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

UPD: Move buttons by mouse in real time (patch by Fuhrer)

Browse source
This commit is contained in:
Alexander Koblov 2011-02-23 08:42:55 +00:00
commit cd57e29106
3 changed files with 113 additions and 88 deletions
Download patch file Download diff file Expand all files Collapse all files

3
components/KASToolBar/kastoolbar.pas
View file

@ -375,6 +375,7 @@ begin
FBarFile.SetButtonX(Index, What, Value);
if What = ButtonX then
begin
if FBarFile.GetButtonX(Index, MenuX)= '-' then Value:= '-'; // To pass separator to FOnLoadButtonGlyph
if Assigned(FOnLoadButtonGlyph) then
Bitmap := FOnLoadButtonGlyph(Value, FGlyphSize, Color)
else
@ -528,6 +529,7 @@ begin
else
FBarFile.RemoveButton(ButtonIndex);
UpdateButtonsTags;
ResizeButtons;
end;
procedure TKASToolBar.UpdateButtonsTags;
@ -734,6 +736,7 @@ function TKASToolBar.InsertButton(InsertAt: Integer; sCaption, sCommand, sHint,
var
Bitmap: TBitmap = nil;
begin
if sHint = '-' then sBitmap:= sHint; // To pass separator to FOnLoadButtonGlyph
if Assigned(FOnLoadButtonGlyph) then
Bitmap:= FOnLoadButtonGlyph(sBitmap, FGlyphSize, clBtnFace)
else

149
src/fconfigtoolbar.lfm
View file

@ -1,8 +1,8 @@
object frmConfigToolBar: TfrmConfigToolBar
Left = 418
Height = 323
Top = 128
Width = 661
Left = 615
Height = 321
Top = 129
Width = 662
HelpType = htKeyword
HelpKeyword = '/toolbar.html'
ActiveControl = btnAppendButton
@ -10,8 +10,8 @@ object frmConfigToolBar: TfrmConfigToolBar
BorderStyle = bsDialog
Caption = 'Change button bar'
ChildSizing.TopBottomSpacing = 8
ClientHeight = 323
ClientWidth = 661
ClientHeight = 321
ClientWidth = 662
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '0.9.29'
@ -30,7 +30,7 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideTop.Side = asrCenter
Left = 8
Height = 14
Top = 177
Top = 175
Width = 52
Caption = '&Command:'
FocusControl = cbCommand
@ -44,8 +44,8 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideRight.Side = asrBottom
Left = 0
Height = 1
Top = 167
Width = 661
Top = 165
Width = 662
Anchors = [akTop, akLeft, akRight]
AutoSize = False
BorderSpacing.Top = 4
@ -58,7 +58,7 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideTop.Side = asrCenter
Left = 8
Height = 14
Top = 204
Top = 202
Width = 60
Caption = '&Parameters:'
FocusControl = edtParams
@ -69,7 +69,7 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideTop.Side = asrCenter
Left = 8
Height = 14
Top = 227
Top = 225
Width = 54
Caption = '&Start path:'
FocusControl = edtStartPath
@ -80,7 +80,7 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideTop.Side = asrCenter
Left = 8
Height = 14
Top = 285
Top = 283
Width = 43
Caption = 'Icon &file:'
FocusControl = kedtIconFileName
@ -95,7 +95,7 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideBottom.Control = sbIconExample
Left = 113
Height = 14
Top = 254
Top = 252
Width = 26
Anchors = [akRight, akBottom]
BorderSpacing.Right = 9
@ -109,7 +109,7 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideTop.Side = asrCenter
Left = 8
Height = 14
Top = 250
Top = 248
Width = 37
Caption = '&Tooltip:'
FocusControl = edtToolTip
@ -124,7 +124,7 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideBottom.Control = gbGroupBox
Left = 108
Height = 40
Top = 272
Top = 270
Width = 40
BorderSpacing.Top = 4
BorderSpacing.Bottom = 7
@ -138,7 +138,7 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = tbScrollBox
AnchorSideRight.Side = asrBottom
Left = 512
Left = 494
Height = 21
Top = 10
Width = 26
@ -152,13 +152,15 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideLeft.Control = btnAppendButton
AnchorSideTop.Control = btnCloneButton
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btnAppendButton
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = tbScrollBox
AnchorSideBottom.Side = asrBottom
Left = 546
Height = 32
Top = 129
Width = 109
Anchors = [akLeft, akBottom]
Left = 528
Height = 31
Top = 128
Width = 128
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.InnerBorder = 4
Caption = '&Delete'
OnClick = btnDeleteButtonClick
@ -171,8 +173,8 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideRight.Control = btnOpenFile
Left = 108
Height = 21
Top = 174
Width = 404
Top = 172
Width = 386
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
DropDownCount = 20
@ -188,9 +190,9 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = cbCommand
AnchorSideBottom.Side = asrBottom
Left = 512
Left = 494
Height = 21
Top = 174
Top = 172
Width = 26
Anchors = [akTop, akRight, akBottom]
BorderSpacing.InnerBorder = 4
@ -201,11 +203,14 @@ object frmConfigToolBar: TfrmConfigToolBar
object btnAppendMore: TButton
AnchorSideLeft.Control = btnAppendButton
AnchorSideTop.Control = btnOpenBarFile
AnchorSideRight.Control = btnAppendButton
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnAppendButton
Left = 546
Height = 32
Left = 528
Height = 30
Top = 10
Width = 109
Width = 128
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Bottom = 8
BorderSpacing.InnerBorder = 4
Caption = 'A&ppend >>'
@ -220,8 +225,8 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideRight.Control = btnOK
Left = 108
Height = 21
Top = 201
Width = 430
Top = 199
Width = 412
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 40
BorderSpacing.Top = 6
@ -237,8 +242,8 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideRight.Side = asrBottom
Left = 108
Height = 21
Top = 224
Width = 430
Top = 222
Width = 412
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
MaxLength = 259
@ -253,8 +258,8 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideRight.Side = asrBottom
Left = 154
Height = 21
Top = 282
Width = 384
Top = 280
Width = 366
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
Enabled = False
@ -269,8 +274,8 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideRight.Side = asrBottom
Left = 108
Height = 21
Top = 247
Width = 430
Top = 245
Width = 412
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
MaxLength = 259
@ -278,16 +283,15 @@ object frmConfigToolBar: TfrmConfigToolBar
TabOrder = 12
end
object btnOK: TButton
AnchorSideLeft.Control = gbGroupBox
AnchorSideLeft.Side = asrCenter
AnchorSideLeft.Control = btnAppendButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnCancel
Left = 546
Left = 528
Height = 32
Top = 211
Width = 109
Anchors = [akRight, akBottom]
Top = 209
Width = 128
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Right = 6
BorderSpacing.InnerBorder = 4
Caption = 'OK'
@ -299,12 +303,14 @@ object frmConfigToolBar: TfrmConfigToolBar
object btnCancel: TButton
AnchorSideLeft.Control = btnOK
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btnOK
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnHelp
Left = 546
Left = 528
Height = 32
Top = 247
Width = 109
Anchors = [akLeft, akBottom]
Top = 245
Width = 128
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Top = 4
BorderSpacing.InnerBorder = 4
Cancel = True
@ -315,13 +321,15 @@ object frmConfigToolBar: TfrmConfigToolBar
object btnHelp: TButton
AnchorSideLeft.Control = btnCancel
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btnOK
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 546
Left = 528
Height = 32
Top = 283
Width = 109
Anchors = [akLeft, akBottom]
Top = 281
Width = 128
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Top = 4
BorderSpacing.InnerBorder = 4
Caption = '&Help'
@ -335,16 +343,17 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = lblLabel
Left = 8
Height = 154
Height = 152
Top = 9
Width = 160
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 9
BorderSpacing.Right = 6
Caption = 'Appearance'
ChildSizing.LeftRightSpacing = 8
ChildSizing.TopBottomSpacing = 4
ClientHeight = 136
ClientHeight = 134
ClientWidth = 156
TabOrder = 4
object lblBarSize: TLabel
@ -389,7 +398,6 @@ object frmConfigToolBar: TfrmConfigToolBar
OnChange = trbBarSizeChange
Position = 18
ScalePos = trRight
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 3
BorderSpacing.Right = 4
Constraints.MinWidth = 40
@ -470,23 +478,23 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideRight.Control = btnAppendButton
AnchorSideBottom.Control = lblLabel
Left = 176
Height = 124
Height = 122
Top = 37
Width = 362
Width = 344
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 6
BorderSpacing.Right = 8
BorderSpacing.Bottom = 6
ClientHeight = 120
ClientWidth = 358
ClientHeight = 118
ClientWidth = 340
TabOrder = 7
OnClick = tbScrollBoxClick
object ktbBar: TKASToolBar
Left = 1
Height = 24
Top = 0
Width = 356
Width = 338
AutoSize = True
BorderSpacing.Left = 1
BorderSpacing.Right = 1
@ -498,7 +506,6 @@ object frmConfigToolBar: TfrmConfigToolBar
OnToolButtonMouseUp = ktbBarToolButtonMouseUp
OnToolButtonMouseMove = ktbBarToolButtonMouseMove
OnToolButtonDragDrop = ktbBarToolButtonDragDrop
OnToolButtonEndDrag = ktbBarToolButtonEndDrag
OnToolButtonDragOver = ktbBarToolButtonDragOver
OnLoadButtonGlyph = ktbBarLoadButtonGlyph
RadioToolBar = True
@ -514,7 +521,7 @@ object frmConfigToolBar: TfrmConfigToolBar
Left = 242
Height = 21
Top = 10
Width = 270
Width = 252
Alignment = taLeftJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 10
@ -529,10 +536,10 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnCloneButton
Left = 546
Left = 528
Height = 32
Top = 49
Width = 109
Top = 48
Width = 128
Anchors = [akRight, akBottom]
BorderSpacing.Right = 6
Caption = '&Insert new button'
@ -543,9 +550,9 @@ object frmConfigToolBar: TfrmConfigToolBar
AnchorSideLeft.Control = btnOK
AnchorSideTop.Control = btnOpenFile
AnchorSideTop.Side = asrCenter
Left = 546
Left = 528
Height = 17
Top = 176
Top = 174
Width = 68
Caption = 'S&eparator'
OnChange = cbIsSeparatorChange
@ -553,14 +560,16 @@ object frmConfigToolBar: TfrmConfigToolBar
end
object btnCloneButton: TButton
AnchorSideLeft.Control = btnAppendButton
AnchorSideTop.Control = tbScrollBox
AnchorSideTop.Control = gbGroupBox
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = btnAppendButton
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDeleteButton
Left = 546
Left = 528
Height = 32
Top = 89
Width = 109
Anchors = [akLeft, akBottom]
Top = 88
Width = 128
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Top = 8
BorderSpacing.Bottom = 8
Caption = 'Clo&ne button'

49
src/fconfigtoolbar.pas
View file

@ -95,8 +95,6 @@ type
NumberOfButton: Integer);
procedure ktbBarToolButtonDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean; NumberOfButton: Integer);
procedure ktbBarToolButtonEndDrag(Sender, Target: TObject; X, Y: Integer;
NumberOfButton: Integer);
procedure ktbBarToolButtonMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer; NumberOfButton: Integer);
procedure ktbBarToolButtonMouseMove(Sender: TObject; Shift: TShiftState; X,
@ -222,6 +220,9 @@ begin
edtToolTip.Text:= '-'
else if edtToolTip.Text= '-' then
edtToolTip.Text:= EmptyStr;
if LastToolButton > -1 then
if (ktbBar.Buttons[LastToolButton].Down = True) and (kedtIconFileName.Caption = '') then
ktbBar.Buttons[LastToolButton].Glyph.Assign(ktbBarLoadButtonGlyph(edtToolTip.Text, ktbBar.GlyphSize, Color));
end;
procedure TfrmConfigToolBar.edtToolTipChange(Sender: TObject);
@ -347,14 +348,24 @@ function TfrmConfigToolBar.ktbBarLoadButtonGlyph(sIconFileName: String;
iIconSize: Integer; clBackColor: TColor): TBitmap;
begin
Result := PixMapManager.LoadBitmapEnhanced(sIconFileName, iIconSize, clBackColor);
if (sIconFileName = '-') then // Paint 'separator' icon
begin
Result := TBitmap.Create;
Result.SetSize(iIconSize,iIconSize);
Result.Canvas.Brush.Color:= clBtnFace;
Result.Canvas.FillRect(Rect(0,0,iIconSize,iIconSize));
Result.Canvas.Brush.Color:= clBtnText;
Result.Canvas.RoundRect(Rect(Round(iIconSize * 0.4), 2, Round(iIconSize * 0.6), iIconSize - 2),iIconSize div 8,iIconSize div 4);
end;
end;
(*Select button on panel*)
procedure TfrmConfigToolBar.ktbBarToolButtonClick(Sender: TObject; NumberOfButton : Integer);
begin
LastToolButton := NumberOfButton;
LoadButton(NumberOfButton);
ktbBar.Buttons[NumberOfButton].Down:=True;
LastToolButton := NumberOfButton;
WakeSleepControls;
end;
@ -397,7 +408,7 @@ if edtToolTip.Text= '-' then
lblToolTip.Enabled := MakeEnabled;
edtToolTip.Enabled := MakeEnabled;
edtToolTip.Color := EditBarsColor;
cbIsSeparator.Enabled := MakeEnabled;
cbIsSeparator.Checked := edtToolTip.Text='-';
btnCloneButton.Enabled := MakeEnabled;
btnDeleteButton.Enabled := MakeEnabled;
btnAppendButton.Caption:= AddButtonName;
@ -419,9 +430,9 @@ begin
cbCommand.Text := ktbBar.GetButtonX(NumberOfButton,CmdX);
kedtIconFileName.Text := ktbBar.GetButtonX(NumberOfButton,ButtonX);
edtToolTip.Text := ktbBar.GetButtonX(NumberOfButton,MenuX);
sbIconExample.Glyph := ktbBar.Buttons[NumberOfButton].Glyph;
edtParams.Text:= ktbBar.GetButtonX(NumberOfButton,ParamX);
edtStartPath.Text:= ktbBar.GetButtonX(NumberOfButton,PathX);
sbIconExample.Glyph := ktbBar.Buttons[NumberOfButton].Glyph;
end;
procedure TfrmConfigToolBar.CopyButton(SourceButton, DestinationButton: Integer);
@ -442,11 +453,11 @@ begin
if (LastToolButton >= 0) and (ktbBar.ButtonCount > 0) then
begin
//---------------------
ktbBar.SetButtonX(LastToolButton,MenuX,edtToolTip.Text);
ktbBar.SetButtonX(LastToolButton,CmdX,cbCommand.Text);
ktbBar.SetButtonX(LastToolButton,ParamX,edtParams.Text);
ktbBar.SetButtonX(LastToolButton,PathX,edtStartPath.Text);
ktbBar.SetButtonX(LastToolButton,ButtonX,kedtIconFileName.Text);
ktbBar.SetButtonX(LastToolButton,MenuX,edtToolTip.Text);
//---------------------
end;
end;
@ -496,28 +507,27 @@ begin
end;
end;
(* Select button after it is dragged*)
procedure TfrmConfigToolBar.ktbBarToolButtonDragDrop(Sender, Source: TObject;
X, Y: Integer; NumberOfButton: Integer);
begin
ktbBar.MoveButton((Source as TSpeedButton).Tag, (Sender as TSpeedButton).Tag);
tbScrollBoxClick(Sender);
ktbBarToolButtonClick(Sender, NumberOfButton)
end;
(* Move button if it is dragged*)
procedure TfrmConfigToolBar.ktbBarToolButtonDragOver(Sender, Source: TObject;
X, Y: Integer; State: TDragState; var Accept: Boolean; NumberOfButton: Integer);
begin
// Some type checks to be here
if ((Sender as TSpeedButton).Tag) <> ((Source as TSpeedButton).Tag) then
Accept:=True;
end;
procedure TfrmConfigToolBar.ktbBarToolButtonEndDrag(Sender, Target: TObject; X,
Y: Integer; NumberOfButton: Integer);
begin
if not (Source is TSpeedButton) then exit;
if (ToolDragButtonNumber <>(Sender as TSpeedButton).Tag) then
begin
ktbBar.MoveButton((Source as TSpeedButton).Tag, (Sender as TSpeedButton).Tag);
ToolDragButtonNumber := (Sender as TSpeedButton).Tag;
Accept:=True;
end;
end;
(* Do not start drag in here, because oterwise button wouldn't be pushed down*)
procedure TfrmConfigToolBar.ktbBarToolButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer;
NumberOfButton: Integer);
@ -527,6 +537,7 @@ begin
ToolButtonMouseY:=Y;
end;
(* Start dragging only if mbLeft if pressed and mouse moved.*)
procedure TfrmConfigToolBar.ktbBarToolButtonMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer; NumberOfButton: Integer);
begin
@ -538,6 +549,7 @@ begin
end;
end;
(* End button drag*)
procedure TfrmConfigToolBar.ktbBarToolButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer;
NumberOfButton: Integer);
@ -588,15 +600,16 @@ begin
end;
end;
// Deselect any selected button
procedure TfrmConfigToolBar.tbScrollBoxClick(Sender: TObject);
begin
ClearControls;
LastToolButton := GetSelectedButton;
if LastToolButton > -1 then
begin
ktbBar.Buttons[LastToolButton].Down:=False;
LastToolButton := -1;
end;
ClearControls;
WakeSleepControls;
end;