From ab24065d598e5b44b8ff80c686c97bf0993e2985 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 7 Aug 2023 13:32:47 +0000 Subject: [PATCH] TvPlanIt: Fix drag-and-drop in TNavBar. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8916 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../tvplanit/examples/navbar/project1.lpi | 5 - components/tvplanit/examples/navbar/unit1.lfm | 5 +- components/tvplanit/examples/navbar/unit1.pas | 18 ++- components/tvplanit/source/vpnavbar.pas | 114 ++++++++++++------ 4 files changed, 92 insertions(+), 50 deletions(-) diff --git a/components/tvplanit/examples/navbar/project1.lpi b/components/tvplanit/examples/navbar/project1.lpi index 559083187..623c96e4d 100644 --- a/components/tvplanit/examples/navbar/project1.lpi +++ b/components/tvplanit/examples/navbar/project1.lpi @@ -61,11 +61,6 @@ - - - - - diff --git a/components/tvplanit/examples/navbar/unit1.lfm b/components/tvplanit/examples/navbar/unit1.lfm index ef6f524b5..0361f4e0b 100644 --- a/components/tvplanit/examples/navbar/unit1.lfm +++ b/components/tvplanit/examples/navbar/unit1.lfm @@ -135,6 +135,7 @@ object Form1: TForm1 SelectedItemFont.Style = [fsBold] ShowButtons = True SoundAlias = 'c:\windows\media\tada.wav' + OnFolderClick = VpNavBar1FolderClick OnItemClick = VpNavBar1ItemClick OnFolderChanged = VpNavBar1FolderChanged Align = alLeft @@ -678,8 +679,8 @@ object Form1: TForm1 object Images: TImageList Height = 32 Width = 32 - Left = 400 - Top = 32 + Left = 48 + Top = 360 Bitmap = { 4C7A0A0000002000000020000000492E00000000000078DAED5D075815C7DADE 5C35E5BF496E921B4D4CEED514D3AE2651D3ED1A5B9AB1C4DE638D8A26D8B10B diff --git a/components/tvplanit/examples/navbar/unit1.pas b/components/tvplanit/examples/navbar/unit1.pas index 5e3613eb7..e5b1c9a35 100644 --- a/components/tvplanit/examples/navbar/unit1.pas +++ b/components/tvplanit/examples/navbar/unit1.pas @@ -67,6 +67,8 @@ type procedure GbIconClick(Sender: TObject); procedure RbBkColorChange(Sender: TObject); procedure VpNavBar1FolderChanged(Sender: TObject; Index: Integer); + procedure VpNavBar1FolderClick(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; Index: Integer); procedure VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; Index: Integer); private @@ -251,6 +253,8 @@ begin EdBkImage.ButtonWidth := EdBkImage.Height; EdSoundFile.ButtonWidth := EdSoundFile.Height; + + VpNavBar1.DragMarkerColor := clWhite; end; procedure TForm1.IconsLinkClick(Sender: TObject); @@ -310,10 +314,18 @@ procedure TForm1.VpNavBar1FolderChanged(Sender: TObject; Index: Integer); var folder: TVpNavFolder; begin -// GbIcon.OnClick := nil; folder := VpNavBar1.Folders[Index]; 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; procedure TForm1.VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton; @@ -324,7 +336,7 @@ var begin folder := VpNavBar1.Folders[VpNavBar1.ActiveFolder]; item := folder.Items[Index]; - Label1.Caption := Format('Item "%s" clicked', [item.Caption]); + Label1.Caption := Format('Item "%s" clicked.', [item.Caption]); end; end. diff --git a/components/tvplanit/source/vpnavbar.pas b/components/tvplanit/source/vpnavbar.pas index 91de12759..61bdca6dc 100644 --- a/components/tvplanit/source/vpnavbar.pas +++ b/components/tvplanit/source/vpnavbar.pas @@ -242,7 +242,7 @@ type nabOverButton: Boolean; nabScrollDownBtn: TSpeedButton; nabScrollUpBtn: TSpeedButton; - nabTimer: Integer; {timer-pool handle} +// nabTimer: Integer; {timer-pool handle} nabExternalDragItem: Integer; nabFolderAccept: Boolean; nabItemAccept: Boolean; @@ -286,7 +286,7 @@ type procedure nabScrollUpBtnClick(Sender: TObject); function nabShowScrollUp: 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; {VCL message methods} @@ -306,7 +306,7 @@ type {windows message response methods} procedure WMEraseBkGnd(var Msg: TLMEraseBkGnd); message LM_ERASEBKGND; 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} procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override; @@ -1126,7 +1126,7 @@ begin nabDragFromItem := -1; nabDragFromFolder := -1; nabDropY := -1; - nabTimer := -1; +// nabTimer := -1; nabLastMouseOverItem := -1; end; {=====} @@ -1815,7 +1815,7 @@ begin end; end; {=====} - + (* procedure TVpCustomNavBar.nabTimerEvent(Sender: TObject; Handle: Integer; Interval: Cardinal; ElapsedTime: LongInt); var @@ -1862,6 +1862,7 @@ begin end; end; end; +*) {=====} procedure TVpCustomNavBar.DblClick; @@ -1911,8 +1912,12 @@ begin if Folders[FActiveFolder].Enabled or (csDesigning in ComponentState) then begin if (Button = mbLeft) then begin - InvalidateItem(FActiveFolder, FPreviousItem); + // Begin dragging here + BeginDrag(false, 3); nabMouseDown := True; + nabDragFromFolder := FActiveFolder; + nabDragFromItem := FActiveItem; + InvalidateItem(FActiveFolder, FPreviousItem); end; end; end; @@ -1955,19 +1960,19 @@ begin end; if (FActiveItem <> -1) and (ItemIndex = -1) and FAllowRearrange then begin - nabDragFromFolder := FActiveFolder; - nabDragFromItem := FActiveItem; +// nabDragFromFolder := FActiveFolder; +// nabDragFromItem := FActiveItem; if (FolderIndex = -1) then begin if nabDropHitTest(X, Y) then - SetCursor(Screen.Cursors[DragCursor]) +// SetCursor(Screen.Cursors[DragCursor]) else begin - SetCursor(Screen.Cursors[crNoDrop]); +// SetCursor(Screen.Cursors[crNoDrop]); nabDropY := -1; Repaint; end; end; end; - if (FolderIndex <> -1) and FAllowRearrange then + if (FolderIndex <> -1) and FAllowRearrange and Dragging then begin ActiveFolder := FolderIndex; nabDropY := -1; @@ -2024,10 +2029,6 @@ procedure TVpCustomNavBar.MouseUp(Button: TMouseButton; Shift: TShiftState; var FolderIndex: Integer; ItemIndex: Integer; - Folder: TVpNavFolder; - Item: TVpNavBtnItem; - FromItem: TVpNavBtnItem; - SourceName: string; begin if nabMouseDown then begin try @@ -2040,27 +2041,8 @@ begin 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; - + { Fire the OnFolderClick event. } if (ItemIndex = -1) then begin - { Fire the OnFolderClick event. } DoFolderClick(Button, Shift, FolderIndex); ActiveFolder := FolderIndex; end; @@ -3034,7 +3016,7 @@ begin nabHitTest.Y := Msg.Pos.Y; end; {=====} - + (* {$IFDEF LCL} procedure TVpCustomNavBar.WMSetCursor(var Msg: TLMSetCursor); {$ELSE} @@ -3061,6 +3043,7 @@ begin inherited; end; {=====} +*) { Overridden DragOver method. } procedure TVpCustomNavBar.DragOver(Source: TObject; X, Y: Integer; @@ -3069,6 +3052,7 @@ var ItemIndex: Integer; FolderIndex: Integer; begin + (* { If State is dsDragLeave then the user has dragged } { outside us. Invalidate the component to get rid } { of any left-over drawing and exit. } @@ -3079,16 +3063,18 @@ begin nabMouseDown := False; nabChanging := False; nabTopItem := 0; - nabDragFromItem := -1; - nabDragFromFolder := -1; +// nabDragFromItem := -1; +// nabDragFromFolder := -1; Invalidate; nabAcceptAny := False; inherited DragOver(Source, X, Y, State, nabAcceptAny); Exit; end; + *) nabFolderAccept := True; nabItemAccept := True; + { Call the user's OnDragOver. } if Assigned(FOnDragOver) then FOnDragOver(Self, Source, X, Y, State, nabFolderAccept, nabItemAccept); @@ -3110,7 +3096,7 @@ begin Accept := nabFolderAccept or nabItemAccept; if nabFolderAccept or nabItemAccept then begin nabGetHitTest(X, Y, FolderIndex, ItemIndex); - nabDropHitTest(X, Y); + Accept := nabDropHitTest(X, Y); nabExternalDrag := True; { Change folder if necessary. } if (FolderIndex <> -1) and (FolderIndex <> FActiveFolder) then @@ -3123,9 +3109,56 @@ end; {=====} procedure TVpCustomNavBar.DragDrop(Source: TObject; X, Y: Integer); +var + FolderIndex: Integer; + ItemIndex: Integer; + Folder: TVpNavFolder; + Item: TVpNavBtnItem; + FromItem: TVpNavBtnItem; + SourceName: string; begin if Assigned(FOnDragDrop) then 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; nabFolderAccept := False; nabItemAccept := False; @@ -3133,7 +3166,8 @@ begin nabChanging := False; nabTopItem := 0; nabDragFromFolder := -1; - Invalidate; +// Invalidate; + inherited DragDrop(Source, X, Y); end; {=====}