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>
<DebugInfoType Value="dsDwarf2Set"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>

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

@ -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

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

@ -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.

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

@ -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;
{=====}