Skip to content

Commit 9afc60f

Browse files
committed
fix: enable drag'n drop in table editor and session manager
This failed previously as the VT.OnDragDrop event inserts a "use ActiveX" on Windows, which is not available on Linux. Use laz.FakeActiveX on Linux instead. https://forum.lazarus.freepascal.org/index.php?topic=40061.0
1 parent 4c0617d commit 9afc60f

File tree

4 files changed

+130
-14
lines changed

4 files changed

+130
-14
lines changed

source/connections.lfm

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1118,6 +1118,8 @@ object connform: Tconnform
11181118
OnBeforeCellPaint = ListSessionsBeforeCellPaint
11191119
OnCompareNodes = ListSessionsCompareNodes
11201120
OnCreateEditor = ListSessionsCreateEditor
1121+
OnDragOver = ListSessionsDragOver
1122+
OnDragDrop = ListSessionsDragDrop
11211123
OnFocusChanged = ListSessionsFocusChanged
11221124
OnFocusChanging = ListSessionsFocusChanging
11231125
OnGetText = ListSessionsGetText

source/connections.pas

Lines changed: 15 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ interface
1212
uses
1313
SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls,
1414
laz.VirtualTrees, Menus, Graphics, extra_controls, lazaruscompat,
15+
{$IFDEF Windows} ActiveX {$ELSE} laz.FakeActiveX {$ENDIF},
1516
dbconnection, RegExpr, Types, FileUtil,
1617
Math, ActnList, ComboEx, EditBtn, Buttons, ColorBox, extfiledialog;
1718

@@ -181,12 +182,12 @@ Tconnform = class(TExtForm)
181182
procedure timerSettingsImportTimer(Sender: TObject);
182183
procedure ListSessionsStructureChange(Sender: TBaseVirtualTree;
183184
Node: PVirtualNode; Reason: TChangeReason);
184-
{procedure ListSessionsDragOver(Sender: TBaseVirtualTree; Source: TObject;
185-
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
186-
var Effect: Integer; var Accept: Boolean);}
187-
{procedure ListSessionsDragDrop(Sender: TBaseVirtualTree; Source: TObject;
185+
procedure ListSessionsDragOver(Sender: TBaseVirtualTree; Source: TObject;
186+
Shift: TShiftState; State: TDragState; const Pt: TPoint; Mode: TDropMode;
187+
var Effect: LongWord; var Accept: Boolean);
188+
procedure ListSessionsDragDrop(Sender: TBaseVirtualTree; Source: TObject;
188189
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
189-
const Pt: TPoint; var Effect: LongWord; Mode: TDropMode);}
190+
const Pt: TPoint; var Effect: LongWord; Mode: TDropMode);
190191
procedure btnMoreClick(Sender: TObject);
191192
procedure menuRenameClick(Sender: TObject);
192193
procedure TimerButtonAnimationTimer(Sender: TObject);
@@ -908,9 +909,9 @@ procedure Tconnform.ListSessionsCreateEditor(Sender: TBaseVirtualTree; Node: PVi
908909
end;
909910

910911

911-
{procedure Tconnform.ListSessionsDragDrop(Sender: TBaseVirtualTree; Source: TObject;
912-
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
913-
const Pt: TPoint; var Effect: LongWord; Mode: TDropMode);
912+
procedure Tconnform.ListSessionsDragDrop(Sender: TBaseVirtualTree;
913+
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
914+
Shift: TShiftState; const Pt: TPoint; var Effect: LongWord; Mode: TDropMode);
914915
var
915916
TargetNode, ParentNode: PVirtualNode;
916917
AttachMode: TVTNodeAttachMode;
@@ -920,7 +921,7 @@ procedure Tconnform.ListSessionsCreateEditor(Sender: TBaseVirtualTree; Node: PVi
920921
begin
921922
TargetNode := Sender.GetNodeAt(Pt.X, Pt.Y);
922923
if not Assigned(TargetNode) then begin
923-
MessageBeep(MB_ICONEXCLAMATION);
924+
Beep;
924925
Exit;
925926
end;
926927
TargetSess := Sender.GetNodeData(TargetNode);
@@ -959,12 +960,12 @@ procedure Tconnform.ListSessionsCreateEditor(Sender: TBaseVirtualTree; Node: PVi
959960
end;
960961
end;
961962
SiblingSessions.Free;
962-
end;}
963+
end;
963964

964965

965-
{procedure Tconnform.ListSessionsDragOver(Sender: TBaseVirtualTree;
966-
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
967-
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
966+
procedure Tconnform.ListSessionsDragOver(Sender: TBaseVirtualTree;
967+
Source: TObject; Shift: TShiftState; State: TDragState; const Pt: TPoint;
968+
Mode: TDropMode; var Effect: LongWord; var Accept: Boolean);
968969
var
969970
TargetNode, ParentNode: PVirtualNode;
970971
TargetSess: PConnectionParameters;
@@ -997,7 +998,7 @@ procedure Tconnform.ListSessionsCreateEditor(Sender: TBaseVirtualTree; Node: PVi
997998
// Shows the right tooltip on Aero GUI
998999
Effect := DROPEFFECT_MOVE;
9991000
end;
1000-
end;}
1001+
end;
10011002

10021003

10031004
procedure Tconnform.ListSessionsFocusChanged(Sender: TBaseVirtualTree;

source/table_editor.lfm

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -379,6 +379,7 @@ object frmTableEditor: TfrmTableEditor
379379
OnClick = AnyTreeClick
380380
OnCreateEditor = treeIndexesCreateEditor
381381
OnDragOver = treeIndexesDragOver
382+
OnDragDrop = treeIndexesDragDrop
382383
OnEditing = treeIndexesEditing
383384
OnFocusChanged = treeIndexesFocusChanged
384385
OnGetText = treeIndexesGetText
@@ -1089,6 +1090,7 @@ object frmTableEditor: TfrmTableEditor
10891090
OnClick = listColumnsClick
10901091
OnCreateEditor = listColumnsCreateEditor
10911092
OnDragOver = listColumnsDragOver
1093+
OnDragDrop = listColumnsDragDrop
10921094
OnEditing = listColumnsEditing
10931095
OnFocusChanged = listColumnsFocusChanged
10941096
OnGetText = listColumnsGetText

source/table_editor.pas

Lines changed: 111 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ interface
77
uses
88
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
99
ComCtrls, laz.VirtualTrees, RegExpr, ExtCtrls, SynEdit,
10+
{$IFDEF Windows} ActiveX {$ELSE} laz.FakeActiveX {$ENDIF},
1011
Menus, Clipbrd, Math, System.UITypes, Generics.Collections, LCLProc, LCLType,
1112
{grideditlinks,} dbstructures, dbstructures.mysql, dbconnection, apphelpers, StrUtils, extra_controls;
1213

@@ -111,6 +112,9 @@ TfrmTableEditor = class(TFrame)
111112
procedure btnMoveDownColumnClick(Sender: TObject);
112113
procedure listColumnsDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState;
113114
Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
115+
procedure listColumnsDragDrop(Sender: TBaseVirtualTree; Source: TObject;
116+
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
117+
const Pt: TPoint; var Effect: LongWord; Mode: TDropMode);
114118
procedure listColumnsPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode;
115119
Column: TColumnIndex; TextType: TVSTTextType);
116120
procedure listColumnsCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
@@ -136,6 +140,9 @@ TfrmTableEditor = class(TFrame)
136140
procedure treeIndexesDragOver(Sender: TBaseVirtualTree; Source: TObject;
137141
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
138142
var Effect: Integer; var Accept: Boolean);
143+
procedure treeIndexesDragDrop(Sender: TBaseVirtualTree; Source: TObject;
144+
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
145+
const Pt: TPoint; var Effect: LongWord; Mode: TDropMode);
139146
procedure treeIndexesNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: String);
140147
procedure treeIndexesEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
141148
procedure treeIndexesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
@@ -1194,6 +1201,30 @@ procedure TfrmTableEditor.listColumnsDragOver(Sender: TBaseVirtualTree;
11941201
end;
11951202

11961203

1204+
procedure TfrmTableEditor.listColumnsDragDrop(Sender: TBaseVirtualTree;
1205+
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
1206+
Shift: TShiftState; const Pt: TPoint; var Effect: LongWord; Mode: TDropMode);
1207+
var
1208+
ToNode: PVirtualNode;
1209+
ToCol, FocusedCol: PTableColumn;
1210+
NewIndex: NativeInt;
1211+
begin
1212+
ToNode := Sender.GetNodeAt(Pt.X, Pt.Y);
1213+
if Assigned(ToNode) then begin
1214+
FocusedCol := Sender.GetNodeData(Sender.FocusedNode);
1215+
ToCol := Sender.GetNodeData(ToNode);
1216+
NewIndex := FColumns.IndexOf(ToCol^);
1217+
if Mode = dmBelow then
1218+
Inc(NewIndex);
1219+
FColumns.Move(FColumns.IndexOf(FocusedCol^), NewIndex);
1220+
FocusedCol.Status := esModified;
1221+
Modification(Sender);
1222+
Sender.SortTree(listColumns.Header.SortColumn, listColumns.Header.SortDirection);
1223+
ValidateColumnControls;
1224+
end;
1225+
end;
1226+
1227+
11971228
procedure TfrmTableEditor.listColumnsBeforeCellPaint(Sender: TBaseVirtualTree;
11981229
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
11991230
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
@@ -2394,6 +2425,86 @@ procedure TfrmTableEditor.treeIndexesDragOver(Sender: TBaseVirtualTree;
23942425
end;
23952426

23962427

2428+
procedure TfrmTableEditor.treeIndexesDragDrop(Sender: TBaseVirtualTree;
2429+
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
2430+
Shift: TShiftState; const Pt: TPoint; var Effect: LongWord; Mode: TDropMode);
2431+
var
2432+
FocusedNode, TargetNode, IndexNode: PVirtualNode;
2433+
ColName, PartLength: String;
2434+
ColPos: Cardinal;
2435+
VT, SourceVT: TlazVirtualStringtree;
2436+
Col: PTableColumn;
2437+
TblKey: TTableKey;
2438+
begin
2439+
// Column node dropped here
2440+
VT := Sender as TlazVirtualStringtree;
2441+
SourceVT := Source as TlazVirtualStringtree;
2442+
TargetNode := VT.GetNodeAt(Pt.X, Pt.Y);
2443+
FocusedNode := VT.FocusedNode;
2444+
IndexNode := nil;
2445+
ColPos := 0;
2446+
if not Assigned(TargetNode) then begin
2447+
Beep;
2448+
Exit;
2449+
end;
2450+
Mainform.LogSQL('TargetNode.Index: '+TargetNode.Index.ToString, lcDebug);
2451+
2452+
case VT.GetNodeLevel(TargetNode) of
2453+
0: begin
2454+
// DragOver only accepts dmOnNode in root tree level
2455+
IndexNode := TargetNode;
2456+
ColPos := IndexNode.ChildCount;
2457+
end;
2458+
2459+
1: begin
2460+
IndexNode := TargetNode.Parent;
2461+
// Find the right new position for the dropped column
2462+
ColPos := TargetNode.Index;
2463+
if Source = Sender then begin
2464+
// Drop within index tree: Take care if user dragged from above or from below the target node
2465+
if FocusedNode <> nil then begin
2466+
if (FocusedNode.Index < TargetNode.Index) and (Mode = dmAbove) and (ColPos > 0) then
2467+
Dec(ColPos);
2468+
if (FocusedNode.Index > TargetNode.Index) and (Mode = dmBelow) and (ColPos < IndexNode.ChildCount-1) then
2469+
Inc(ColPos);
2470+
end;
2471+
end else begin
2472+
// Drop from columns list
2473+
if Mode = dmBelow then
2474+
Inc(ColPos);
2475+
end;
2476+
end;
2477+
2478+
end;
2479+
2480+
if Source = Sender then
2481+
MoveFocusedIndexPart(ColPos)
2482+
else begin
2483+
TblKey := FKeys[IndexNode.Index];
2484+
Col := SourceVT.GetNodeData(SourceVT.FocusedNode);
2485+
ColName := Col.Name;
2486+
if TblKey.Columns.IndexOf(ColName) > -1 then begin
2487+
if MessageDialog(_('Add duplicated column to index?'),
2488+
f_('Index "%s" already contains the column "%s". It is possible to add a column twice into a index, but total nonsense in practice.', [VT.Text[IndexNode, 0], ColName]),
2489+
mtConfirmation, [mbYes, mbNo]) = mrNo then
2490+
Exit;
2491+
end;
2492+
2493+
TblKey.Columns.Insert(ColPos, ColName);
2494+
PartLength := '';
2495+
if (not TblKey.IsFulltext) and (Col.DataType.Index in [dbdtTinyText, dbdtText, dbdtMediumText, dbdtLongText, dbdtTinyBlob, dbdtBlob, dbdtMediumBlob, dbdtLongBlob]) then
2496+
PartLength := '100';
2497+
TblKey.Subparts.Insert(ColPos, PartLength);
2498+
TblKey.Collations.Insert(ColPos, 'A');
2499+
IndexNode.States := IndexNode.States + [vsHasChildren, vsExpanded];
2500+
end;
2501+
Modification(Sender);
2502+
// Finally tell parent node to update its children
2503+
VT.ReinitChildren(IndexNode, False);
2504+
VT.Repaint;
2505+
end;
2506+
2507+
23972508
procedure TfrmTableEditor.btnMoveUpIndexClick(Sender: TObject);
23982509
begin
23992510
// Move index part up

0 commit comments

Comments
 (0)