pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

TvPlanIt: Fix drag-and-drop in TNavBar.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8916 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-08-07 13:32:47 +00:00
parent 110ffd365b
commit ab24065d59
4 changed files with 92 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
components/tvplanit/examples/navbar/project1.lpi
View File

@ -61,11 +61,6 @@
<Debugging> <Debugging>
<DebugInfoType Value="dsDwarf2Set"/> <DebugInfoType Value="dsDwarf2Set"/>
</Debugging> </Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking> </Linking>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>

5
components/tvplanit/examples/navbar/unit1.lfm
View File

@ -135,6 +135,7 @@ object Form1: TForm1
SelectedItemFont.Style = [fsBold] SelectedItemFont.Style = [fsBold]
ShowButtons = True ShowButtons = True
SoundAlias = 'c:\windows\media\tada.wav' SoundAlias = 'c:\windows\media\tada.wav'
OnFolderClick = VpNavBar1FolderClick
OnItemClick = VpNavBar1ItemClick OnItemClick = VpNavBar1ItemClick
OnFolderChanged = VpNavBar1FolderChanged OnFolderChanged = VpNavBar1FolderChanged
Align = alLeft Align = alLeft
@ -678,8 +679,8 @@ object Form1: TForm1
object Images: TImageList object Images: TImageList
Height = 32 Height = 32
Width = 32 Width = 32
Left = 400 Left = 48
Top = 32 Top = 360
Bitmap = { Bitmap = {
4C7A0A0000002000000020000000492E00000000000078DAED5D075815C7DADE 4C7A0A0000002000000020000000492E00000000000078DAED5D075815C7DADE
5C35E5BF496E921B4D4CEED514D3AE2651D3ED1A5B9AB1C4DE638D8A26D8B10B 5C35E5BF496E921B4D4CEED514D3AE2651D3ED1A5B9AB1C4DE638D8A26D8B10B

18
components/tvplanit/examples/navbar/unit1.pas
View File

@ -67,6 +67,8 @@ type
procedure GbIconClick(Sender: TObject); procedure GbIconClick(Sender: TObject);
procedure RbBkColorChange(Sender: TObject); procedure RbBkColorChange(Sender: TObject);
procedure VpNavBar1FolderChanged(Sender: TObject; Index: Integer); procedure VpNavBar1FolderChanged(Sender: TObject; Index: Integer);
procedure VpNavBar1FolderClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; Index: Integer);
procedure VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton; procedure VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; Index: Integer); Shift: TShiftState; Index: Integer);
private private
@ -251,6 +253,8 @@ begin
EdBkImage.ButtonWidth := EdBkImage.Height; EdBkImage.ButtonWidth := EdBkImage.Height;
EdSoundFile.ButtonWidth := EdSoundFile.Height; EdSoundFile.ButtonWidth := EdSoundFile.Height;
VpNavBar1.DragMarkerColor := clWhite;
end; end;
procedure TForm1.IconsLinkClick(Sender: TObject); procedure TForm1.IconsLinkClick(Sender: TObject);
@ -310,10 +314,18 @@ procedure TForm1.VpNavBar1FolderChanged(Sender: TObject; Index: Integer);
var var
folder: TVpNavFolder; folder: TVpNavFolder;
begin begin
// GbIcon.OnClick := nil;
folder := VpNavBar1.Folders[Index]; folder := VpNavBar1.Folders[Index];
cmbIconSize.ItemIndex := ord(folder.IconSize); cmbIconSize.ItemIndex := ord(folder.IconSize);
// GbIcon.OnClick := @RgIconSizeClick; end;
procedure TForm1.VpNavBar1FolderClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; Index: Integer);
var
folder: TVpNavFolder;
begin
folder := VpNavBar1.Folders[Index];
Label1.Caption := Format('Folder "%s" clicked.', [folder.Caption]);
end; end;
procedure TForm1.VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton; procedure TForm1.VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton;
@ -324,7 +336,7 @@ var
begin begin
folder := VpNavBar1.Folders[VpNavBar1.ActiveFolder]; folder := VpNavBar1.Folders[VpNavBar1.ActiveFolder];
item := folder.Items[Index]; item := folder.Items[Index];
Label1.Caption := Format('Item "%s" clicked', [item.Caption]); Label1.Caption := Format('Item "%s" clicked.', [item.Caption]);
end; end;
end. end.

114
components/tvplanit/source/vpnavbar.pas
View File

@ -242,7 +242,7 @@ type
nabOverButton: Boolean; nabOverButton: Boolean;
nabScrollDownBtn: TSpeedButton; nabScrollDownBtn: TSpeedButton;
nabScrollUpBtn: TSpeedButton; nabScrollUpBtn: TSpeedButton;
nabTimer: Integer; {timer-pool handle} // nabTimer: Integer; {timer-pool handle}
nabExternalDragItem: Integer; nabExternalDragItem: Integer;
nabFolderAccept: Boolean; nabFolderAccept: Boolean;
nabItemAccept: Boolean; nabItemAccept: Boolean;
@ -286,7 +286,7 @@ type
procedure nabScrollUpBtnClick(Sender: TObject); procedure nabScrollUpBtnClick(Sender: TObject);
function nabShowScrollUp: Boolean; function nabShowScrollUp: Boolean;
function nabShowScrollDown: Boolean; function nabShowScrollDown: Boolean;
procedure nabTimerEvent(Sender: TObject; Handle: Integer; Interval: Cardinal; ElapsedTime: LongInt); // procedure nabTimerEvent(Sender: TObject; Handle: Integer; Interval: Cardinal; ElapsedTime: LongInt);
procedure nabProcessContainers; procedure nabProcessContainers;
{VCL message methods} {VCL message methods}
@ -306,7 +306,7 @@ type
{windows message response methods} {windows message response methods}
procedure WMEraseBkGnd(var Msg: TLMEraseBkGnd); message LM_ERASEBKGND; procedure WMEraseBkGnd(var Msg: TLMEraseBkGnd); message LM_ERASEBKGND;
procedure WMNCHitTest(var Msg: TLMNCHitTest); message LM_NCHITTEST; procedure WMNCHitTest(var Msg: TLMNCHitTest); message LM_NCHITTEST;
procedure WMSetCursor(var Msg: TLMSetCursor); message LM_SETCURSOR; // procedure WMSetCursor(var Msg: TLMSetCursor); message LM_SETCURSOR;
{$IF LCL_FullVersion >= 1080000} {$IF LCL_FullVersion >= 1080000}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override; const AXProportion, AYProportion: Double); override;
@ -1126,7 +1126,7 @@ begin
nabDragFromItem := -1; nabDragFromItem := -1;
nabDragFromFolder := -1; nabDragFromFolder := -1;
nabDropY := -1; nabDropY := -1;
nabTimer := -1; // nabTimer := -1;
nabLastMouseOverItem := -1; nabLastMouseOverItem := -1;
end; end;
{=====} {=====}
@ -1815,7 +1815,7 @@ begin
end; end;
end; end;
{=====} {=====}
(*
procedure TVpCustomNavBar.nabTimerEvent(Sender: TObject; Handle: Integer; procedure TVpCustomNavBar.nabTimerEvent(Sender: TObject; Handle: Integer;
Interval: Cardinal; ElapsedTime: LongInt); Interval: Cardinal; ElapsedTime: LongInt);
var var
@ -1862,6 +1862,7 @@ begin
end; end;
end; end;
end; end;
*)
{=====} {=====}
procedure TVpCustomNavBar.DblClick; procedure TVpCustomNavBar.DblClick;
@ -1911,8 +1912,12 @@ begin
if Folders[FActiveFolder].Enabled or (csDesigning in ComponentState) then if Folders[FActiveFolder].Enabled or (csDesigning in ComponentState) then
begin begin
if (Button = mbLeft) then begin if (Button = mbLeft) then begin
InvalidateItem(FActiveFolder, FPreviousItem); // Begin dragging here
BeginDrag(false, 3);
nabMouseDown := True; nabMouseDown := True;
nabDragFromFolder := FActiveFolder;
nabDragFromItem := FActiveItem;
InvalidateItem(FActiveFolder, FPreviousItem);
end; end;
end; end;
end; end;
@ -1955,19 +1960,19 @@ begin
end; end;
if (FActiveItem <> -1) and (ItemIndex = -1) and FAllowRearrange then if (FActiveItem <> -1) and (ItemIndex = -1) and FAllowRearrange then
begin begin
nabDragFromFolder := FActiveFolder; // nabDragFromFolder := FActiveFolder;
nabDragFromItem := FActiveItem; // nabDragFromItem := FActiveItem;
if (FolderIndex = -1) then begin if (FolderIndex = -1) then begin
if nabDropHitTest(X, Y) then if nabDropHitTest(X, Y) then
SetCursor(Screen.Cursors[DragCursor]) // SetCursor(Screen.Cursors[DragCursor])
else begin else begin
SetCursor(Screen.Cursors[crNoDrop]); // SetCursor(Screen.Cursors[crNoDrop]);
nabDropY := -1; nabDropY := -1;
Repaint; Repaint;
end; end;
end; end;
end; end;
if (FolderIndex <> -1) and FAllowRearrange then if (FolderIndex <> -1) and FAllowRearrange and Dragging then
begin begin
ActiveFolder := FolderIndex; ActiveFolder := FolderIndex;
nabDropY := -1; nabDropY := -1;
@ -2024,10 +2029,6 @@ procedure TVpCustomNavBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
var var
FolderIndex: Integer; FolderIndex: Integer;
ItemIndex: Integer; ItemIndex: Integer;
Folder: TVpNavFolder;
Item: TVpNavBtnItem;
FromItem: TVpNavBtnItem;
SourceName: string;
begin begin
if nabMouseDown then begin if nabMouseDown then begin
try try
@ -2040,27 +2041,8 @@ begin
DoItemClick(Button, Shift, ItemIndex); DoItemClick(Button, Shift, ItemIndex);
end; end;
if nabDragFromItem <> -1 then begin { Fire the OnFolderClick event. }
if nabDropHitTest(X, Y) then begin
{get the old item}
Folder := Folders[nabDragFromFolder];
FromItem := TVpNavBtnItem(Folder.Items[nabDragFromItem]);
{create the new item}
Folder := Folders[nabDragToFolder];
Item := TVpNavBtnItem(Folder.FItems.Insert(nabDragToItem));
Item.Assign(FromItem);
SourceName := FromItem.Name;
FromItem.Free;
Item.Name := SourceName;
nabRecalcDisplayNames;
DoArrange;
end;
nabDragFromFolder := -1;
nabDragFromItem := -1;
end;
if (ItemIndex = -1) then begin if (ItemIndex = -1) then begin
{ Fire the OnFolderClick event. }
DoFolderClick(Button, Shift, FolderIndex); DoFolderClick(Button, Shift, FolderIndex);
ActiveFolder := FolderIndex; ActiveFolder := FolderIndex;
end; end;
@ -3034,7 +3016,7 @@ begin
nabHitTest.Y := Msg.Pos.Y; nabHitTest.Y := Msg.Pos.Y;
end; end;
{=====} {=====}
(*
{$IFDEF LCL} {$IFDEF LCL}
procedure TVpCustomNavBar.WMSetCursor(var Msg: TLMSetCursor); procedure TVpCustomNavBar.WMSetCursor(var Msg: TLMSetCursor);
{$ELSE} {$ELSE}
@ -3061,6 +3043,7 @@ begin
inherited; inherited;
end; end;
{=====} {=====}
*)
{ Overridden DragOver method. } { Overridden DragOver method. }
procedure TVpCustomNavBar.DragOver(Source: TObject; X, Y: Integer; procedure TVpCustomNavBar.DragOver(Source: TObject; X, Y: Integer;
@ -3069,6 +3052,7 @@ var
ItemIndex: Integer; ItemIndex: Integer;
FolderIndex: Integer; FolderIndex: Integer;
begin begin
(*
{ If State is dsDragLeave then the user has dragged } { If State is dsDragLeave then the user has dragged }
{ outside us. Invalidate the component to get rid } { outside us. Invalidate the component to get rid }
{ of any left-over drawing and exit. } { of any left-over drawing and exit. }
@ -3079,16 +3063,18 @@ begin
nabMouseDown := False; nabMouseDown := False;
nabChanging := False; nabChanging := False;
nabTopItem := 0; nabTopItem := 0;
nabDragFromItem := -1; // nabDragFromItem := -1;
nabDragFromFolder := -1; // nabDragFromFolder := -1;
Invalidate; Invalidate;
nabAcceptAny := False; nabAcceptAny := False;
inherited DragOver(Source, X, Y, State, nabAcceptAny); inherited DragOver(Source, X, Y, State, nabAcceptAny);
Exit; Exit;
end; end;
*)
nabFolderAccept := True; nabFolderAccept := True;
nabItemAccept := True; nabItemAccept := True;
{ Call the user's OnDragOver. } { Call the user's OnDragOver. }
if Assigned(FOnDragOver) then if Assigned(FOnDragOver) then
FOnDragOver(Self, Source, X, Y, State, nabFolderAccept, nabItemAccept); FOnDragOver(Self, Source, X, Y, State, nabFolderAccept, nabItemAccept);
@ -3110,7 +3096,7 @@ begin
Accept := nabFolderAccept or nabItemAccept; Accept := nabFolderAccept or nabItemAccept;
if nabFolderAccept or nabItemAccept then begin if nabFolderAccept or nabItemAccept then begin
nabGetHitTest(X, Y, FolderIndex, ItemIndex); nabGetHitTest(X, Y, FolderIndex, ItemIndex);
nabDropHitTest(X, Y); Accept := nabDropHitTest(X, Y);
nabExternalDrag := True; nabExternalDrag := True;
{ Change folder if necessary. } { Change folder if necessary. }
if (FolderIndex <> -1) and (FolderIndex <> FActiveFolder) then if (FolderIndex <> -1) and (FolderIndex <> FActiveFolder) then
@ -3123,9 +3109,56 @@ end;
{=====} {=====}
procedure TVpCustomNavBar.DragDrop(Source: TObject; X, Y: Integer); procedure TVpCustomNavBar.DragDrop(Source: TObject; X, Y: Integer);
var
FolderIndex: Integer;
ItemIndex: Integer;
Folder: TVpNavFolder;
Item: TVpNavBtnItem;
FromItem: TVpNavBtnItem;
SourceName: string;
begin begin
if Assigned(FOnDragDrop) then if Assigned(FOnDragDrop) then
FOnDragDrop(Self, Source, X, Y, FActiveFolder, nabExternalDragItem); FOnDragDrop(Self, Source, X, Y, FActiveFolder, nabExternalDragItem);
nabGetHitTest(X, Y, FolderIndex, ItemIndex);
if (FActiveItem <> -1) and (ItemIndex <> -1) then begin
FSelectedItem := ItemIndex;
InvalidateItem(FActiveFolder, ItemIndex);
{
if FActiveItem = ItemIndex then
DoItemClick(Button, Shift, ItemIndex);
}
end;
if nabDragFromItem <> -1 then begin
if nabDropHitTest(X, Y) then begin
{get the old item}
Folder := Folders[nabDragFromFolder];
FromItem := TVpNavBtnItem(Folder.Items[nabDragFromItem]);
{create the new item}
Folder := Folders[nabDragToFolder];
Item := TVpNavBtnItem(Folder.FItems.Insert(nabDragToItem));
Item.Assign(FromItem);
SourceName := FromItem.Name;
FromItem.Free;
Item.Name := SourceName;
nabRecalcDisplayNames;
DoArrange;
end;
nabDragFromFolder := -1;
nabDragFromItem := -1;
end;
(*
if (ItemIndex = -1) then begin
{ Fire the OnFolderClick event. }
DoFolderClick(Button, Shift, FolderIndex);
ActiveFolder := FolderIndex;
end;
*)
// Invalidate;
nabExternalDrag := False; nabExternalDrag := False;
nabFolderAccept := False; nabFolderAccept := False;
nabItemAccept := False; nabItemAccept := False;
@ -3133,7 +3166,8 @@ begin
nabChanging := False; nabChanging := False;
nabTopItem := 0; nabTopItem := 0;
nabDragFromFolder := -1; nabDragFromFolder := -1;
Invalidate; // Invalidate;
inherited DragDrop(Source, X, Y); inherited DragDrop(Source, X, Y);
end; end;
{=====} {=====}