mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

ADD: Patch [ 1881588 ] KasBarMenu и класс для работы с *.bar from Dmitry Kolomiets

Browse source
This commit is contained in:
Alexander Koblov 2008-01-29 10:18:36 +00:00
commit 4e8a40ae69
6 changed files with 439 additions and 372 deletions
Download patch file Download diff file Expand all files Collapse all files

12
components/KASToolBar/kasbarfiles.pas
View file

@ -1,8 +1,8 @@
{
File name: kasbarmenu.pas
File name: kasbarfiles.pas
Author: Dmitry Kolomiets (B4rr4cuda@rambler.ru)
Popup menu with *.bar's buttons as MenuItems
Class working with *.bar files.
Based on KASToolBar functions
Copyright (C) 2006-2007 Koblov Alexander (Alexx2000@mail.ru)
@ -29,6 +29,7 @@
unit KASBarFiles;
{$mode objfpc}{$H+}
interface
@ -65,21 +66,20 @@ type
TBarClass=class
CurrentBar:string;
FChangePath : String;
//------------------------------------------------------
private
XButtons:Tlist;
FEnvVar : String;
FChangePath : String;
function GetButton(Index: Integer): TKButton;
function GetButtonCount: Integer;
function GetCmdDirFromEnvVar(sPath: String): String;
procedure SetButton(Index:Integer; const AValue: TKButton);
function SetCmdDirAsEnvVar(sPath: String): String;
procedure SetButton(Index:Integer; const AValue: TKButton);
//------------------------------------------------------
public
//---------------------
Constructor Create;
destructor Destroy; override;
//---------------------

7
components/KASToolBar/kasbarmenu.pas
View file

@ -50,13 +50,14 @@ TOnMenuButtonClick = procedure (Sender: TObject; NumberOfButton : Integer) of ob
FImages: TImageList;
FOnLoadButtonGlyph : TOnLoadButtonGlyph;
FOnMenuButtonClick : TOnMenuButtonClick;
//------------------------------------------------------
procedure MenuOnClick(Sender: TObject);
function LoadBtnIcon(IconPath: String): TBitMap;
//------------------------------------------------------
protected
// property Images;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -140,12 +141,12 @@ end;
procedure TKASBarMenu.LoadBarFile(FileName: string);
var I:Integer; Item:TMenuItem;
begin
Self.Items.Clear;
FBar.DeleteAllButtons;
FBar.LoadFromFile(FileName);
Self.Items.Clear;
Self.Images:=FImages;
FImages.Clear;
FBar.LoadFromFile(FileName);
For I:=0 to Fbar.ButtonCount-1 do
begin
Item:=TMenuItem.Create(Self);

618
fconfigtoolbar.pas
View file

@ -1,309 +1,309 @@
{
Double Commander
-------------------------------------------------------------------------
Configuration Toolbar
Copyright (C) 2006-2007 Koblov Alexander (Alexx2000@mail.ru)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit fConfigToolBar;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, KASToolBar, KASEdit,
KASBarFiles, ExtCtrls;
type
{ TfrmConfigToolBar }
TfrmConfigToolBar = class(TForm)
lblButtonBar: TLabel;
lblCommand: TLabel;
btnCancel: TButton;
gbGroupBox: TGroupBox;
lblIcon: TLabel;
lblIconFile: TLabel;
btnAddButton: TButton;
ktbBar: TKASToolBar;
btnOpenBarFile: TButton;
kedtBarSize: TKASEdit;
cbCommand: TComboBox;
btnDeleteButton: TButton;
btnOpenFile: TButton;
btnAddSubBar: TButton;
btnOpenIconFile: TButton;
kedtIconFileName: TKASEdit;
kedtParams: TKASEdit;
kedtStartPath: TKASEdit;
kedtToolTip: TKASEdit;
cbFlatIcons: TCheckBox;
btnHelp: TButton;
cbSmallIcons: TCheckBox;
lblLabel: TLabel;
btnOK: TButton;
OpenDialog: TOpenDialog;
lblParameters: TLabel;
sbIconExample: TSpeedButton;
stToolBarFileName: TStaticText;
tbScrollBox: TScrollBox;
lblSize: TLabel;
lblStartPath: TLabel;
lblToolTip: TLabel;
procedure btnAddSubBarClick(Sender: TObject);
procedure btnOpenBarFileClick(Sender: TObject);
procedure cbCommandSelect(Sender: TObject);
procedure cbFlatIconsChange(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnAddButtonClick(Sender: TObject);
function ktbBarLoadButtonGlyph(sIconFileName: String; iIconSize: Integer;
clBackColor: TColor): TBitmap;
procedure ktbBarToolButtonClick(Sender: TObject; NumberOfButton : Integer);
procedure Save;
procedure btnDeleteButtonClick(Sender: TObject);
procedure btnOpenFileClick(Sender: TObject);
procedure btnOpenIconFileClick(Sender: TObject);
private
{ private declarations }
procedure FillActionLists;
public
{ public declarations }
end;
procedure ShowConfigToolbar(iButtonIndex : Integer = -1);
var
LastToolButton, NewToolButton : Integer;
implementation
uses ActnList, LCLProc, fMain, uOSForms, uPixMapManager, uGlobsPaths, uGlobs;
procedure ShowConfigToolbar(iButtonIndex : Integer = -1);
begin
with TfrmConfigToolBar.Create(Application) do
try
LastToolButton := -1;
NewToolButton := -1;
ktbBar.InitBounds;
ktbBar.Tag := iButtonIndex; // Selected button index
ShowModal;
finally
Free;
end;
end;
{ TfrmConfigToolBar }
procedure TfrmConfigToolBar.FillActionLists;
var
vNum: integer;
vActions: TAction;
begin
for vNum := 0 to frmMain.actionLst.ActionCount -1 do
begin
vActions := frmMain.actionLst.Actions[vNum] as TAction;
cbCommand.Items.AddObject(vActions.Name, vActions);
end;
end;
procedure TfrmConfigToolBar.FormShow(Sender: TObject);
begin
FillActionLists;
kedtBarSize.Text := IntToStr(gToolBarIconSize);
cbFlatIcons.Checked := gToolBarFlat;
sbIconExample.Flat:= gToolBarFlat;
ktbBar.FlatButtons := gToolBarFlat;
ktbBar.ChangePath := gpExePath;
ktbBar.EnvVar := '%commander_path%';
ktbBar.LoadFromFile(gpIniDir + 'default.bar');
stToolBarFileName.Caption := gpIniDir + 'default.bar';
if ktbBar.Tag >= 0 then
begin
ktbBar.Buttons[ktbBar.Tag].Click;
ktbBar.Buttons[ktbBar.Tag].Down := True;
end
else
begin
if ktbBar.ButtonCount>0 then
begin
ktbBar.Buttons[ktbBar.ButtonCount-1].Down:=true;
ktbBarToolButtonClick(Sender,ktbBar.ButtonCount-1);
end;
end;
end;
procedure TfrmConfigToolBar.cbFlatIconsChange(Sender: TObject);
begin
ktbBar.FlatButtons := cbFlatIcons.Checked;
sbIconExample.Flat := cbFlatIcons.Checked;
end;
procedure TfrmConfigToolBar.btnOpenBarFileClick(Sender: TObject);
begin
OpenDialog.FileName := stToolBarFileName.Caption;
OpenDialog.Filter:= '*.bar|*.bar';
if OpenDialog.Execute then
begin
ktbBar.LoadFromFile(OpenDialog.FileName);
stToolBarFileName.Caption := OpenDialog.FileName;
end;
end;
procedure TfrmConfigToolBar.btnAddSubBarClick(Sender: TObject);
begin
end;
procedure TfrmConfigToolBar.cbCommandSelect(Sender: TObject);
var
vActions: TAction;
begin
vActions := cbCommand.Items.Objects[cbCommand.ItemIndex] as TAction;
kedtToolTip.Text := StringReplace(vActions.Caption, '&', '', [rfReplaceAll]);
end;
procedure TfrmConfigToolBar.btnOKClick(Sender: TObject);
begin
Save;
gToolBarIconSize := StrToIntDef(kedtBarSize.Text, 16);
gToolBarFlat := cbFlatIcons.Checked;
ktbBar.SaveToFile(gpIniDir + 'default.bar');
frmMain.MainToolBar.ButtonGlyphSize := gToolBarIconSize;
frmMain.MainToolBar.DeleteAllToolButtons;
frmMain.MainToolBar.FlatButtons := gToolBarFlat;
frmMain.MainToolBar.LoadFromFile(gpIniDir + 'default.bar');
Close;
end;
(*Add new button on tool bar*)
procedure TfrmConfigToolBar.btnAddButtonClick(Sender: TObject);
begin
Save;
// WriteLn();
ktbBar.AddX('','','','','');
NewToolButton := ktbBar.AddButton('', '', '', '');
ktbBar.Buttons[ktbBar.ButtonCount-1].Down:=true;
ktbBarToolButtonClick(Sender,ktbBar.ButtonCount-1);
//ShowMessage(IntToStr(NewToolButton));
end;
function TfrmConfigToolBar.ktbBarLoadButtonGlyph(sIconFileName: String;
iIconSize: Integer; clBackColor: TColor): TBitmap;
begin
Result := LoadBitmapFromFile(sIconFileName, iIconSize, clBackColor);
end;
(*Select button on panel*)
procedure TfrmConfigToolBar.ktbBarToolButtonClick(Sender: TObject; NumberOfButton : Integer);
begin
Save;
// cbCommand.Text := ktbBar.Commands[NumberOfButton];
cbCommand.Text := ktbBar.GetButtonX(NumberOfButton,CmdX);
// kedtIconFileName.Text := ktbBar.Icons[NumberOfButton];
kedtIconFileName.Text := ktbBar.GetButtonX(NumberOfButton,ButtonX);
// kedtToolTip.Text := ktbBar.Buttons[NumberOfButton].Hint;
kedtToolTip.Text := ktbBar.GetButtonX(NumberOfButton,MenuX);
sbIconExample.Glyph := ktbBar.Buttons[NumberOfButton].Glyph;
kedtParams.Text:= ktbBar.GetButtonX(NumberOfButton,ParamX);
kedtStartPath.Text:= ktbBar.GetButtonX(NumberOfButton,PathX);
LastToolButton := NumberOfButton;
end;
(*Save current button*)
procedure TfrmConfigToolBar.Save;
begin
if (LastToolButton >= 0) and (ktbBar.ButtonCount > 0) then
begin
//---------------------
ktbBar.SetButtonX(LastToolButton,CmdX,cbCommand.Text);
ktbBar.SetButtonX(LastToolButton,ParamX,kedtParams.Text);
ktbBar.SetButtonX(LastToolButton,PathX,kedtStartPath.Text);
ktbBar.SetButtonX(LastToolButton,ButtonX,kedtIconFileName.Text);
ktbBar.SetButtonX(LastToolButton,MenuX,kedtToolTip.Text);
//---------------------
// ktbBar.Commands[LastToolButton] := cbCommand.Text;
// ktbBar.Icons[LastToolButton] := kedtIconFileName.Text;
// ktbBar.Buttons[LastToolButton].Hint := kedtToolTip.Text;
end
else (*If only Append clicked*)
if NewToolButton >= 0 then
begin
//ShowMessage(IntToStr(NewToolButton));
// ktbBar.Commands[NewToolButton] := cbCommand.Text;
// ktbBar.Icons[NewToolButton] := kedtIconFileName.Text;
// ktbBar.Buttons[NewToolButton].Hint := kedtToolTip.Text;
//---------------------
ktbBar.SetButtonX(NewToolButton,CmdX,cbCommand.Text);
ktbBar.SetButtonX(NewToolButton,ButtonX,kedtIconFileName.Text);
ktbBar.SetButtonX(NewToolButton,MenuX,kedtToolTip.Text);
ktbBar.SetButtonX(NewToolButton,ParamX,kedtParams.Text);
ktbBar.SetButtonX(NewToolButton,PathX,kedtStartPath.Text);
//---------------------
end;
end;
(*Remove current button*)
procedure TfrmConfigToolBar.btnDeleteButtonClick(Sender: TObject);
begin
if (LastToolButton >= 0) and (ktbBar.ButtonCount > 0) then
begin
ktbBar.RemoveButton(LastToolButton);
cbCommand.Text := '';
kedtIconFileName.Text := '';
kedtToolTip.Text := '';
LastToolButton := -1;
NewToolButton := -1;
ktbBar.Buttons[ktbBar.ButtonCount-1].Down:=true;
ktbBarToolButtonClick(Sender,ktbBar.ButtonCount-1);
end;
end;
procedure TfrmConfigToolBar.btnOpenFileClick(Sender: TObject);
begin
OpenDialog.Filter:= '';
if OpenDialog.Execute then
cbCommand.Text := OpenDialog.FileName;
end;
procedure TfrmConfigToolBar.btnOpenIconFileClick(Sender: TObject);
var
sFileName: String;
begin
sFileName := kedtIconFileName.Text;
if ShowOpenIconDialog(Self, sFileName) then
begin
kedtIconFileName.Text := sFileName;
sbIconExample.Glyph := LoadBitmapFromFile(kedtIconFileName.Text, 32, Color);
end;
end;
initialization
{$I fconfigtoolbar.lrs}
end.
{
Double Commander
-------------------------------------------------------------------------
Configuration Toolbar
Copyright (C) 2006-2007 Koblov Alexander (Alexx2000@mail.ru)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit fConfigToolBar;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, KASToolBar, KASEdit,
ExtCtrls,KASBarFiles;
type
{ TfrmConfigToolBar }
TfrmConfigToolBar = class(TForm)
lblButtonBar: TLabel;
lblCommand: TLabel;
btnCancel: TButton;
gbGroupBox: TGroupBox;
lblIcon: TLabel;
lblIconFile: TLabel;
btnAddButton: TButton;
ktbBar: TKASToolBar;
btnOpenBarFile: TButton;
kedtBarSize: TKASEdit;
cbCommand: TComboBox;
btnDeleteButton: TButton;
btnOpenFile: TButton;
btnAddSubBar: TButton;
btnOpenIconFile: TButton;
kedtIconFileName: TKASEdit;
kedtParams: TKASEdit;
kedtStartPath: TKASEdit;
kedtToolTip: TKASEdit;
cbFlatIcons: TCheckBox;
btnHelp: TButton;
cbSmallIcons: TCheckBox;
lblLabel: TLabel;
btnOK: TButton;
OpenDialog: TOpenDialog;
lblParameters: TLabel;
sbIconExample: TSpeedButton;
stToolBarFileName: TStaticText;
tbScrollBox: TScrollBox;
lblSize: TLabel;
lblStartPath: TLabel;
lblToolTip: TLabel;
procedure btnAddSubBarClick(Sender: TObject);
procedure btnOpenBarFileClick(Sender: TObject);
procedure cbCommandSelect(Sender: TObject);
procedure cbFlatIconsChange(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnAddButtonClick(Sender: TObject);
function ktbBarLoadButtonGlyph(sIconFileName: String; iIconSize: Integer;
clBackColor: TColor): TBitmap;
procedure ktbBarToolButtonClick(Sender: TObject; NumberOfButton : Integer);
procedure Save;
procedure btnDeleteButtonClick(Sender: TObject);
procedure btnOpenFileClick(Sender: TObject);
procedure btnOpenIconFileClick(Sender: TObject);
private
{ private declarations }
procedure FillActionLists;
public
{ public declarations }
end;
procedure ShowConfigToolbar(iButtonIndex : Integer = -1);
var
LastToolButton, NewToolButton : Integer;
implementation
uses ActnList, LCLProc, fMain, uOSForms, uPixMapManager, uGlobsPaths, uGlobs;
procedure ShowConfigToolbar(iButtonIndex : Integer = -1);
begin
with TfrmConfigToolBar.Create(Application) do
try
LastToolButton := -1;
NewToolButton := -1;
ktbBar.InitBounds;
ktbBar.Tag := iButtonIndex; // Selected button index
ShowModal;
finally
Free;
end;
end;
{ TfrmConfigToolBar }
procedure TfrmConfigToolBar.FillActionLists;
var
vNum: integer;
vActions: TAction;
begin
for vNum := 0 to frmMain.actionLst.ActionCount -1 do
begin
vActions := frmMain.actionLst.Actions[vNum] as TAction;
cbCommand.Items.AddObject(vActions.Name, vActions);
end;
end;
procedure TfrmConfigToolBar.FormShow(Sender: TObject);
begin
FillActionLists;
kedtBarSize.Text := IntToStr(gToolBarIconSize);
cbFlatIcons.Checked := gToolBarFlat;
sbIconExample.Flat:= gToolBarFlat;
ktbBar.FlatButtons := gToolBarFlat;
ktbBar.ChangePath := gpExePath;
ktbBar.EnvVar := '%commander_path%';
ktbBar.LoadFromFile(gpIniDir + 'default.bar');
stToolBarFileName.Caption := gpIniDir + 'default.bar';
if ktbBar.Tag >= 0 then
begin
ktbBar.Buttons[ktbBar.Tag].Click;
ktbBar.Buttons[ktbBar.Tag].Down := True;
end
else
begin
if ktbBar.ButtonCount>0 then
begin
ktbBar.Buttons[ktbBar.ButtonCount-1].Down:=true;
ktbBarToolButtonClick(Sender,ktbBar.ButtonCount-1);
end;
end;
end;
procedure TfrmConfigToolBar.cbFlatIconsChange(Sender: TObject);
begin
ktbBar.FlatButtons := cbFlatIcons.Checked;
sbIconExample.Flat := cbFlatIcons.Checked;
end;
procedure TfrmConfigToolBar.btnOpenBarFileClick(Sender: TObject);
begin
OpenDialog.FileName := stToolBarFileName.Caption;
OpenDialog.Filter:= '*.bar|*.bar';
if OpenDialog.Execute then
begin
ktbBar.LoadFromFile(OpenDialog.FileName);
stToolBarFileName.Caption := OpenDialog.FileName;
end;
end;
procedure TfrmConfigToolBar.btnAddSubBarClick(Sender: TObject);
begin
end;
procedure TfrmConfigToolBar.cbCommandSelect(Sender: TObject);
var
vActions: TAction;
begin
vActions := cbCommand.Items.Objects[cbCommand.ItemIndex] as TAction;
kedtToolTip.Text := StringReplace(vActions.Caption, '&', '', [rfReplaceAll]);
end;
procedure TfrmConfigToolBar.btnOKClick(Sender: TObject);
begin
Save;
gToolBarIconSize := StrToIntDef(kedtBarSize.Text, 16);
gToolBarFlat := cbFlatIcons.Checked;
ktbBar.SaveToFile(gpIniDir + 'default.bar');
frmMain.MainToolBar.ButtonGlyphSize := gToolBarIconSize;
frmMain.MainToolBar.DeleteAllToolButtons;
frmMain.MainToolBar.FlatButtons := gToolBarFlat;
frmMain.MainToolBar.LoadFromFile(gpIniDir + 'default.bar');
Close;
end;
(*Add new button on tool bar*)
procedure TfrmConfigToolBar.btnAddButtonClick(Sender: TObject);
begin
Save;
// WriteLn();
ktbBar.AddX('','','','','');
NewToolButton := ktbBar.AddButton('', '', '', '');
ktbBar.Buttons[ktbBar.ButtonCount-1].Down:=true;
ktbBarToolButtonClick(Sender,ktbBar.ButtonCount-1);
//ShowMessage(IntToStr(NewToolButton));
end;
function TfrmConfigToolBar.ktbBarLoadButtonGlyph(sIconFileName: String;
iIconSize: Integer; clBackColor: TColor): TBitmap;
begin
Result := LoadBitmapFromFile(sIconFileName, iIconSize, clBackColor);
end;
(*Select button on panel*)
procedure TfrmConfigToolBar.ktbBarToolButtonClick(Sender: TObject; NumberOfButton : Integer);
begin
Save;
// cbCommand.Text := ktbBar.Commands[NumberOfButton];
cbCommand.Text := ktbBar.GetButtonX(NumberOfButton,CmdX);
// kedtIconFileName.Text := ktbBar.Icons[NumberOfButton];
kedtIconFileName.Text := ktbBar.GetButtonX(NumberOfButton,ButtonX);
// kedtToolTip.Text := ktbBar.Buttons[NumberOfButton].Hint;
kedtToolTip.Text := ktbBar.GetButtonX(NumberOfButton,MenuX);
sbIconExample.Glyph := ktbBar.Buttons[NumberOfButton].Glyph;
kedtParams.Text:= ktbBar.GetButtonX(NumberOfButton,ParamX);
kedtStartPath.Text:= ktbBar.GetButtonX(NumberOfButton,PathX);
LastToolButton := NumberOfButton;
end;
(*Save current button*)
procedure TfrmConfigToolBar.Save;
begin
if (LastToolButton >= 0) and (ktbBar.ButtonCount > 0) then
begin
//---------------------
ktbBar.SetButtonX(LastToolButton,CmdX,cbCommand.Text);
ktbBar.SetButtonX(LastToolButton,ParamX,kedtParams.Text);
ktbBar.SetButtonX(LastToolButton,PathX,kedtStartPath.Text);
ktbBar.SetButtonX(LastToolButton,ButtonX,kedtIconFileName.Text);
ktbBar.SetButtonX(LastToolButton,MenuX,kedtToolTip.Text);
//---------------------
// ktbBar.Commands[LastToolButton] := cbCommand.Text;
// ktbBar.Icons[LastToolButton] := kedtIconFileName.Text;
// ktbBar.Buttons[LastToolButton].Hint := kedtToolTip.Text;
end
else (*If only Append clicked*)
if NewToolButton >= 0 then
begin
//ShowMessage(IntToStr(NewToolButton));
// ktbBar.Commands[NewToolButton] := cbCommand.Text;
// ktbBar.Icons[NewToolButton] := kedtIconFileName.Text;
// ktbBar.Buttons[NewToolButton].Hint := kedtToolTip.Text;
//---------------------
ktbBar.SetButtonX(NewToolButton,CmdX,cbCommand.Text);
ktbBar.SetButtonX(NewToolButton,ButtonX,kedtIconFileName.Text);
ktbBar.SetButtonX(NewToolButton,MenuX,kedtToolTip.Text);
ktbBar.SetButtonX(NewToolButton,ParamX,kedtParams.Text);
ktbBar.SetButtonX(NewToolButton,PathX,kedtStartPath.Text);
//---------------------
end;
end;
(*Remove current button*)
procedure TfrmConfigToolBar.btnDeleteButtonClick(Sender: TObject);
begin
if (LastToolButton >= 0) and (ktbBar.ButtonCount > 0) then
begin
ktbBar.RemoveButton(LastToolButton);
cbCommand.Text := '';
kedtIconFileName.Text := '';
kedtToolTip.Text := '';
LastToolButton := -1;
NewToolButton := -1;
ktbBar.Buttons[ktbBar.ButtonCount-1].Down:=true;
ktbBarToolButtonClick(Sender,ktbBar.ButtonCount-1);
end;
end;
procedure TfrmConfigToolBar.btnOpenFileClick(Sender: TObject);
begin
OpenDialog.Filter:= '';
if OpenDialog.Execute then
cbCommand.Text := OpenDialog.FileName;
end;
procedure TfrmConfigToolBar.btnOpenIconFileClick(Sender: TObject);
var
sFileName: String;
begin
sFileName := kedtIconFileName.Text;
if ShowOpenIconDialog(Self, sFileName) then
begin
kedtIconFileName.Text := sFileName;
sbIconExample.Glyph := LoadBitmapFromFile(kedtIconFileName.Text, 32, Color);
end;
end;
initialization
{$I fconfigtoolbar.lrs}
end.

110
fmain.lfm
View file

@ -1,15 +1,15 @@
object frmMain: TfrmMain
Left = 254
Height = 336
Top = 192
Width = 540
HorzScrollBar.Page = 539
VertScrollBar.Page = 315
Left = 263
Height = 695
Top = 96
Width = 1013
HorzScrollBar.Page = 1012
VertScrollBar.Page = 668
VertScrollBar.Range = 79
ActiveControl = pnlNotebooks
ActiveControl = nbRight
Caption = 'Double Commander'
ClientHeight = 316
ClientWidth = 540
ClientHeight = 669
ClientWidth = 1013
Font.Color = clBlack
Font.Height = 13
Font.Name = 'Helvetica'
@ -30,15 +30,15 @@ object frmMain: TfrmMain
object pnlSyncSize: TPanel
Height = 26
Top = 24
Width = 540
Width = 1013
Align = alTop
BevelOuter = bvNone
ClientHeight = 26
ClientWidth = 540
ClientWidth = 1013
FullRepaint = False
TabOrder = 0
object pnlDisk: TPanel
Left = 15
Left = 488
Height = 26
Width = 525
Align = alRight
@ -81,34 +81,34 @@ object frmMain: TfrmMain
end
end
object pnlNotebooks: TPanel
Height = 174
Height = 527
Top = 50
Width = 540
Width = 1013
Align = alClient
ClientHeight = 174
ClientWidth = 540
ClientHeight = 527
ClientWidth = 1013
FullRepaint = False
TabOrder = 1
TabStop = True
object MainSplitter: TSplitter
Left = 171
Height = 134
Height = 487
Top = 1
Width = 4
ResizeStyle = rsLine
end
object pnlLeft: TPanel
Left = 1
Height = 134
Height = 487
Top = 1
Width = 170
Align = alLeft
BevelOuter = bvNone
ClientHeight = 134
ClientHeight = 487
ClientWidth = 170
TabOrder = 0
object nbLeft: TNotebook
Height = 110
Height = 463
Top = 24
Width = 170
Align = alClient
@ -176,18 +176,18 @@ object frmMain: TfrmMain
end
object pnlRight: TPanel
Left = 175
Height = 134
Height = 487
Top = 1
Width = 364
Width = 837
Align = alClient
BevelOuter = bvNone
ClientHeight = 134
ClientWidth = 364
ClientHeight = 487
ClientWidth = 837
TabOrder = 1
object nbRight: TNotebook
Height = 110
Height = 463
Top = 24
Width = 364
Width = 837
Align = alClient
OnCloseTabClicked = NoteBookCloseTabClicked
OnPageChanged = nbPageChanged
@ -196,11 +196,11 @@ object frmMain: TfrmMain
end
object pnlRightTools: TPanel
Height = 24
Width = 364
Width = 837
Align = alTop
BevelOuter = bvNone
ClientHeight = 24
ClientWidth = 364
ClientWidth = 837
TabOrder = 1
object btnRightDrive: TSpeedButton
Height = 24
@ -211,7 +211,7 @@ object frmMain: TfrmMain
NumGlyphs = 0
end
object btnRightHome: TSpeedButton
Left = 341
Left = 814
Height = 24
Width = 23
Align = alRight
@ -221,7 +221,7 @@ object frmMain: TfrmMain
OnClick = btnRightClick
end
object btnRightUp: TSpeedButton
Left = 318
Left = 791
Height = 24
Width = 23
Align = alRight
@ -231,7 +231,7 @@ object frmMain: TfrmMain
OnClick = btnRightClick
end
object btnRightRoot: TSpeedButton
Left = 295
Left = 768
Height = 24
Width = 23
Align = alRight
@ -243,7 +243,7 @@ object frmMain: TfrmMain
object lblRightDriveInfo: TLabel
Left = 48
Height = 24
Width = 247
Width = 720
Align = alClient
Alignment = taCenter
ParentColor = False
@ -254,13 +254,13 @@ object frmMain: TfrmMain
object pnlCommand: TPanel
Left = 1
Height = 38
Top = 135
Width = 538
Top = 488
Width = 1011
Align = alBottom
Anchors = [akLeft, akRight]
BevelOuter = bvLowered
ClientHeight = 38
ClientWidth = 538
ClientWidth = 1011
FullRepaint = False
ParentColor = False
TabOrder = 2
@ -268,9 +268,9 @@ object frmMain: TfrmMain
AnchorSideTop.Control = edtCommand
AnchorSideTop.Side = asrCenter
Left = 1
Height = 14
Top = 11
Width = 23
Height = 13
Top = 12
Width = 33
Alignment = taRightJustify
Caption = 'Path'
ParentColor = False
@ -280,11 +280,10 @@ object frmMain: TfrmMain
Left = 56
Height = 21
Top = 8
Width = 471
Width = 944
TabStop = False
Anchors = [akTop, akLeft, akRight]
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
MaxLength = 0
ParentCtl3D = False
TabOrder = 0
@ -293,7 +292,7 @@ object frmMain: TfrmMain
end
object MainToolBar: TKAStoolBar
Height = 24
Width = 540
Width = 1013
Align = alTop
TabOrder = 2
OnMouseUp = MainToolBarMouseUp
@ -305,13 +304,13 @@ object frmMain: TfrmMain
end
object pnlKeys: TPanel
Height = 27
Top = 289
Width = 540
Top = 642
Width = 1013
Align = alBottom
Anchors = [akLeft, akRight]
BevelOuter = bvLowered
ClientHeight = 27
ClientWidth = 540
ClientWidth = 1013
FullRepaint = False
TabOrder = 3
OnResize = pnlKeysResize
@ -398,13 +397,15 @@ object frmMain: TfrmMain
end
object seLogWindow: TSynEdit
Height = 61
Top = 228
Width = 540
Top = 581
Width = 1013
Align = alBottom
Font.Height = -16
Font.Name = 'courier'
ParentColor = False
TabOrder = 4
BookMarkOptions.OnChange = nil
Gutter.OnChange = nil
Gutter.CodeFoldingWidth = 14
Keystrokes = <
item
@ -730,13 +731,14 @@ object frmMain: TfrmMain
ReadOnly = True
RightEdge = 0
ScrollBars = ssVertical
SelectedColor.OnChange = nil
OnSpecialLineColors = seLogWindowSpecialLineColors
end
object LogSplitter: TSplitter
Cursor = crVSplit
Height = 4
Top = 224
Width = 540
Top = 577
Width = 1013
Align = alBottom
ResizeStyle = rsLine
ResizeAnchor = akBottom
@ -1315,6 +1317,12 @@ object frmMain: TfrmMain
OnExecute = actOpenArchiveExecute
ShortCut = 16418
end
object actShowButtonMenu: TAction
Category = 'Commands'
Caption = 'actShowButtonMenu'
DisableIfNoHandler = True
OnExecute = actShowButtonMenuExecute
end
end
object pmHotList: TPopupMenu
left = 152
@ -1342,4 +1350,10 @@ object frmMain: TfrmMain
left = 80
top = 136
end
object pmButtonMenu: TKASBarMenu
OnLoadButtonGlyph = pmButtonMenuLoadButtonGlyph
OnMenuButtonClick = pmButtonMenuMenuButtonClick
left = 220
top = 136
end
end

1
fmain.lrt
View file

@ -76,5 +76,6 @@ TFRMMAIN.ACTTRANSFERLEFT.CAPTION=Transfer dir under cursor to left window
TFRMMAIN.ACTTRANSFERRIGHT.CAPTION=Transfer dir under cursor to right window
TFRMMAIN.ACTCONTEXTMENU.CAPTION=Show context menu
TFRMMAIN.ACTOPENARCHIVE.CAPTION=Try open archive
TFRMMAIN.ACTSHOWBUTTONMENU.CAPTION=actShowButtonMenu
TFRMMAIN.TBEDIT.CAPTION=Edit
TFRMMAIN.TBDELETE.CAPTION=Delete

63
fmain.pas
View file

@ -39,7 +39,7 @@ uses
Graphics, Forms, Menus, Controls, Dialogs, ComCtrls,
StdCtrls, ExtCtrls,ActnList,Buttons,
SysUtils, Classes, {uFilePanel,} framePanel, {FileCtrl,} Grids,
KASToolBar, IniFiles, SynEdit;
KASToolBar, IniFiles, SynEdit, KASBarMenu,KASBarFiles;
const
cHistoryFile='cmdhistory.txt';
@ -53,6 +53,7 @@ type
actAddPathToCmdLine: TAction;
actFocusCmdLine: TAction;
actContextMenu: TAction;
actShowButtonMenu: TAction;
actOpenArchive: TAction;
actTransferRight: TAction;
actTransferLeft: TAction;
@ -73,6 +74,7 @@ type
dskLeft: TKAStoolBar;
dskRight: TKAStoolBar;
edtCommand: TComboBox;
pmButtonMenu: TKASBarMenu;
lblCommandPath: TLabel;
lblRightDriveInfo: TLabel;
lblLeftDriveInfo: TLabel;
@ -203,6 +205,7 @@ type
procedure actOpenVFSListExecute(Sender: TObject);
procedure actPackFilesExecute(Sender: TObject);
procedure actRightOpenDrivesExecute(Sender: TObject);
procedure actShowButtonMenuExecute(Sender: TObject);
procedure actTransferLeftExecute(Sender: TObject);
procedure actTransferRightExecute(Sender: TObject);
procedure btnLeftClick(Sender: TObject);
@ -227,6 +230,10 @@ type
procedure mnuHelpClick(Sender: TObject);
procedure nbPageChanged(Sender: TObject);
procedure NotebookCloseTabClicked(Sender: TObject);
function pmButtonMenuLoadButtonGlyph(sIconFileName: String;
iIconSize: Integer; clBackColor: TColor): TBitmap;
procedure pmButtonMenuMenuButtonClick(Sender: TObject;
NumberOfButton: Integer);
procedure pnlKeysResize(Sender: TObject);
procedure actViewExecute(Sender: TObject);
procedure actEditExecute(Sender: TObject);
@ -333,7 +340,8 @@ type
procedure RemovePage(ANoteBook:TNoteBook; iPageIndex:Integer);
procedure LoadTabs(ANoteBook:TNoteBook);
procedure SaveTabs(ANoteBook:TNoteBook);
function ExecCmd(Cmd : String) : Boolean;
function ExecCmd(Cmd:string) : Boolean;
function ExecCmdEx(NumberOfButton:Integer) : Boolean;
procedure UpdateWindowView;
procedure SaveShortCuts;
procedure LoadShortCuts;
@ -402,6 +410,20 @@ begin
pmDrivesMenu.PopUp(p.x, p.y);
end;
procedure TfrmMain.actShowButtonMenuExecute(Sender: TObject);
var cmd:string; Point:TPoint;
begin
cmd:=MainToolBar.GetButtonX((Sender as TAction).tag,CmdX);
pmButtonMenu.LoadBarFile(gpIniDir + MainToolBar.GetButtonX((Sender as TACtion).tag,ParamX));
Point:=MainToolBar.ClientToScreen(Classes.Point(0,0));
Point.Y:=Point.Y+MainToolbar.Height;
if MainToolbar.ButtonCount>0 then
Point.X:=Point.X+MainToolbar.Buttons[0].Width*((Sender as TAction).tag)-60
else
Point.X:=Point.X+MainToolbar.ButtonGlyphSize*((Sender as TAction).tag)+50;
pmButtonMenu.PopUp(Point.x,Point.Y);
end;
procedure TfrmMain.actTransferLeftExecute(Sender: TObject);
begin
if (PanelSelected = fpRight) then
@ -648,7 +670,7 @@ end;
procedure TfrmMain.MainToolBarToolButtonClick(Sender: TObject; NumberOfButton : Integer);
begin
ExecCmd(MainToolBar.Commands[NumberOfButton]);
ExecCmdEx(NumberOfButton);
DebugLn(MainToolBar.Commands[NumberOfButton]);
end;
@ -767,6 +789,9 @@ begin
end;
(*Tool Bar*)
pmButtonMenu.BarFile.ChangePath := gpExePath;
pmButtonMenu.BarFile.EnvVar := '%commander_path%';
LoadShortCuts;
{Load some options from layout page}
@ -827,6 +852,18 @@ begin
end;
end;
function TfrmMain.pmButtonMenuLoadButtonGlyph(sIconFileName: String;
iIconSize: Integer; clBackColor: TColor): TBitmap;
begin
Result := LoadBitmapFromFile(sIconFileName, iIconSize, clBackColor);
end;
procedure TfrmMain.pmButtonMenuMenuButtonClick(Sender: TObject;
NumberOfButton: Integer);
begin
ExecCmdEx(NumberOfButton);
end;
procedure TfrmMain.pnlKeysResize(Sender: TObject);
var
iWidth:Integer;
@ -2675,9 +2712,7 @@ begin
gIni.WriteString(Section, 'path', sPath);
end;
(* Execute internal or external command *)
function TfrmMain.ExecCmd(Cmd: String): Boolean;
function TfrmMain.ExecCmd(Cmd: string): Boolean;
begin
if actionLst.ActionByName(Cmd) <> nil then
Result := actionLst.ActionByName(Cmd).Execute
@ -2685,6 +2720,22 @@ begin
Result := ExecCmdFork(Format('"%s"', [Cmd]));
end;
function TfrmMain.ExecCmdEx(NumberOfButton: Integer): Boolean;
var Cmd:string;
begin
Cmd:=MainToolBar.GetButtonX(NumberOfButton,CmdX);
if actionLst.ActionByName(Cmd) <> nil then
begin
actionLst.ActionByName(Cmd).Tag:=NumberOfButton;
Result := actionLst.ActionByName(Cmd).Execute;
end
else
Result := ExecCmdFork(Format('"%s"', [Cmd]));
end;
(* Execute internal or external command *)
procedure TfrmMain.UpdateWindowView;
var
I : Integer;