From 1562d76b6bbfe8e50bb8141c6fae1c4ef78419ae Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 9 Jun 2025 16:58:54 +0200 Subject: [PATCH] Update VirtualTreeView component code to v8.1.2 from May 30, 2025 --- components/virtualtreeview/INSTALL.txt | 53 +- components/virtualtreeview/MAKEFILE | 10 +- components/virtualtreeview/MakeRelease.Bat | 3 - components/virtualtreeview/README.md | 8 +- .../VirtualTrees.AccessibilityFactory.pas | 1 + .../Source/VirtualTrees.AncestorVcl.pas | 6 +- .../Source/VirtualTrees.BaseTree.pas | 1392 ++++++++--------- .../Source/VirtualTrees.ClipBoard.pas | 3 +- .../Source/VirtualTrees.DataObject.pas | 68 +- .../Source/VirtualTrees.DragImage.pas | 441 +----- .../Source/VirtualTrees.DragnDrop.pas | 78 +- .../Source/VirtualTrees.DrawTree.pas | 2 +- .../Source/VirtualTrees.FMX.pas | 15 +- .../Source/VirtualTrees.Header.pas | 192 +-- .../Source/VirtualTrees.Types.pas | 44 +- .../virtualtreeview/Source/VirtualTrees.pas | 19 +- .../Delphi11.1/VirtualTreeView.groupproj | 48 - .../packages/Delphi11.1/VirtualTreesD.dpk | 40 - .../packages/Delphi11.1/VirtualTreesD.dproj | 127 -- .../packages/Delphi11.1/VirtualTreesR.dpk | 56 - .../packages/Delphi11.1/VirtualTreesR.dproj | 145 -- .../Delphi11.2/VirtualTreeView.groupproj | 48 - .../packages/Delphi11.2/VirtualTreesD.dpk | 40 - .../packages/Delphi11.2/VirtualTreesD.dproj | 127 -- .../packages/Delphi11.2/VirtualTreesR.dpk | 60 - .../packages/Delphi11.2/VirtualTreesR.dproj | 147 -- .../RAD Studio 10.4+/VirtualTreesR.dpk | 2 +- .../RAD Studio 10.4+/VirtualTreesR.dproj | 7 +- packages/Delphi11.1/heidisql.dpr | 115 -- packages/Delphi11.1/heidisql.dproj | 1192 -------------- packages/Delphi11.1/heidisql.groupproj | 96 -- packages/Delphi11.1/heidisql.mes | 164 -- packages/Delphi11.2/heidisql.dpr | 117 -- packages/Delphi11.2/heidisql.dproj | 1184 -------------- packages/Delphi11.2/heidisql.groupproj | 96 -- packages/Delphi11.2/heidisql.mes | 164 -- packages/Delphi12.1/heidisql.groupproj | 16 +- 37 files changed, 984 insertions(+), 5342 deletions(-) delete mode 100644 components/virtualtreeview/MakeRelease.Bat delete mode 100644 components/virtualtreeview/packages/Delphi11.1/VirtualTreeView.groupproj delete mode 100644 components/virtualtreeview/packages/Delphi11.1/VirtualTreesD.dpk delete mode 100644 components/virtualtreeview/packages/Delphi11.1/VirtualTreesD.dproj delete mode 100644 components/virtualtreeview/packages/Delphi11.1/VirtualTreesR.dpk delete mode 100644 components/virtualtreeview/packages/Delphi11.1/VirtualTreesR.dproj delete mode 100644 components/virtualtreeview/packages/Delphi11.2/VirtualTreeView.groupproj delete mode 100644 components/virtualtreeview/packages/Delphi11.2/VirtualTreesD.dpk delete mode 100644 components/virtualtreeview/packages/Delphi11.2/VirtualTreesD.dproj delete mode 100644 components/virtualtreeview/packages/Delphi11.2/VirtualTreesR.dpk delete mode 100644 components/virtualtreeview/packages/Delphi11.2/VirtualTreesR.dproj delete mode 100644 packages/Delphi11.1/heidisql.dpr delete mode 100644 packages/Delphi11.1/heidisql.dproj delete mode 100644 packages/Delphi11.1/heidisql.groupproj delete mode 100644 packages/Delphi11.1/heidisql.mes delete mode 100644 packages/Delphi11.2/heidisql.dpr delete mode 100644 packages/Delphi11.2/heidisql.dproj delete mode 100644 packages/Delphi11.2/heidisql.groupproj delete mode 100644 packages/Delphi11.2/heidisql.mes diff --git a/components/virtualtreeview/INSTALL.txt b/components/virtualtreeview/INSTALL.txt index 5bebc4c6..21ad1fe6 100644 --- a/components/virtualtreeview/INSTALL.txt +++ b/components/virtualtreeview/INSTALL.txt @@ -1,22 +1,27 @@ -Supported Delphi version: RAD Studio XE3 and higher -Supported Windows Versions: Windows Vista and higher +Supported Delphi version: RAD Studio 10.0 and higher +Supported Windows Versions: Windows 8 and higher Extract the entire(!) ZIP file and follow the instructions below. Delphi / RAD Studio 10.4 and higher Installation ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1. Open the project group "Packages\RAD Studio 10.4+\VirtualTreeView.groupproj" -2. Right click on "VirtualTreesD*.bpl" and click "Install" -3. Go to "Tools > Options > Language > Delphi Options > Library > Library Path > [...]" - Browse to the "Source" folder of VirtualTreeView, press "OK", "Add", "OK" - Do this for both Win32 and Win64 platform, which you can choose in the dropdown box. -4. C++ Builder users only: - In the Options dialog go to "Environment Options > C++ Options > Paths and Directories" - a) Click "Library Path > [...]" - Browse to the "Source" folder of VirtualTreeView, press "OK", "Add", "OK" - b) Click "System Include path > [...]" - Browse to the "Source" folder of VirtualTreeView, press "OK", "Add", "OK" -5. Close the RAD Studio Options dialog by clicking "Save". +2. Right click on root elelment "VirtualTreeView" and click "Build All" +3. Right click on "VirtualTreesD*.bpl" and click "Install" +4. Go to "Tools > Options > Language > Delphi Options > Library +5. Choose platform "Win32", click on "Library Path > [...]" + Browse to the "Packages\RAD Studio 10.4+\Win32\Release" folder of VirtualTreeView, + press "Choose Folder", "Add", "OK" +6. Choose platform "Win64", click on "Library Path > [...]" + Browse to the "Packages\RAD Studio 10.4+\Win64\Release" folder of VirtualTreeView, + press "Choose Folder", "Add", "OK" +7. C++ Builder users only: + In the Options dialog go to "Environment Options > C++ Options > Paths and Directories" + a) Click "Library Path > [...]" + Browse to the "Source" folder of VirtualTreeView, press "OK", "Add", "OK" + b) Click "System Include path > [...]" + Browse to the "Source" folder of VirtualTreeView, press "OK", "Add", "OK" +8. Close the RAD Studio Options dialog by clicking "Save". Delphi / RAD Studio 10.3 @@ -35,7 +40,7 @@ Delphi / RAD Studio 10.3 5. Close the RAD Studio Options dialog by clicking "Save". -Delphi / RAD Studio XE3 - 10.2 Installation +Delphi / RAD Studio 10.0 - 10.2 Installation ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1. Open the project group "Packages\RAD Studio *\VirtualTreeView.groupproj" 2. Right click on "VirtualTreesD*.bpl" and click "Install" @@ -62,21 +67,5 @@ In case you experience any problems, try to delete all these files from your dis I recommend using UltraSearch for this task: http://www.jam-software.de/ultrasearch/ -Please send comments and suggestions regarding the packages and the install -instructions to joachim.marder@gmail.com or open an issue. - - -C++ Builder XE3 and higher Installation -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1. Open the project group "Packages\CBuilder XE*\VirtualTreeView.groupproj" - that is closest to your version. -2. Right click on "VirtualTreesR*.bpl" and click "Build" -3. Right click on "VirtualTreesD*.bpl" and click "Install" -4. Go to "Tools > Options > Environment Options > Delphi Options > Library > Library Path > [...]" - Browse to the "Source" folder of VirtualTreeView, press "OK", "Add", "OK", "OK" -5. Go to "Tools > Options > Environment Options > C++ Options > Paths and Directories" - a) Click "Library Path > [...]" - Browse to the "Source" folder of VirtualTreeView, press "OK", "Add", "OK" - b) Click "System Include path > [...]" - Browse to the "Source" folder of VirtualTreeView, press "OK", "Add", "OK", "OK" -6. If you target Win64 you need to build VirtualTreesR*.bpl also for the platform "Win64" +For comments and suggestions regarding the packages and the install +instructions open an Issue at: https://github.com/JAM-Software/Virtual-TreeView/issues diff --git a/components/virtualtreeview/MAKEFILE b/components/virtualtreeview/MAKEFILE index a13eccc3..4c89b54b 100644 --- a/components/virtualtreeview/MAKEFILE +++ b/components/virtualtreeview/MAKEFILE @@ -33,6 +33,14 @@ clean: DEL /S /Q .\*.DCU #TODO: Add demos and package folders +12.3: Source\*.pas "Packages\RAD Studio 10.4+\$(PROJECT)R.dpk" "Packages\RAD Studio 10.4+\$(PROJECT)R.dproj" "Packages\RAD Studio 10.4+\$(PROJECT)D.dpk" "Packages\RAD Studio 10.4+\$(PROJECT)D.dproj" + SET BDS=$(STUDIO)\23.0 + $(BUILD) /property:Platform=Win32 "Packages\RAD Studio 10.4+\$(PROJECT)R.dproj" + $(BUILD) /property:Platform=Win32 "Packages\RAD Studio 10.4+\$(PROJECT)D.dproj" + $(BUILD) /property:Platform=Win64 "Packages\RAD Studio 10.4+\$(PROJECT)R.dproj" + $(BUILD) /property:Platform=Win64 "Packages\RAD Studio 10.4+\$(PROJECT)D.dproj" + $(MAKE) _samples + 12.0: Source\*.pas "Packages\RAD Studio 10.4+\$(PROJECT)R.dpk" "Packages\RAD Studio 10.4+\$(PROJECT)R.dproj" "Packages\RAD Studio 10.4+\$(PROJECT)D.dpk" "Packages\RAD Studio 10.4+\$(PROJECT)D.dproj" SET BDS=$(STUDIO)\23.0 $(BUILD) "Packages\RAD Studio 10.4+\$(PROJECT)R.dproj" @@ -62,7 +70,7 @@ clean: _samples: "Demos\Advanced\Advanced.exe" "Demos\Minimal\Minimal.exe" "Demos\Objects\Objects.exe" "Demos\OLE\OLE.exe" -_continuousbuilds: clean 12.0 +_continuousbuilds: clean 12.3 _release: #This small batch file is intended to create a source code release file of the VirtualTreeView as ZIP archive diff --git a/components/virtualtreeview/MakeRelease.Bat b/components/virtualtreeview/MakeRelease.Bat deleted file mode 100644 index b016c935..00000000 --- a/components/virtualtreeview/MakeRelease.Bat +++ /dev/null @@ -1,3 +0,0 @@ -@ECHO OFF -nmake _release -pause \ No newline at end of file diff --git a/components/virtualtreeview/README.md b/components/virtualtreeview/README.md index d4326232..a882caa8 100644 --- a/components/virtualtreeview/README.md +++ b/components/virtualtreeview/README.md @@ -5,9 +5,9 @@ Virtual Treeview is a Delphi treeview control built from ground up. Many years o I don't use C++ Builder and my experience with it is very limited. This makes it difficult to take care about bugs that are reported in C++ Builder and to maintain the C++ Builder packages. I would be great if someone would volunteer to do this. ### Downloads -**V7.6.x** official release for **Delphi XE3 to 11.3** and C++ Buildler 10.1 to 11.3: [JAM Software](https://www.jam-software.com/virtual-treeview/VirtualTreeView.zip) ([Changes](https://github.com/JAM-Software/Virtual-TreeView/releases/latest)) +[**V8** official release](https://github.com/JAM-Software/Virtual-TreeView/releases/latest) for **RAD Studio 10 to 12** which includes some **[breaking changes](https://github.com/JAM-Software/Virtual-TreeView/wiki/Breaking-Changes-in-V8)**. -In the master branch we develop **V8** that includes some **[breaking changes](https://github.com/JAM-Software/Virtual-TreeView/wiki/Breaking-Changes-in-upcoming-V8)**. +[**V7.6.x**](https://github.com/JAM-Software/Virtual-TreeView/releases/tag/V7.6.6) for **Delphi XE3 to XE8**. An experimental **FireMonkey** port can be found here: [livius2/Virtual-TreeView](https://github.com/livius2/Virtual-TreeView) @@ -15,9 +15,7 @@ A port to **Lazarus / FPC** can be found here: [blikblum/VirtualTreeView-Lazarus For a **Delphi XE2** compatible fork see: [Fr0sT-Brutal/VirtualTreeView_mod/tree/fr0st_xe2](https://github.com/Fr0sT-Brutal/VirtualTreeView_mod/tree/fr0st_xe2) -For a **Delphi XE** compatible fork see: [sglienke/Virtual-TreeView](https://github.com/sglienke/Virtual-TreeView) - -**V5.5.3** for **Delphi 7 to XE2**: [Download](https://downloads.jam-software.de/virtual-treeview/VirtualTreeViewV5.5.3.zip) +**V5.5.3** for **Delphi 7 to XE2**: [Download](https://github.com/JAM-Software/Virtual-TreeView/releases/download/V5.5.3/VirtualTreeViewV5.5.3.zip) **V6 latest stable version** tested on Windows XP/2003 support: [GitHub](https://github.com/Virtual-TreeView/Virtual-TreeView/archive/V6_stable.zip) diff --git a/components/virtualtreeview/Source/VirtualTrees.AccessibilityFactory.pas b/components/virtualtreeview/Source/VirtualTrees.AccessibilityFactory.pas index d478fdaa..e26dacaf 100644 --- a/components/virtualtreeview/Source/VirtualTrees.AccessibilityFactory.pas +++ b/components/virtualtreeview/Source/VirtualTrees.AccessibilityFactory.pas @@ -44,6 +44,7 @@ uses type IVTAccessibleProvider = interface + ['{8B76176B-C1F2-4C5C-99B4-2444FABE495C}'] function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible; end; diff --git a/components/virtualtreeview/Source/VirtualTrees.AncestorVcl.pas b/components/virtualtreeview/Source/VirtualTrees.AncestorVcl.pas index 7085edee..d0739a9e 100644 --- a/components/virtualtreeview/Source/VirtualTrees.AncestorVcl.pas +++ b/components/virtualtreeview/Source/VirtualTrees.AncestorVcl.pas @@ -32,7 +32,7 @@ type protected function GetHintWindowClass: THintWindowClass; override; - function GetTreeFromDataObject(const DataObject: TVTDragDataObject): TBaseVirtualTree; override; + class function GetTreeFromDataObject(const DataObject: TVTDragDataObject): TBaseVirtualTree; deprecated 'Use class TVTDragManager.GetTreeFromDataObject() instead'; function DoRenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HRESULT; override; property OnRenderOLEData: TVTRenderOLEDataEvent read FOnRenderOLEData write FOnRenderOLEData; public //methods @@ -96,7 +96,7 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TVTAncestorVcl.GetTreeFromDataObject(const DataObject: TVTDragDataObject): TBaseVirtualTree; +class function TVTAncestorVcl.GetTreeFromDataObject(const DataObject: TVTDragDataObject): TBaseVirtualTree; // Returns the owner/sender of the given data object by means of a special clipboard format // or nil if the sender is in another process or no virtual tree at all. @@ -145,7 +145,7 @@ begin else begin // Try to get the source tree of the operation to optimize the operation. - Source := GetTreeFromDataObject(Data); + Source := TVTDragManager.GetTreeFromDataObject(Data); Result := ProcessOLEData(Source, Data, FocusedNode, DefaultPasteMode, Assigned(Source) and (tsCutPending in Source.TreeStates)); if Assigned(Source) then diff --git a/components/virtualtreeview/Source/VirtualTrees.BaseTree.pas b/components/virtualtreeview/Source/VirtualTrees.BaseTree.pas index 3587d7b4..2cc7b9e1 100644 --- a/components/virtualtreeview/Source/VirtualTrees.BaseTree.pas +++ b/components/virtualtreeview/Source/VirtualTrees.BaseTree.pas @@ -120,7 +120,7 @@ type // to compile (conversion done by BCB is wrong). TCacheEntry = record Node: PVirtualNode; - AbsoluteTop: TDimension; + AbsoluteTop: TNodeHeight; end; TCache = array of TCacheEntry; @@ -326,6 +326,8 @@ type const APlusSelectedHotBM :TBitmap; const AMinusBM : TBitmap; const AMinusHotBM : TBitmap; const AMinusSelectedHotBM :TBitmap; var ASize : TSize) of object; + TVTColumnHeaderSpanningEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var Count: Integer) of object; + // search, sort TVTCompareEvent = procedure(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer) of object; @@ -531,7 +533,7 @@ type FOffsetY: TDimension; // Determines left and top scroll offset. FEffectiveOffsetX: TDimension; // Actual position of the horizontal scroll bar (varies depending on bidi mode). FRangeX, - FRangeY: TDimension; // current virtual width and height of the tree + FRangeY: TNodeHeight; // current virtual width and height of the tree FBottomSpace: TDimension; // Extra space below the last node. FDefaultPasteMode: TVTNodeAttachMode; // Used to determine where to add pasted nodes to. @@ -546,9 +548,8 @@ type FSearchStart: TVTSearchStart; // Where to start iteration on each key press. // miscellanous - FPanningWindow: HWND; // Helper window for wheel panning + FPanningWindow: TForm; // Helper window for wheel panning FPanningCursor: TVTCursor; // Current wheel panning cursor. - FPanningImage: TBitmap; // A little 32x32 bitmap to indicate the panning reference point. FLastClickPos: TPoint; // Used for retained drag start and wheel mouse scrolling. FOperationCount: Cardinal; // Counts how many nested long-running operations are in progress. FOperationCanceled: Boolean; // Used to indicate that a long-running operation should be canceled. @@ -681,6 +682,7 @@ type // not covered by any node FOnMeasureItem: TVTMeasureItemEvent; // Triggered when a node is about to be drawn and its height was not yet // determined by the application. + FOnColumnHeaderSpanning: TVTColumnHeaderSpanningEvent; // triggered before the header column area been create for painting FOnGetUserClipboardFormats: TVTGetUserClipboardFormatsEvent; // gives application/descendants the opportunity to // add own clipboard formats on the fly FOnPaintText: TVTPaintText; // triggered before either normal or fixed text is painted to allow @@ -739,8 +741,8 @@ type procedure ClearNodeBackground(const PaintInfo: TVTPaintInfo; UseBackground, Floating: Boolean; R: TRect); function CompareNodePositions(Node1, Node2: PVirtualNode; ConsiderChildrenAbove: Boolean = False): Integer; procedure DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: TDimension; Style: TVTLineType; Reverse: Boolean); - function FindInPositionCache(Node: PVirtualNode; var CurrentPos: TDimension): PVirtualNode; overload; - function FindInPositionCache(Position: TDimension; var CurrentPos: TDimension): PVirtualNode; overload; + function FindInPositionCache(Node: PVirtualNode; var CurrentPos: TNodeHeight): PVirtualNode; overload; + function FindInPositionCache(Position: TDimension; var CurrentPos: TNodeHeight): PVirtualNode; overload; procedure FixupTotalCount(Node: PVirtualNode); procedure FixupTotalHeight(Node: PVirtualNode); function GetBottomNode: PVirtualNode; @@ -757,7 +759,7 @@ type function GetFullyVisible(Node: PVirtualNode): Boolean; function GetHasChildren(Node: PVirtualNode): Boolean; function GetMultiline(Node: PVirtualNode): Boolean; - function GetNodeHeight(Node: PVirtualNode): TDimension; + function GetNodeHeight(Node: PVirtualNode): TNodeHeight; function GetNodeParent(Node: PVirtualNode): PVirtualNode; function GetOffsetXY: TPoint; function GetRootNodeCount: Cardinal; @@ -814,7 +816,7 @@ type procedure SetMultiline(Node: PVirtualNode; const Value: Boolean); procedure SetNodeAlignment(const Value: TVTNodeAlignment); procedure SetNodeDataSize(Value: Integer); - procedure SetNodeHeight(Node: PVirtualNode; Value: TDimension); + procedure SetNodeHeight(Node: PVirtualNode; Value: TNodeHeight); procedure SetNodeParent(Node: PVirtualNode; const Value: PVirtualNode); procedure SetOffsetX(const Value: TDimension); procedure SetOffsetXY(const Value: TPoint); @@ -904,7 +906,7 @@ type procedure AddToSelection(const NewItems: TNodeArray; NewLength: Integer; ForceInsert: Boolean = False); overload; virtual; procedure AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var NextNonEmpty: TColumnIndex); virtual; procedure AdjustPanningCursor(X, Y: TDimension); virtual; - procedure AdjustTotalHeight(Node: PVirtualNode; Value: TDimension; relative: Boolean = False); + procedure AdjustTotalHeight(Node: PVirtualNode; Value: TNodeHeight; relative: Boolean = False); procedure AdviseChangeEvent(StructureChange: Boolean; Node: PVirtualNode; Reason: TChangeReason); virtual; function AllocateInternalDataArea(Size: Cardinal): Cardinal; virtual; procedure Animate(Steps, Duration: Cardinal; Callback: TVTAnimationCallback; Data: Pointer); virtual; @@ -1056,6 +1058,7 @@ type procedure DoStructureChange(Node: PVirtualNode; Reason: TChangeReason); virtual; procedure DoTimerScroll; virtual; procedure DoUpdating(State: TVTUpdateState); virtual; + procedure DoColumnHeaderSpanning(Column: TColumnIndex; var Count: Integer); virtual; function DoValidateCache: Boolean; virtual; procedure DragAndDrop(AllowedEffects: DWord; const DataObject: TVTDragDataObject; var DragEffect: Integer); virtual; procedure DragCanceled; override; @@ -1092,7 +1095,6 @@ type function GetOperationCanceled: Boolean; function GetOptionsClass: TTreeOptionsClass; virtual; function GetSelectedCount(): Integer; override; - function GetTreeFromDataObject(const DataObject: TVTDragDataObject): TBaseVirtualTree; virtual; procedure HandleHotTrack(X, Y: TDimension); virtual; procedure HandleIncrementalSearch(CharCode: Word); virtual; procedure HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); virtual; @@ -1117,6 +1119,7 @@ type procedure InternalRemoveFromSelection(Node: PVirtualNode); virtual; procedure InterruptValidation(pWaitForValidationTermination: Boolean = True); procedure InvalidateCache; + function LineWidth(): TDimension; procedure Loaded; override; procedure MainColumnChanged; virtual; procedure MarkCutCopyNodes; override; @@ -1131,7 +1134,6 @@ type procedure PaintTreeLines(const PaintInfo: TVTPaintInfo; IndentSize: TDimension; const LineImage: TLineImage); virtual; procedure PaintSelectionRectangle(Target: TCanvas; WindowOrgX: TDimension; const SelectionRect: TRect; TargetRect: TRect); virtual; - procedure PanningWindowProc(var Message: TMessage); virtual; procedure PrepareBitmaps(NeedButtons, NeedLines: Boolean); procedure PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: TDimension); virtual; function ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, @@ -1163,8 +1165,6 @@ type procedure UpdateEditBounds; virtual; procedure UpdateHeaderRect; virtual; procedure UpdateStyleElements; override; - procedure UpdateWindowAndDragImage(const Tree: TBaseVirtualTree; TreeRect: TRect; UpdateNCArea, - ReshowDragImage: Boolean); virtual; procedure ValidateCache; virtual; procedure ValidateNodeDataSize(var Size: Integer); virtual; procedure WndProc(var Message: TMessage); override; @@ -1235,7 +1235,7 @@ type property MinusBM: TBitmap read FMinusBM; property PlusBM: TBitmap read FPlusBM; property RangeX: TDimension read GetRangeX;// Returns the width of the virtual tree in pixels, (not ClientWidth). If there are columns it returns the total width of all of them; otherwise it returns the maximum of the all the line's data widths. - property RangeY: TDimension read FRangeY; + property RangeY: TNodeHeight read FRangeY; property RootNodeCount: Cardinal read GetRootNodeCount write SetRootNodeCount default 0; property ScrollBarOptions: TScrollBarOptions read FScrollBarOptions write SetScrollBarOptions; property SelectionBlendFactor: Byte read FSelectionBlendFactor write FSelectionBlendFactor default 128; @@ -1379,6 +1379,7 @@ type property OnStateChange: TVTStateChangeEvent read FOnStateChange write FOnStateChange; property OnStructureChange: TVTStructureChangeEvent read FOnStructureChange write FOnStructureChange; property OnUpdating: TVTUpdatingEvent read FOnUpdating write FOnUpdating; + property OnColumnHeaderSpanning: TVTColumnHeaderSpanningEvent read FOnColumnHeaderSpanning write FOnColumnHeaderSpanning; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -1507,6 +1508,7 @@ type var Text: string); virtual; function GetTreeRect: TRect; function GetVisibleParent(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + function GetTopInvisibleParent(Node: PVirtualNode): PVirtualNode; function HasAsParent(Node, PotentialParent: PVirtualNode): Boolean; function InsertNode(Node: PVirtualNode; Mode: TVTNodeAttachMode; UserData: Pointer = nil): PVirtualNode; procedure InvalidateChildren(Node: PVirtualNode; Recursive: Boolean); @@ -1518,7 +1520,7 @@ type function IsMouseSelecting: Boolean; function IsEmpty: Boolean; inline; function IsUpdating(): Boolean; - function IterateSubtree(Node: PVirtualNode; Callback: TVTGetNodeProc; Data: Pointer; Filter: TVirtualNodeStates = []; + function IterateSubtree(StartNode: PVirtualNode; Callback: TVTGetNodeProc; Data: Pointer; Filter: TVirtualNodeStates = []; DoInit: Boolean = False; ChildNodesOnly: Boolean = False): PVirtualNode; procedure LoadFromFile(const FileName: TFileName); virtual; procedure LoadFromStream(Stream: TStream); virtual; @@ -1606,7 +1608,7 @@ type property IsFiltered[Node: PVirtualNode]: Boolean read GetFiltered write SetFiltered; property IsVisible[Node: PVirtualNode]: Boolean read GetVisible write SetVisible; property MultiLine[Node: PVirtualNode]: Boolean read GetMultiline write SetMultiline; - property NodeHeight[Node: PVirtualNode]: TDimension read GetNodeHeight write SetNodeHeight; + property NodeHeight[Node: PVirtualNode]: TNodeHeight read GetNodeHeight write SetNodeHeight; property NodeParent[Node: PVirtualNode]: PVirtualNode read GetNodeParent write SetNodeParent; property OffsetX: TDimension read FOffsetX write SetOffsetX; property OffsetXY: TPoint read GetOffsetXY write SetOffsetXY; @@ -1642,14 +1644,14 @@ function TreeFromNode(Node: PVirtualNode): TBaseVirtualTree; implementation -{$R VirtualTrees.res} - uses Winapi.MMSystem, // for animation timer (does not include further resources) System.Math, System.SyncObjs, System.StrUtils, + Clipbrd, Vcl.Consts, + Vcl.ExtCtrls, Vcl.AxCtrls, // TOLEStream Vcl.StdActns, // for standard action support Vcl.GraphUtil, // accessibility helper class @@ -1936,8 +1938,9 @@ begin // Initialize OLE subsystem for drag'n drop and clipboard operations. NeedToUnitialize := not IsLibrary and Succeeded(OleInitialize(nil)); - // Register the tree reference clipboard format. Others will be handled in InternalClipboarFormats. + // Register the tree reference clipboard format. CF_VTREFERENCE := RegisterClipboardFormat(CFSTR_VTREFERENCE); + CF_VTHEADERREFERENCE := RegisterClipboardFormat(CFSTR_VTHEADERREFERENCE); // Clipboard format registration. // Native clipboard format. Needs a new identifier and has an average priority to allow other formats to take over. @@ -2211,12 +2214,12 @@ end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.AdjustTotalHeight(Node: PVirtualNode; Value: TDimension; Relative: Boolean = False); +procedure TBaseVirtualTree.AdjustTotalHeight(Node: PVirtualNode; Value: TNodeHeight; Relative: Boolean = False); // Sets a node's total height to the given value and recursively adjusts the parent's total height. var - Difference: TDimension; + Difference: TNodeHeight; Run: PVirtualNode; begin @@ -2997,7 +3000,7 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.FindInPositionCache(Node: PVirtualNode; var CurrentPos: TDimension): PVirtualNode; +function TBaseVirtualTree.FindInPositionCache(Node: PVirtualNode; var CurrentPos: TNodeHeight): PVirtualNode; // Looks through the position cache and returns the node whose top position is the largest one which is smaller or equal // to the position of the given node. @@ -3030,7 +3033,7 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.FindInPositionCache(Position: TDimension; var CurrentPos: TDimension): PVirtualNode; +function TBaseVirtualTree.FindInPositionCache(Position: TDimension; var CurrentPos: TNodeHeight): PVirtualNode; // Looks through the position cache and returns the node whose top position is the largest one which is smaller or equal // to the given vertical position. @@ -3289,7 +3292,7 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetNodeHeight(Node: PVirtualNode): TDimension; +function TBaseVirtualTree.GetNodeHeight(Node: PVirtualNode): TNodeHeight; begin if Assigned(Node) and (Node <> FRoot) then @@ -4125,8 +4128,6 @@ begin MoveTo(2, Width div 2); LineTo(Width - 2, Width div 2); end - else - FMinusBM.Handle := LoadBitmap(HInstance, 'VT_XPBUTTONMINUS'); end; FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); FSelectedHotMinusBM.Canvas.Draw(0, 0, FMinusBM); @@ -4167,8 +4168,6 @@ begin MoveTo(Width div 2, 2); LineTo(Width div 2, Width - 2); end - else - FPlusBM.Handle := LoadBitmap(HInstance, 'VT_XPBUTTONPLUS'); end; FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); FSelectedHotPlusBM.Canvas.Draw(0, 0, FPlusBM); @@ -4356,7 +4355,10 @@ procedure TBaseVirtualTree.SetButtonFillMode(const Value: TVTButtonFillMode); begin if FButtonFillMode <> Value then begin - FButtonFillMode := Value; + if Value = TVTButtonFillMode.fmShaded then // no longer supported + FButtonFillMode := TVTButtonFillMode.fmTreeColor + else + FButtonFillMode := Value; if not (csLoading in ComponentState) then begin PrepareBitmaps(True, False); @@ -4468,7 +4470,7 @@ var Index: Cardinal; Child: PVirtualNode; Count: Integer; - NewHeight: TDimension; + NewHeight: TNodeHeight; begin if not (toReadOnly in FOptions.MiscOptions) then begin @@ -5052,7 +5054,7 @@ end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetNodeHeight(Node: PVirtualNode; Value: TDimension); +procedure TBaseVirtualTree.SetNodeHeight(Node: PVirtualNode; Value: TNodeHeight); var Difference: TDimension; @@ -6185,7 +6187,7 @@ begin FHintData.Tree.FLastHintRect := Rect(0, 0, 0, 0); LeaveStates := [tsHint]; - if [tsWheelPanning, tsWheelScrolling] * FStates = [] then + if not (tsPanning in FStates) then begin StopTimer(ScrollTimer); LeaveStates := LeaveStates + [tsScrollPending, tsScrolling]; @@ -6470,8 +6472,18 @@ procedure TBaseVirtualTree.WMContextMenu(var Message: TWMContextMenu); // This method is called when a popup menu is about to be displayed. // We have to cancel some pending states here to avoid interferences. +var + HitInfo: THitInfo; + pt: TPoint; begin - DoStateChange([], [tsClearPending, tsEditPending, tsOLEDragPending, tsVCLDragPending]); + DoStateChange([], [tsClearPending, tsEditPending, tsOLEDragPending, tsVCLDragPending, tsPopupMenuShown]); + + if not Assigned(PopupMenu) then begin + // convert screen coordinates to client + pt := ScreenToClient(Point(Message.XPos, Message.YPos)); + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); // ShiftState is not used anyway here + DoPopupMenu(HitInfo.HitNode, HitInfo.HitColumn, pt); + end; if not (tsPopupMenuShown in FStates) then inherited; @@ -6524,6 +6536,24 @@ end; procedure TBaseVirtualTree.WMHScroll(var Message: TWMHScroll); + //--------------- local functions ------------------------------------------- + + function GetRealScrollPosition: TDimension; + + var + SI: TScrollInfo; + Bar: Integer; + + begin + SI.cbSize := SizeOf(TScrollInfo); + SI.fMask := SIF_TRACKPOS; + Bar := SB_HORZ; + GetScrollInfo(Bar, SI); + Result := SI.nTrackPos; + end; + + //--------------- end local functions --------------------------------------- + var RTLFactor: Integer; @@ -6556,11 +6586,9 @@ begin begin DoStateChange([tsThumbTracking]); if UseRightToLeftAlignment then - SetOffsetX(-FRangeX + ClientWidth + Message.Pos) + SetOffsetX(-FRangeX + ClientWidth + GetRealScrollPosition) else - SetOffsetX(-Message.Pos); - // Fix unstyled scrollbar in some cases, while causing flicker: - UpdateScrollBars(True); + SetOffsetX(-GetRealScrollPosition); end; SB_TOP: SetOffsetX(0); @@ -7457,7 +7485,7 @@ begin inherited; // Start wheel panning or scrolling if not already active, allowed and scrolling is useful at all. - if (toWheelPanning in FOptions.MiscOptions) and ([tsWheelScrolling, tsWheelPanning] * FStates = []) and + if (toWheelPanning in FOptions.MiscOptions) and not (tsPanning in FStates) and ((FRangeX > ClientWidth) or (FRangeY > ClientHeight)) then begin FLastClickPos := SmallPointToPoint(Message.Pos); @@ -7487,16 +7515,7 @@ var begin DoStateChange([], [tsMiddleButtonDown]); - // If wheel panning/scrolling is active and the mouse has not yet been moved then the user starts wheel auto scrolling. - // Indicate this by removing the panning flag. Otherwise (the mouse has moved meanwhile) stop panning. - if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then - begin - if tsWheelScrolling in FStates then - DoStateChange([], [tsWheelPanning]) - else - StopWheelPanning; - end - else + if not (tsPanning in FStates) then if FHeader.States = [] then begin inherited; @@ -7536,7 +7555,7 @@ begin StopTimer(ChangeTimer); StopTimer(StructureChangeTimer); - if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.MiscOptions) and HandleAllocated then + if not (csDesigning in ComponentState) and HandleAllocated then RevokeDragDrop(Handle); inherited; @@ -7726,7 +7745,7 @@ var HitInfo: THitInfo; begin - DoStateChange([], [tsPopupMenuShown, tsRightButtonDown]); + DoStateChange([], [tsRightButtonDown]); if FHeader.States = [] then begin @@ -7747,8 +7766,6 @@ begin if toRightClickSelect in FOptions.SelectionOptions then HandleMouseUp(Message, HitInfo); - if not Assigned(PopupMenu) then - DoPopupMenu(HitInfo.HitNode, HitInfo.HitColumn, Point(Message.XPos, Message.YPos)); end; end; @@ -7769,8 +7786,7 @@ begin begin // Feature: design-time header #415 // Allow header to handle cursor and return control's default if it did nothing - if (CursorWnd = Handle) and - ([tsWheelPanning, tsWheelScrolling] * FStates = []) then + if (CursorWnd = Handle) and not (tsPanning in FStates) then begin if not TVTHeaderCracker(FHeader).HandleMessage(TMessage(Message)) then begin @@ -8064,8 +8080,8 @@ procedure TBaseVirtualTree.AdjustPanningCursor(X, Y: TDimension); // Loads the proper cursor which indicates into which direction scrolling is done. var - Name: string; - NewCursor: HCURSOR; + NewCursor: TPanningCursor; + NewCursorHandle: HCURSOR; ScrollHorizontal, ScrollVertical: Boolean; @@ -8079,12 +8095,12 @@ begin if ScrollHorizontal then begin if ScrollVertical then - Name := 'VT_MOVEALL' + NewCursor := TPanningCursor.MOVEALL else - Name := 'VT_MOVEEW'; + NewCursor := TPanningCursor.MOVEEW; end else - Name := 'VT_MOVENS'; + NewCursor := TPanningCursor.MOVENS; end else begin @@ -8097,32 +8113,33 @@ begin begin // Left hand side. if Y - FLastClickPos.Y < -8 then - Name := 'VT_MOVENW' + NewCursor := TPanningCursor.MOVENW else if Y - FLastClickPos.Y > 8 then - Name := 'VT_MOVESW' + NewCursor := TPanningCursor.MOVESW else - Name := 'VT_MOVEW'; + NewCursor := TPanningCursor.MOVEW; end else if X - FLastClickPos.X > 8 then begin // Right hand side. if Y - FLastClickPos.Y < -8 then - Name := 'VT_MOVENE' + NewCursor := TPanningCursor.MOVENE + else if Y - FLastClickPos.Y > 8 then - Name := 'VT_MOVESE' + NewCursor := TPanningCursor.MOVESE else - Name := 'VT_MOVEE'; + NewCursor := TPanningCursor.MOVEE; end else begin // Up or down. if Y < FLastClickPos.Y then - Name := 'VT_MOVEN' + NewCursor := TPanningCursor.MOVEN else - Name := 'VT_MOVES'; + NewCursor := TPanningCursor.MOVES; end; end else @@ -8130,30 +8147,30 @@ begin begin // Only horizontal movement allowed. if X < FLastClickPos.X then - Name := 'VT_MOVEW' + NewCursor := TPanningCursor.MOVEW else - Name := 'VT_MOVEE'; + NewCursor := TPanningCursor.MOVEE; end else begin // Only vertical movement allowed. if Y < FLastClickPos.Y then - Name := 'VT_MOVEN' + NewCursor := TPanningCursor.MOVEN else - Name := 'VT_MOVES'; + NewCursor := TPanningCursor.MOVES; end; end; // Now load the cursor and apply it. - NewCursor := LoadCursor(HInstance, PChar(Name)); - if FPanningCursor <> NewCursor then + NewCursorHandle := LoadCursor(0, MAKEINTRESOURCE(NewCursor)); + if FPanningCursor <> NewCursorHandle then begin DeleteObject(FPanningCursor); - FPanningCursor := NewCursor; + FPanningCursor := NewCursorHandle; Winapi.Windows.SetCursor(FPanningCursor); end else - DeleteObject(NewCursor); + DeleteObject(NewCursorHandle); end; //---------------------------------------------------------------------------------------------------------------------- @@ -8345,7 +8362,7 @@ begin // wheel panning/scrolling is active. IsDropTarget := Assigned(FDragManager) and DragManager.IsDropTarget; IsDrawSelecting := [tsDrawSelPending, tsDrawSelecting] * FStates <> []; - IsWheelPanning := [tsWheelPanning, tsWheelScrolling] * FStates <> []; + IsWheelPanning := tsPanning in FStates; Result := ((toAutoScroll in FOptions.AutoOptions) or IsWheelPanning) and (FHeader.States = []) and (IsDrawSelecting or IsDropTarget or (tsVCLDragging in FStates) or IsWheelPanning); end; @@ -8720,9 +8737,8 @@ begin PrepareBitmaps(True, True); // Register tree as OLE drop target. - if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.MiscOptions) then - if not (csLoading in ComponentState) then // will be done in Loaded after all inherited settings are loaded from the DFMs - RegisterDragDrop(Handle, DragManager as IDropTarget); + if not (csDesigning in ComponentState) and not (csLoading in ComponentState) and ((hoDrag in Header.Options) or (toAcceptOLEDrop in TreeOptions.MiscOptions)) then // will be done in Loaded after all inherited settings are loaded from the DFMs + RegisterDragDrop(Handle, DragManager as IDropTarget); UpdateScrollBars(True); UpdateHeaderRect; @@ -9276,7 +9292,7 @@ begin if CanAutoScroll then begin // Calculation for wheel panning/scrolling is a bit different to normal auto scroll. - if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then + if tsPanning in FStates then begin if (X - FLastClickPos.X) < -8 then Include(Result, TScrollDirection.sdLeft); @@ -9377,7 +9393,7 @@ procedure TBaseVirtualTree.DoAutoScroll(X, Y: TDimension); begin FScrollDirections := DetermineScrollDirections(X, Y); - if FStates * [tsWheelPanning, tsWheelScrolling] = [] then + if not (tsPanning in FStates) then begin if FScrollDirections = [] then begin @@ -9665,6 +9681,14 @@ end; //---------------------------------------------------------------------------------------------------------------------- +procedure TBaseVirtualTree.DoColumnHeaderSpanning(Column: TColumnIndex; var Count: Integer); +begin + if Assigned(FOnColumnHeaderSpanning) then + FOnColumnHeaderSpanning(Self.Header, Column, Count); +end; + +//---------------------------------------------------------------------------------------------------------------------- + procedure TBaseVirtualTree.DoColumnResize(Column: TColumnIndex); var @@ -10883,7 +10907,7 @@ begin MapWindowPoints(Handle, 0, R, 2); InRect := PtInRect(R, P); ClientP := ScreenToClient(P); - Panning := [tsWheelPanning, tsWheelScrolling] * FStates <> []; + Panning := tsPanning in FStates; if IsMouseSelecting or InRect or Panning then begin @@ -10980,7 +11004,7 @@ begin end; UpdateWindow(); - if (FScrollDirections = []) and ([tsWheelPanning, tsWheelScrolling] * FStates = []) then + if (FScrollDirections = []) and not (tsPanning in FStates) then begin StopTimer(ScrollTimer); DoStateChange([], [tsScrollPending, tsScrolling]); @@ -11013,7 +11037,7 @@ var Index: Cardinal; CurrentNode, Temp: PVirtualNode; - CurrentTop: TDimension; + CurrentTop: TNodeHeight; begin EntryCount := 0; if not (tsStopValidation in FStates) then @@ -11203,6 +11227,12 @@ var begin try + if not (toAcceptOLEDrop in TreeOptions.MiscOptions) then + begin + Effect := DROPEFFECT_NONE; + Exit(NOERROR); + end; + // Determine acceptance of drag operation and reset scroll start time. FDragScrollStart := 0; @@ -11473,7 +11503,7 @@ procedure TBaseVirtualTree.DrawGridHLine(const PaintInfo: TVTPaintInfo; Left, Ri var R: TRect; begin - R := Rect(Min(Left, Right), Top, Max(Left, Right) + 1, Top + 1); + R := Rect(Min(Left, Right), Top, Max(Left, Right) + LineWidth, Top + LineWidth); DrawGridLine(PaintInfo.Canvas, R) end; @@ -11485,7 +11515,7 @@ procedure TBaseVirtualTree.DrawGridVLine(const PaintInfo: TVTPaintInfo; Top, Bot var R: TRect; begin - R := Rect(Left, Min(Top, Bottom), Left + 1, Max(Top, Bottom) + 1); + R := Rect(Left, Min(Top, Bottom), Left + LineWidth, Max(Top, Bottom) + LineWidth); if pFixedColumn and (TVtPaintOption.toShowVertGridLines in TreeOptions.PaintOptions) then // In case we showe grid lines, we must use a color for the fixed column that differentiates from the normal gridlines StyleServices.DrawElement(PaintInfo.Canvas.Handle, StyleServices.GetElementDetails(tlGroupHeaderLineOpenHot), R {$IF CompilerVersion >= 34}, @R, CurrentPPI{$IFEND}) else begin @@ -11901,13 +11931,6 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetTreeFromDataObject(const DataObject: TVTDragDataObject): TBaseVirtualTree; -begin - Result:= nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - procedure TBaseVirtualTree.HandleHotTrack(X, Y: TDimension); // Updates the current "hot" node. @@ -12393,7 +12416,7 @@ var //--------------- end local functions --------------------------------------- begin - if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then + if tsPanning in FStates then begin StopWheelPanning; Exit; @@ -12419,6 +12442,7 @@ begin Winapi.Windows.SetFocus(Handle); // Repeat the hit test as an OnExit event might got triggered that could modify the tree. GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + FLastHitInfo := HitInfo; // See issue #1297 end; if IsEmpty then @@ -12571,8 +12595,6 @@ begin if not FSelectionLocked and ((not (IsAnyHit or FullRowDrag) and MultiSelect and ShiftEmpty) or (IsAnyHit and (not NodeSelected or (NodeSelected and CanClear)) and (ShiftEmpty or not MultiSelect or (tsRightButtonDown in FStates)))) then begin - Assert(not (tsClearPending in FStates), 'Pending and direct clearance are mutual exclusive!'); - // If the currently hit node was already selected then we have to reselect it again after clearing the current // selection, but without a change event if it is the only selected node. // The same applies if the Alt key is pressed, which allows to start drawing the selection rectangle also @@ -13474,9 +13496,8 @@ begin inherited; // Call RegisterDragDrop after all visual inheritance changes to MiscOptions have been applied. - if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.MiscOptions) then - if HandleAllocated then - RegisterDragDrop(Handle, DragManager as IDropTarget); + if not (csDesigning in ComponentState) and HandleAllocated and ((hoDrag in Header.Options) or (toAcceptOLEDrop in TreeOptions.MiscOptions)) then + RegisterDragDrop(Handle, DragManager as IDropTarget); // If a root node count has been set during load of the tree then update its child structure now // as this hasn't been done yet in this case. @@ -13596,14 +13617,6 @@ begin end; end; - // If both wheel panning and auto scrolling are pending then the user moved the mouse while holding down the - // middle mouse button. This means panning is being used, hence remove the wheel scroll flag. - if [tsWheelPanning, tsWheelScrolling] * FStates = [tsWheelPanning, tsWheelScrolling] then - begin - if ((Abs(FLastClickPos.X - X) >= Mouse.DragThreshold) or (Abs(FLastClickPos.Y - Y) >= Mouse.DragThreshold)) then - DoStateChange([], [tsWheelScrolling]); - end; - // Really start dragging if the mouse has been moved more than the threshold. if (tsOLEDragPending in FStates) and ( @@ -13616,7 +13629,7 @@ begin begin if CanAutoScroll then DoAutoScroll(X, Y); - if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then + if tsPanning in FStates then AdjustPanningCursor(X, Y); if not IsMouseSelecting then begin @@ -13827,6 +13840,7 @@ var Details, lSizeDetails: TThemedElementDetails; lSize: TSize; Theme: HTHEME; + lCheckImages: TCustomImageList; begin with ImageInfo do begin @@ -13898,8 +13912,12 @@ begin DrawArrow(Canvas, TScrollDirection.sdDown, Point(R.Left + Round(lSize.cx * 0.22), R.Top + Round(lSize.cy * 0.33)), Round(lSize.cx *0.28)); end;//if end - else - with FCheckImages do + else begin + if Assigned(FCheckImages) then + lCheckImages := FCheckImages + else + lCheckImages := FCustomCheckImages; + with lCheckImages do begin if Selected and not Ghosted then begin @@ -13914,6 +13932,7 @@ begin ImageList_DrawEx(Handle, Index, Canvas.Handle, XPos, YPos, 0, 0, GetRGBColor(BkColor), ForegroundColor, ILD_TRANSPARENT); end; + end; //else end; end; @@ -14187,34 +14206,6 @@ end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PanningWindowProc(var Message: TMessage); - -var - PS: TPaintStruct; - Canvas: TCanvas; - -begin - if Message.Msg = WM_PAINT then - begin - BeginPaint(FPanningWindow, PS); - Canvas := TCanvas.Create; - Canvas.Handle := PS.hdc; - try - Canvas.Draw(0, 0, FPanningImage); - finally - Canvas.Handle := 0; - Canvas.Free; - EndPaint(FPanningWindow, PS); - end; - Message.Result := 0; - end - else - with Message do - Result := DefWindowProc(FPanningWindow, Msg, wParam, lParam); -end; - -//---------------------------------------------------------------------------------------------------------------------- - procedure TBaseVirtualTree.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: TDimension); // This method is called immediately before a cell's content is drawn und is responsible to paint selection colors etc. @@ -14821,123 +14812,72 @@ end; //---------------------------------------------------------------------------------------------------------------------- -var - PanningWindowClass: TWndClass = ( - style: 0; - lpfnWndProc: @DefWindowProc; - cbClsExtra: 0; - cbWndExtra: 0; - hInstance: 0; - hIcon: 0; - hCursor: 0; - hbrBackground: 0; - lpszMenuName: nil; - lpszClassName: 'VTPanningWindow' - ); - procedure TBaseVirtualTree.StartWheelPanning(Position: TPoint); // Called when wheel panning should start. A little helper window is created to indicate the reference position, // which determines in which direction and how far wheel panning/scrolling will happen. //--------------- local function -------------------------------------------- - - function CreateClipRegion: HRGN; - - // In order to avoid doing all the transparent drawing ourselves we use a - // window region for the wheel window. - // Since we only work on a very small image (32x32 pixels) this is acceptable. - + function CreatePanningWindow(const ImageName: TPanningCursor; const Pos: TPoint): TForm; var - Start, X, Y: Integer; - Temp: HRGN; - + Form: TForm; + Image: TImage; + PanningImage: TIcon; begin - Assert(not FPanningImage.Empty, 'Invalid wheel panning image.'); + Form := TForm.Create(Self); + Form.PopupMode := pmExplicit; + Form.PopupParent := GetParentForm(Self); + Form.TransparentColor := True; + Form.TransparentColorValue := clBtnFace; + Form.Width := ScaledPixels(32); + Form.Height := Form.Width; + Form.BorderStyle := bsNone; + Form.StyleElements := []; + Image := TImage.Create(Form); + Image.Left := 0; + Image.Top := 0; + Image.Parent := Form; + Image.Align := TAlign.alClient; - // Create an initial region on which we operate. - Result := CreateRectRgn(0, 0, 0, 0); - with FPanningImage, Canvas do - begin - for Y := 0 to Height - 1 do - begin - Start := -1; - for X := 0 to Width - 1 do - begin - // Start a new span if we found a non-transparent pixel and no span is currently started. - if (Start = -1) and (Pixels[X, Y] <> clFuchsia) then - Start := X - else - if (Start > -1) and (Pixels[X, Y] = clFuchsia) then - begin - // A non-transparent span is finished. Add it to the result region. - Temp := CreateRectRgn(Start, Y, X, Y + 1); - CombineRgn(Result, Result, Temp, RGN_OR); - DeleteObject(Temp); - Start := -1; - end; - end; - // If there is an open span then add this also to the result region. - if Start > -1 then - begin - Temp := CreateRectRgn(Start, Y, Width, Y + 1); - CombineRgn(Result, Result, Temp, RGN_OR); - DeleteObject(Temp); - end; - end; + PanningImage := TIcon.Create; + try + PanningImage.Handle := LoadImage(0, MAKEINTRESOURCE(ImageName), IMAGE_CURSOR, Form.Width, Form.Height, LR_DEFAULTCOLOR or LR_LOADTRANSPARENT); + Image.Picture.Assign(PanningImage); + Form.Left := Pos.X - (PanningImage.Width div 2); + Form.Top := Pos.Y - (PanningImage.Height div 2); + finally + PanningImage.Free; end; - // The resulting region is used as window region so we must not delete it. - // Windows will own it after the assignment below. + Form.Position := poDesigned; + // This prevents a focus chnage compare to using TForm.Show() + ShowWindow(Form.Handle, SW_SHOWNOACTIVATE); + Form.Visible := True; + Exit(Form); end; - //--------------- end local function ---------------------------------------- var - TempClass: TWndClass; - ClassRegistered: Boolean; - ImageName: string; + ImageName: TPanningCursor; Pt: TPoint; begin - // Set both panning and scrolling flag. One will be removed shortly depending on whether the middle mouse button is - // released before the mouse is moved or vice versa. The first case is referred to as wheel scrolling while the - // latter is called wheel panning. StopTimer(ScrollTimer); - DoStateChange([tsWheelPanning, tsWheelScrolling]); + DoStateChange([tsPanning]); - // Register the helper window class. - PanningWindowClass.hInstance := HInstance; - ClassRegistered := GetClassInfo(HInstance, PanningWindowClass.lpszClassName, TempClass); - if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then - begin - if ClassRegistered then - Winapi.Windows.UnregisterClass(PanningWindowClass.lpszClassName, HInstance); - Winapi.Windows.RegisterClass(PanningWindowClass); - end; - // Create the helper window and show it at the given position without activating it. - Pt := ClientToScreen(Position); - FPanningWindow := CreateWindowEx(WS_EX_TOOLWINDOW, PanningWindowClass.lpszClassName, nil, WS_POPUP, Pt.X - 16, Pt.Y - 16, - 32, 32, Handle, 0, HInstance, nil); - - FPanningImage := TBitmap.Create; + // Determine correct cursor if FRangeX > ClientWidth then begin if FRangeY > ClientHeight then - ImageName := 'VT_MOVEALL' + ImageName := TPanningCursor.MOVEALL else - ImageName := 'VT_MOVEEW'; + ImageName := TPanningCursor.MOVEEW; end else - ImageName := 'VT_MOVENS'; - FPanningImage.LoadFromResourceName(HInstance, ImageName); - SetWindowRgn(FPanningWindow, CreateClipRegion, False); + ImageName := TPanningCursor.MOVENS; - {$ifdef CPUX64} - SetWindowLongPtr(FPanningWindow, GWLP_WNDPROC, LONG_PTR(System.Classes.MakeObjectInstance(PanningWindowProc))); - {$else} - SetWindowLong(FPanningWindow, GWL_WNDPROC, NativeInt(System.Classes.MakeObjectInstance(PanningWindowProc))); - {$endif CPUX64} - ShowWindow(FPanningWindow, SW_SHOWNOACTIVATE); + // Create the helper window and show it at the given position without activating it. + Pt := ClientToScreen(Position); + FPanningWindow := CreatePanningWindow(ImageName, Pt); // Setup the panscroll timer and capture all mouse input. TrySetFocus(); @@ -14951,29 +14891,17 @@ procedure TBaseVirtualTree.StopWheelPanning; // Stops panning if currently active and destroys the helper window. -var - Instance: Pointer; - begin - if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then + if tsPanning in FStates then begin // Release the mouse capture and stop the panscroll timer. StopTimer(ScrollTimer); ReleaseCapture; - DoStateChange([], [tsWheelPanning, tsWheelScrolling]); + DoStateChange([], [tsPanning]); // Destroy the helper window. - {$ifdef CPUX64} - Instance := Pointer(GetWindowLongPtr(FPanningWindow, GWLP_WNDPROC)); - {$else} - Instance := Pointer(GetWindowLong(FPanningWindow, GWL_WNDPROC)); - {$endif CPUX64} - DestroyWindow(FPanningWindow); - if Instance <> @DefWindowProc then - System.Classes.FreeObjectInstance(Instance); - FPanningWindow := 0; - FPanningImage.Free; - FPanningImage := nil; + if Assigned(FPanningWindow) then + FPanningWindow.Release; DeleteObject(FPanningCursor); FPanningCursor := 0; Winapi.Windows.SetCursor(Screen.Cursors[Cursor]); @@ -15395,91 +15323,6 @@ const // Region identifiers for GetRandomRgn function GetRandomRgn(DC: HDC; Rgn: HRGN; iNum: Integer): Integer; stdcall; external 'GDI32.DLL'; -procedure TBaseVirtualTree.UpdateWindowAndDragImage(const Tree: TBaseVirtualTree; TreeRect: TRect; UpdateNCArea, - ReshowDragImage: Boolean); - -// Method to repaint part of the window area which is not covered by the drag image and to initiate a recapture -// of the drag image. -// Note: This method must only be called during a drag operation and the tree passed in is the one managing the current -// drag image (so it is the actual drag source). - -var - DragRegion, // the region representing the drag image - UpdateRegion, // the unclipped region within the tree to be updated - NCRegion: HRGN; // the region representing the non-client area of the tree - DragRect, - NCRect: TRect; - RedrawFlags: Cardinal; - - VisibleTreeRegion: HRGN; - - DC: HDC; - - //This function was originally designed only for tree's drag image. But we modified - //it for reusing it with header's drag image too for solving issue 248. - useDragImage: TVTDragImage; -begin - if IntersectRect(TreeRect, TreeRect, ClientRect) then - begin - // Retrieve the visible region of the window. This is important to avoid overpainting parts of other windows - // which overlap this one. - VisibleTreeRegion := CreateRectRgn(0, 0, 1, 1); - DC := GetDCEx(Handle, 0, DCX_CACHE or DCX_WINDOW or DCX_CLIPSIBLINGS or DCX_CLIPCHILDREN); - GetRandomRgn(DC, VisibleTreeRegion, SYSRGN); - ReleaseDC(Handle, DC); - - //Take proper drag image depending on whether the drag is being done in the tree - //or in the header. - if (Tree.FHeader.DragImage <> nil) and (Tree.FHeader.DragImage.Visible) then - begin - useDragImage := Tree.FHeader.DragImage; - - // The drag image will figure out itself what part of the rectangle can be recaptured. - // Recapturing is not done by taking a snapshot of the screen, but by letting the tree draw itself - // into the back bitmap of the drag image. So the order here is unimportant. - useDragImage.RecaptureBackground(Self, TreeRect, VisibleTreeRegion, UpdateNCArea, ReshowDragImage); - - // Calculate the screen area not covered by the drag image and which needs an update. - DragRect := useDragImage.GetDragImageRect; - MapWindowPoints(0, Handle, DragRect, 2); - DragRegion := CreateRectRgnIndirect(DragRect); - - // Start with non-client area if requested. - if UpdateNCArea then - begin - // Compute the part of the non-client area which must be updated. - - // Determine the outer rectangle of the entire tree window. - GetWindowRect(Handle, NCRect); - // Express the tree window rectangle in client coordinates (because RedrawWindow wants them so). - MapWindowPoints(0, Handle, NCRect, 2); - NCRegion := CreateRectRgnIndirect(NCRect); - // Determine client rect in screen coordinates and create another region for it. - UpdateRegion := CreateRectRgnIndirect(ClientRect); - // Create a region which only contains the NC part by subtracting out the client area. - CombineRgn(NCRegion, NCRegion, UpdateRegion, RGN_DIFF); - // Subtract also out what is hidden by the drag image. - CombineRgn(NCRegion, NCRegion, DragRegion, RGN_DIFF); - RedrawWindow(nil, NCRegion, RDW_FRAME or RDW_NOERASE or RDW_NOCHILDREN or RDW_INVALIDATE or RDW_VALIDATE or - RDW_UPDATENOW); - DeleteObject(NCRegion); - DeleteObject(UpdateRegion); - end; - - UpdateRegion := CreateRectRgnIndirect(TreeRect); - RedrawFlags := RDW_INVALIDATE or RDW_VALIDATE or RDW_UPDATENOW or RDW_NOERASE or RDW_NOCHILDREN; - // Remove the part of the update region which is covered by the drag image. - CombineRgn(UpdateRegion, UpdateRegion, DragRegion, RGN_DIFF); - RedrawWindow(nil, UpdateRegion, RedrawFlags); - DeleteObject(UpdateRegion); - DeleteObject(DragRegion); - DeleteObject(VisibleTreeRegion); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - procedure TBaseVirtualTree.ValidateCache(); // Starts cache validation if not already done by adding this instance to the worker thread's waiter list @@ -15871,6 +15714,8 @@ begin begin Canvas.Font.Assign(Self.Font); lTextHeight := Canvas.TextHeight('Tg') + TextMargin; + if Assigned(Images) then + lTextHeight := Max(lTextHeight, Images.Height + IfThen(fImagesMargin > 1, fImagesMargin div 2, fImagesMargin)); // ImagesMargin is the distance between two Images / checboxes. Don't count it twice vertically => div 2 // By default, we only ensure that DefaultNodeHeight is large enough. // If the form's dpi has changed, we scale up and down the DefaultNodeHeight, See issue #677. if (lTextHeight <> Self.DefaultNodeHeight) then begin @@ -16464,6 +16309,8 @@ var I: Integer; LevelChange: Boolean; begin + if Length(pNodes) = 0 then + exit; // Prevent range error below when empty array is passen. See issue #1288 BeginUpdate; try for I := High(pNodes) downto 1 do @@ -16835,7 +16682,7 @@ function TBaseVirtualTree.GetDisplayRect(Node: PVirtualNode; Column: TColumnInde var Temp: PVirtualNode; LeftOffset: TDimension; - TopOffset: TDimension; + TopOffset: TNodeHeight; CacheIsAvailable: Boolean; TextWidth: TDimension; CurrentBidiMode: TBidiMode; @@ -17725,25 +17572,73 @@ function TBaseVirtualTree.GetLastVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; IncludeFiltered: Boolean = False): PVirtualNode; // Returns the very last visible node in the tree while optionally considering toChildrenAbove. +// Note that the visibility of all ancestor nodes of the resulting node must not be considered. // No initialization is performed. + + //--------------- local functions ------------------------------------------- + + function GetNodeIsVisible(ChildNode: PVirtualNode): Boolean; + begin + Result := (vsVisible in ChildNode.States) and + (IncludeFiltered or not IsEffectivelyFiltered[ChildNode]); + end; + + function GetNodeHasVisibleChildren(ChildNode: PVirtualNode): Boolean; + begin + Result := (vsHasChildren in ChildNode.States) and + (vsExpanded in ChildNode.States) and + not (vsAllChildrenHidden in ChildNode.States); + end; + + function IterateChildren(ParentNode: PVirtualNode): PVirtualNode; + var + Run: PVirtualNode; + begin + Result := nil; + + Run := GetLastChildNoInit(ParentNode); // Do not use 'GetLastVisibleChildNoInit' here (see above). + while Assigned(Run) do + begin + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + if GetNodeIsVisible(Run) then + Result := Run + else if GetNodeHasVisibleChildren(Run) then + Result := IterateChildren(Run); + end else + begin + if GetNodeHasVisibleChildren(Run) then + Result := IterateChildren(Run) + else if GetNodeIsVisible(Run) then + Result := Run; + end; + + if Assigned(Result) then + break; + + Run := GetPreviousSiblingNoInit(Run); + end; + end; + + //--------------- end local functions --------------------------------------- + var - Next: PVirtualNode; + Run: PVirtualNode; begin - Result := GetLastVisibleChildNoInit(Node, IncludeFiltered); - if not ConsiderChildrenAbove or not (toChildrenAbove in FOptions.PaintOptions) then - while Assigned(Result) and (vsExpanded in Result.States) do - begin - // Test if there is a next last child. If not keep the node from the last run. - // Otherwise use the next last child. - Next := GetLastChildNoInit(Result); - if Assigned(Next) and (not (vsVisible in Next.States) or - (not IncludeFiltered and IsEffectivelyFiltered[Next])) then - Next := GetPreviousVisibleSiblingNoInit(Next, IncludeFiltered); - if Next = nil then - Break; - Result := Next; - end; + Result := nil; + + // First, check wether the given node and all its parents are expanded. + // If not, there can not be any visible child node. + Run := Node; + while Assigned(Run) and (Run <> RootNode) do + begin + if not (vsExpanded in Run.States) then + exit; + Run := Run.Parent; + end; + + Result := IterateChildren(Node); end; //---------------------------------------------------------------------------------------------------------------------- @@ -18176,113 +18071,122 @@ function TBaseVirtualTree.GetNextVisible(Node: PVirtualNode; ConsiderChildrenAbo // toChildrenAbove is optionally considered which is the default here. var + TopInvisibleParent: PVirtualNode; ForceSearch: Boolean; begin Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + if not Assigned(Result) then Exit; - repeat - // If the given node is not visible then look for a parent node which is visible, otherwise we will - // likely go unnecessarily through a whole bunch of invisible nodes. - if not FullyVisible[Result] then - Result := GetVisibleParent(Result, True); + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + repeat + // If any ancestor is invisible, then find the last (furthest) parent node + // which is invisible to skip invisible subtrees. Otherwise we will + // likely go unnecessarily through a whole bunch of invisible nodes. + TopInvisibleParent := GetTopInvisibleParent(Result); + if Assigned(TopInvisibleParent) then + Result := TopInvisibleParent; + + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + repeat + // If there a no siblings anymore, go up one level. + if not Assigned(Result.NextSibling) then + begin + Result := Result.Parent; + if Result = FRoot then + begin + Result := nil; + Break; + end; + + if not (vsInitialized in Result.States) then + InitNode(Result); + end + else + begin + // There is at least one sibling so take it. + Result := Result.NextSibling; + if not (vsInitialized in Result.States) then + InitNode(Result); + if not (vsVisible in Result.States) then + Continue; + + // Now take a look at the children. As the children are initialized + // while toggling, we don't need to call 'InitChildren' beforehand here. + while (vsExpanded in Result.States) and Assigned(Result.FirstChild) do + begin + Result := Result.FirstChild; + if not (vsInitialized in Result.States) then + InitNode(Result); + if not (vsVisible in Result.States) then + Break; + end; + end; + + // If we found a visible node we don't need to search any longer. + // As it has already been initialized above, we don't need to call 'InitNode' here. + if vsVisible in Result.States then + Break; + until False; + end + else + begin + ForceSearch := True; + // If we found an invisible ancestor, we must not check its children. + // Remember, that TopInvisibleParent can be effectively invisible merely due to + // its own parent's expansion state despite being visible itself. + if Result <> TopInvisibleParent then + begin + if not (vsInitialized in Result.States) then + InitNode(Result); + + // Child nodes are the first choice if the current node is known to be visible. + if (vsVisible in Result.States) and (vsExpanded in Result.States) then + begin + // Initialize the node's children if necessary. + if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then + InitChildren(Result); + + if Assigned(Result.FirstChild) then + begin + Result := Result.FirstChild; + if not (vsInitialized in Result.States) then + InitNode(Result); + ForceSearch := False; + end; + end; + end; + + // If there are no children or the first child is not visible then search the sibling nodes or traverse parents. + if ForceSearch or not (vsVisible in Result.States) then begin repeat - // If there a no siblings anymore, go up one level. - if not Assigned(Result.NextSibling) then + // Is there a next sibling? + if Assigned(Result.NextSibling) then begin - Result := Result.Parent; - if Result = FRoot then - begin - Result := nil; - Break; - end; - + Result := Result.NextSibling; if not (vsInitialized in Result.States) then InitNode(Result); if vsVisible in Result.States then Break; end + // No sibling anymore, so use the parent's next sibling. + else if Result.Parent <> FRoot then + Result := Result.Parent else begin - // There is at least one sibling so take it. - Result := Result.NextSibling; - if not (vsInitialized in Result.States) then - InitNode(Result); - if not (vsVisible in Result.States) then - Continue; - - // Now take a look at the children. - // As the children are initialized while toggling, we don't need to do this here. - while (vsExpanded in Result.States) and Assigned(Result.FirstChild) do - begin - Result := Result.FirstChild; - if not (vsInitialized in Result.States) then - InitNode(Result); - if not (vsVisible in Result.States) then - Break; - end; - - // If we found a visible node we don't need to search any longer. - if vsVisible in Result.States then - Break; + // There are no further nodes to examine, hence there is no further visible node. + Result := nil; + Break; end; until False; - end - else - begin - // Has this node got children? - if [vsHasChildren, vsExpanded] * Result.States = [vsHasChildren, vsExpanded] then - begin - // Yes, there are child nodes. Initialize them if necessary. - if Result.ChildCount = 0 then - InitChildren(Result); - end; - - // Child nodes are the first choice if possible. - if (vsExpanded in Result.States) and Assigned(Result.FirstChild) then - begin - Result := GetFirstChild(Result); - ForceSearch := False; - end - else - ForceSearch := True; - - // If there are no children or the first child is not visible then search the sibling nodes or traverse parents. - if Assigned(Result) and (ForceSearch or not (vsVisible in Result.States)) then - begin - repeat - // Is there a next sibling? - if Assigned(Result.NextSibling) then - begin - Result := Result.NextSibling; - if not (vsInitialized in Result.States) then - InitNode(Result); - if vsVisible in Result.States then - Break; - end - else - begin - // No sibling anymore, so use the parent's next sibling. - if Result.Parent <> FRoot then - Result := Result.Parent - else - begin - // There are no further nodes to examine, hence there is no further visible node. - Result := nil; - Break; - end; - end; - until False; - end; end; - until not Assigned(Result) or IsEffectivelyVisible[Result]; - end; + end; + until not Assigned(Result) or IsEffectivelyVisible[Result]; + + Assert(Result <> Node, 'Node cannot be its own visible successor.'); end; //---------------------------------------------------------------------------------------------------------------------- @@ -18290,98 +18194,100 @@ end; function TBaseVirtualTree.GetNextVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; // Returns the next node in tree, with regard to Node, which is visible. -// toChildrenAbove is optionally considered (which is the default). No initialization is done. +// No initialization is done. +// toChildrenAbove is optionally considered which is the default here. var + TopInvisibleParent: PVirtualNode; ForceSearch: Boolean; begin Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + if not Assigned(Result) then Exit; - repeat - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + repeat + // If any ancestor is invisible, then find the last (furthest) parent node + // which is invisible to skip invisible subtrees. Otherwise we will + // likely go unnecessarily through a whole bunch of invisible nodes. + TopInvisibleParent := GetTopInvisibleParent(Result); + if Assigned(TopInvisibleParent) then + Result := TopInvisibleParent; + + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + repeat + // If there are no siblings anymore, go up one level. + if not Assigned(Result.NextSibling) then + begin + Result := Result.Parent; + if Result = FRoot then + begin + Result := nil; + Break; + end; + end + else + begin + // There is at least one sibling so take it. + Result := Result.NextSibling; + if not (vsVisible in Result.States) then + Continue; + + // Now take a look at the children. + while (vsExpanded in Result.States) and Assigned(Result.FirstChild) do + begin + Result := Result.FirstChild; + if not (vsVisible in Result.States) then + Break; + end; + end; + + // If we found a visible node we don't need to search any longer. + if vsVisible in Result.States then + Break; + until False; + end + else + begin + // Child nodes are the first choice if the current node is known to be visible. + // Remember, that TopInvisibleParent can be effectively invisible merely due to + // its own parent's expansion state despite being visible itself. + if (vsVisible in Result.States) and (vsExpanded in Result.States) and + (Result <> TopInvisibleParent) and Assigned(Result.FirstChild) then + begin + Result := Result.FirstChild; + ForceSearch := False; + end else + ForceSearch := True; + + // If there are no children or the first child is not visible then search the sibling nodes or traverse parents. + if ForceSearch or not (vsVisible in Result.States) then begin repeat - // If there a no siblings anymore, go up one level. - if not Assigned(Result.NextSibling) then + // Is there a next sibling? + if Assigned(Result.NextSibling) then begin - Result := Result.Parent; - if Result = FRoot then - begin - Result := nil; - Break; - end; + Result := Result.NextSibling; if vsVisible in Result.States then Break; end + // No sibling anymore, so use the parent's next sibling. + else if Result.Parent <> FRoot then + Result := Result.Parent else begin - // There is at least one sibling so take it. - Result := Result.NextSibling; - if not (vsVisible in Result.States) then - Continue; - - // Now take a look at the children. - while (vsExpanded in Result.States) and Assigned(Result.FirstChild) do - begin - Result := Result.FirstChild; - if not (vsVisible in Result.States) then - Break; - end; - - // If we found a visible node we don't need to search any longer. - if vsVisible in Result.States then - Break; + // There are no further nodes to examine, hence there is no further visible node. + Result := nil; + Break; end; until False; - end - else - begin - // If the given node is not visible then look for a parent node which is visible, otherwise we will - // likely go unnecessarily through a whole bunch of invisible nodes. - if not FullyVisible[Result] then - Result := GetVisibleParent(Result, True); - - // Child nodes are the first choice if possible. - if (vsExpanded in Result.States) and Assigned(Result.FirstChild) then - begin - Result := Result.FirstChild; - ForceSearch := False; - end - else - ForceSearch := True; - - // If there are no children or the first child is not visible then search the sibling nodes or traverse parents. - if ForceSearch or not (vsVisible in Result.States) then - begin - repeat - // Is there a next sibling? - if Assigned(Result.NextSibling) then - begin - Result := Result.NextSibling; - if vsVisible in Result.States then - Break; - end - else - begin - // No sibling anymore, so use the parent's next sibling. - if Result.Parent <> FRoot then - Result := Result.Parent - else - begin - // There are no further nodes to examine, hence there is no further visible node. - Result := nil; - Break; - end; - end; - until False; - end; end; - until not Assigned(Result) or IsEffectivelyVisible[Result]; - end; + end; + until not Assigned(Result) or IsEffectivelyVisible[Result]; + + Assert(Result <> Node, 'Node cannot be its own visible successor.'); end; //---------------------------------------------------------------------------------------------------------------------- @@ -18447,7 +18353,7 @@ function TBaseVirtualTree.GetNodeAt(X, Y: TDimension; Relative: Boolean; var Nod var AbsolutePos, - CurrentPos: TDimension; + CurrentPos: TNodeHeight; begin if Y < 0 then @@ -18926,104 +18832,120 @@ function TBaseVirtualTree.GetPreviousVisible(Node: PVirtualNode; ConsiderChildre // toChildrenAbove is optionally considered which is the default here. var - Marker: PVirtualNode; + TopInvisibleParent: PVirtualNode; + ForceSearch: Boolean; begin Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + if not Assigned(Result) then Exit; - repeat - // If the given node is not visible then look for a parent node which is visible and use its last visible - // child or the parent node (if there is no visible child) as result. - if not FullyVisible[Result] then + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + repeat + // If any ancestor is invisible, then find the last (furthest) parent node + // which is invisible to skip invisible subtrees. Otherwise we will + // likely go unnecessarily through a whole bunch of invisible nodes. + TopInvisibleParent := GetTopInvisibleParent(Result); + if Assigned(TopInvisibleParent) then + Result := TopInvisibleParent; + + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + ForceSearch := True; + // If we found an invisible ancestor, we must not check its children. + // Remember, that TopInvisibleParent can be effectively invisible merely due to + // its own parent's expansion state despite being visible itself. + if Result <> TopInvisibleParent then begin - Result := GetVisibleParent(Result, True); - if Result = FRoot then - Result := nil; - Marker := GetLastVisible(Result, True); - if Assigned(Marker) then - Result := Marker; - end - else + if not (vsInitialized in Result.States) then + InitNode(Result); + + if (vsVisible in Result.States) and (vsExpanded in Result.States) then + begin + // Initialiue the node's children if necessary. + if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then + InitChildren(Result); + + // Child nodes are the first choice if the current node is known to be visible. + if Assigned(Result.LastChild) then + begin + Result := Result.LastChild; + if not (vsInitialized in Result.States) then + InitNode(Result); + ForceSearch := False; + end; + end; + end; + + if ForceSearch or not (vsVisible in Result.States) then begin - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then - begin - repeat - if Assigned(Result.LastChild) and (vsExpanded in Result.States) then - begin - Result := Result.LastChild; - if not (vsInitialized in Result.States) then - InitNode(Result); - - if vsVisible in Result.States then - Break; - end - else - if Assigned(Result.PrevSibling) then - begin - if not (vsInitialized in Result.PrevSibling.States) then - InitNode(Result.PrevSibling); - - if vsVisible in Result.PrevSibling.States then - begin - Result := Result.PrevSibling; - Break; - end; - end - else - begin - Marker := nil; - repeat - Result := Result.Parent; - if Result <> FRoot then - Marker := GetPreviousVisibleSibling(Result, True) - else - Result := nil; - until Assigned(Marker) or (Result = nil); - if Assigned(Marker) then - Result := Marker; - - Break; - end; - until False; - end - else - begin - repeat - // Is there a previous sibling node? - if Assigned(Result.PrevSibling) then - begin - Result := Result.PrevSibling; - // Initialize the new node and check its visibility. - if not (vsInitialized in Result.States) then - InitNode(Result); - if vsVisible in Result.States then - begin - // If there are visible child nodes then use the last one. - Marker := GetLastVisible(Result, True, True); - if Assigned(Marker) then - Result := Marker; - Break; - end; - end - else - begin - // No previous sibling there so the parent node is the nearest previous node. - Result := Result.Parent; - if Result = FRoot then - Result := nil; + repeat + // Is there a previous sibling? + if Assigned(Result.PrevSibling) then + begin + Result := Result.PrevSibling; + if not (vsInitialized in Result.States) then + InitNode(Result); + if vsVisible in Result.States then Break; - end; - until False; + end + // No sibling anymore, so use the parent's previous sibling. + else if Result.Parent <> FRoot then + Result := Result.Parent + // There are no further nodes to examine, hence there is no further visible node. + else + begin + Result := nil; + Break; + end; + until False; + end; + end + else + begin + repeat + // If there are no sibling anymore, go up one level. + if not Assigned(Result.PrevSibling) then + begin + Result := Result.Parent; + if Result = FRoot then + begin + Result := nil; + Break; + end; + if not (vsInitialized in Result.States) then + InitNode(Result); + end else + begin + Result := Result.PrevSibling; + if not (vsInitialized in Result.States) then + InitNode(Result); + if not (vsVisible in Result.States) then + Continue; + + // Now take a look at the children. As the children are initialized + // while toggling, we don't need to call 'InitChildren' beforehand here. + while (vsExpanded in Result.States) and Assigned(Result.LastChild) do + begin + Result := Result.LastChild; + if not (vsInitialized in Result.States) then + InitNode(Result); + if not (vsVisible in Result.States) then + Break; + end; end; - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); - end; - until not Assigned(Result) or IsEffectivelyVisible[Result]; - end; + // If we found a visible node we don't need to search any longer. + if vsVisible in Result.States then + Break; + until False; + end; + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); + until not Assigned(Result) or IsEffectivelyVisible[Result]; + + Assert(Result <> Node, 'Node cannot be its own visible predecessor.'); end; //---------------------------------------------------------------------------------------------------------------------- @@ -19032,97 +18954,99 @@ function TBaseVirtualTree.GetPreviousVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; // Returns the previous node in tree, with regard to Node, which is visible. +// No initialization is done. // toChildrenAbove is optionally considered which is the default here. var - Marker: PVirtualNode; + TopInvisibleParent: PVirtualNode; + ForceSearch: Boolean; begin Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + if not Assigned(Result) then Exit; - repeat - // If the given node is not visible then look for a parent node which is visible and use its last visible - // child or the parent node (if there is no visible child) as result. - if not FullyVisible[Result] then + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + repeat + // If any ancestor is invisible, then find the last (furthest) parent node + // which is invisible to skip invisible subtrees. Otherwise we will + // likely go unnecessarily through a whole bunch of invisible nodes. + TopInvisibleParent := GetTopInvisibleParent(Result); + if Assigned(TopInvisibleParent) then + Result := TopInvisibleParent; + + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + // Child nodes are the first choice if the current node is known to be visible. + // Remember, that TopInvisibleParent can be effectively invisible merely due to + // its own parent's expansion state despite being visible itself. + if (vsVisible in Result.States) and (vsExpanded in Result.States) and + (Result <> TopInvisibleParent) and Assigned(Result.LastChild) then begin - Result := GetVisibleParent(Result, True); - if Result = FRoot then - Result := nil; - Marker := GetLastVisibleNoInit(Result, True); - if Assigned(Marker) then - Result := Marker; - end - else + Result := Result.LastChild; + ForceSearch := False; + end else + ForceSearch := True; + + if ForceSearch or not (vsVisible in Result.States) then begin - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + repeat + // Is there a previous sibling? + if Assigned(Result.PrevSibling) then + begin + Result := Result.PrevSibling; + if vsVisible in Result.States then + Break; + end + // No sibling anymore, so use the parent's previous sibling. + else if Result.Parent <> FRoot then + Result := Result.Parent + // There are no further nodes to examine, hence there is no further visible node. + else + begin + Result := nil; + Break; + end; + until False; + end; + end + else + begin + repeat + // If there are no siblings anymore, go up one level. + if not Assigned(Result.PrevSibling) then begin - repeat - // Is the current node expanded and has children? - if (vsExpanded in Result.States) and Assigned(Result.LastChild) then - begin - Result := Result.LastChild; - if vsVisible in Result.States then - Break; - end - else - if Assigned(Result.PrevSibling) then - begin - // No children anymore, so take the previous sibling. - Result := Result.PrevSibling; - if vsVisible in Result.States then - Break; - end - else - begin - // No children and no previous siblings, so walk up the tree and look wether - // a parent has a previous visible sibling. If that is the case take it, - // otherwise there is no previous visible node. - Marker := nil; - repeat - Result := Result.Parent; - if Result <> FRoot then - Marker := GetPreviousVisibleSiblingNoInit(Result, True) - else - Result := nil; - until Assigned(Marker) or (Result = nil); - if Assigned(Marker) then - Result := Marker; - Break; - end; - until False; + Result := Result.Parent; + if Result = FRoot then + begin + Result := nil; + Break; + end; end else begin - repeat - // Is there a previous sibling node? - if Assigned(Result.PrevSibling) then - begin - Result := Result.PrevSibling; - if vsVisible in Result.States then - begin - // If there are visible child nodes then use the last one. - Marker := GetLastVisibleNoInit(Result, True, True); - if Assigned(Marker) then - Result := Marker; - Break; - end; - end - else - begin - // No previous sibling there so the parent node is the nearest previous node. - Result := Result.Parent; - if Result = FRoot then - Result := nil; + // There is at least one sibling so take it. + Result := Result.PrevSibling; + if not (vsVisible in Result.States) then + Continue; + + // Now take a look at the children. + while (vsExpanded in Result.States) and Assigned(Result.LastChild) do + begin + Result := Result.LastChild; + if not (vsVisible in Result.States) then Break; - end; - until False; + end; end; - end; - until not Assigned(Result) or IsEffectivelyVisible[Result]; - end; + + // If we found a visible node we don't need to search any longer. + if vsVisible in Result.States then + Break; + until False; + end; + until not Assigned(Result) or IsEffectivelyVisible[Result]; + + Assert(Result <> Node, 'Node cannot be its own visible predecessor.'); end; //---------------------------------------------------------------------------------------------------------------------- @@ -19251,6 +19175,20 @@ begin Result.FNodeLevel := NodeLevel; end; +function TBaseVirtualTree.LineWidth: TDimension; +// Returns the width in pixels that should be used to draw grid lines, see issue #1203 +begin + // Always use line width of 1 for older Delphi versions. + {$if CompilerVersion < 31} + Exit(1); + {$else} + if FCurrentPPI < 200 then + Exit(1) // Always use 1 pixel is scaled <=200% + else + Exit(MulDiv(1, Self.FCurrentPPI, 132)); // Use 132 dpi instead of the typical 96 so that line width increase slightly slower than the actual scaling, so we have a 3px line at 400% + {$ifend} +end; + //---------------------------------------------------------------------------------------------------------------------- function TBaseVirtualTree.NoInitNodes(ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; @@ -19527,6 +19465,31 @@ end; //---------------------------------------------------------------------------------------------------------------------- +function TBaseVirtualTree.GetTopInvisibleParent(Node: PVirtualNode): PVirtualNode; + +// Returns the last (furthest) parent node of Node which is invisible. + +var + Run: PVirtualNode; + +begin + Assert(Assigned(Node), 'Node must not be nil.'); + Assert(Node <> FRoot, 'Node must not be the hidden root node.'); + + Result := nil; + + Run := Node.Parent; + while (Run <> FRoot) do + begin + if not ( (vsVisible in Run.States) and (vsExpanded in Run.Parent.States) ) then + Result := Run; + Run := Run.Parent; + end; + +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TBaseVirtualTree.HasAsParent(Node, PotentialParent: PVirtualNode): Boolean; // Determines whether Node has got PotentialParent as one of its parents. @@ -19852,7 +19815,7 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.IterateSubtree(Node: PVirtualNode; Callback: TVTGetNodeProc; Data: Pointer; +function TBaseVirtualTree.IterateSubtree(StartNode: PVirtualNode; Callback: TVTGetNodeProc; Data: Pointer; Filter: TVirtualNodeStates = []; DoInit: Boolean = False; ChildNodesOnly: Boolean = False): PVirtualNode; // Iterates through the all children and grandchildren etc. of Node (or the entire tree if Node = nil) @@ -19870,7 +19833,7 @@ var WasIterating: Boolean; begin - Assert(Node <> FRoot, 'Node must not be the hidden root node.'); + Assert(StartNode <> FRoot, 'Node must not be the hidden root node.'); WasIterating := tsIterating in FStates; DoStateChange([tsIterating]); @@ -19882,18 +19845,19 @@ begin GetNextNode := GetNextNoInit; Abort := False; - if Node = nil then + Result := StartNode; + if Result = nil then Stop := nil else begin - if not (vsInitialized in Node.States) and DoInit then - InitNode(Node); + if not (vsInitialized in Result.States) and DoInit then + InitNode(Result); // The stopper does not need to be initialized since it is not taken into the enumeration. - Stop := Node.NextSibling; + Stop := Result.NextSibling; if Stop = nil then begin - Stop := Node; + Stop := Result; repeat Stop := Stop.Parent; until (Stop = FRoot) or Assigned(Stop.NextSibling); @@ -19905,51 +19869,49 @@ begin end; // Use first node if we start with the root. - if Node = nil then - Node := GetFirstNoInit; + if Result = nil then + Result := GetFirstNoInit; - if Assigned(Node) then + if Assigned(Result) then begin - if not (vsInitialized in Node.States) and DoInit then - InitNode(Node); + if not (vsInitialized in Result.States) and DoInit then + InitNode(Result); // Skip given node if only the child nodes are requested. if ChildNodesOnly then begin - if Node.ChildCount = 0 then - Node := nil - else - Node := GetNextNode(Node); + if Result.ChildCount = 0 then + Result := nil + else if StartNode <> nil then + Result := GetNextNode(Result); end; if Filter = [] then begin // unfiltered loop - while Assigned(Node) and (Node <> Stop) do + while Assigned(Result) and (Result <> Stop) do begin - Callback(Self, Node, Data, Abort); + Callback(Self, Result, Data, Abort); if Abort then Break; - Node := GetNextNode(Node); + Result := GetNextNode(Result); end; end else begin // filtered loop - while Assigned(Node) and (Node <> Stop) do + while Assigned(Result) and (Result <> Stop) do begin - if Node.States * Filter = Filter then - Callback(Self, Node, Data, Abort); + if Result.States * Filter = Filter then + Callback(Self, Result, Data, Abort); if Abort then Break; - Node := GetNextNode(Node); + Result := GetNextNode(Result); end; end; end; - if Abort then - Result := Node - else + if not Abort then Result := nil; finally if not WasIterating then @@ -20570,15 +20532,15 @@ begin begin if BidiMode = bdLeftToRight then begin - DrawGridHLine(PaintInfo, CellRect.Left + PaintInfo.Offsets[ofsCheckBox] - fImagesMargin, CellRect.Right - 1, CellRect.Bottom - 1); + DrawGridHLine(PaintInfo, CellRect.Left + PaintInfo.Offsets[ofsCheckBox] - fImagesMargin, CellRect.Right - LineWidth, CellRect.Bottom - LineWidth); end else begin - DrawGridHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.PaintOptions, 1, IndentSize) * FIndent - 1, CellRect.Bottom - 1); + DrawGridHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.PaintOptions, LineWidth, IndentSize) * FIndent - 1, CellRect.Bottom - LineWidth); end; end else - DrawGridHLine(PaintInfo, CellRect.Left, CellRect.Right, CellRect.Bottom - 1); + DrawGridHLine(PaintInfo, CellRect.Left, CellRect.Right, CellRect.Bottom - LineWidth); Dec(CellRect.Bottom); Dec(ContentRect.Bottom); @@ -20608,7 +20570,7 @@ begin begin if (BidiMode = bdLeftToRight) or not ColumnIsEmpty(Node, Column) then begin - DrawGridVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - 1, ColumnIsFixed and (NextColumn >= 0)); + DrawGridVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - LineWidth, ColumnIsFixed and (NextColumn >= 0)); end; Dec(CellRect.Right); @@ -20624,7 +20586,7 @@ begin begin if (BidiMode = bdLeftToRight) or not ColumnIsEmpty(Node, Column) then begin - DrawGridVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - 1, ColumnIsFixed and (NextColumn >= 0)); + DrawGridVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - LineWidth, ColumnIsFixed and (NextColumn >= 0)); end; Dec(CellRect.Right); end; @@ -20666,6 +20628,7 @@ begin ((Column = FEditColumn) or not UseColumns)) then DoPaintNode(PaintInfo); + Canvas.Brush.Color := FColors.BackGroundColor; // Set useful background color, see issue #1264 DoAfterCellPaint(Canvas, Node, Column, CellRect); end; end; @@ -20912,7 +20875,6 @@ var TreeRect, PaintRect: TRect; LocalSpot, - ImagePos, PaintTarget: TPoint; lDragImage: TVTDragImage; // drag image management Image: TBitmap; @@ -20922,13 +20884,6 @@ begin begin lDragImage := TVTDragImage.Create(Self); try - with lDragImage do - begin - Fade := True; - PreBlendBias := 0; - Transparency := 200; - end; - // Determine the drag rectangle which is a square around the hot spot. Operate in virtual tree space. LocalSpot := HotSpot; Dec(LocalSpot.X, -FEffectiveOffsetX); @@ -20970,11 +20925,10 @@ begin // Once we have got the drag image we can convert all necessary coordinates into screen space. OffsetRect(TreeRect, -FEffectiveOffsetX, FOffsetY); - ImagePos := ClientToScreen(TreeRect.TopLeft); - HotSpot := ClientToScreen(HotSpot); + HotSpot.X := Width div 2; + HotSpot.Y := Height div 2; - lDragImage.ColorKey := FColors.BackGroundColor; - lDragImage.PrepareDrag(Image, ImagePos, HotSpot, DataObject); + lDragImage.PrepareDrag(Image, HotSpot, DataObject, FColors.BackGroundColor); finally Image.Free; end; @@ -21157,7 +21111,7 @@ begin begin BeginUpdate; // try to get the source tree of the operation - Source := GetTreeFromDataObject(DataObject); + Source := TVTDragManager.GetTreeFromDataObject(DataObject); if Assigned(Source) then Source.BeginUpdate; try @@ -22600,7 +22554,7 @@ begin DoShowScrollBar(SB_VERT, True); ScrollInfo.nMin := 0; - ScrollInfo.nMax := FRangeY; + ScrollInfo.nMax := IfThen(FRangeY < MaxInt, FRangeY, MaxInt); // TScrollInfo values are signed 32bit only ScrollInfo.nPos := -FOffsetY; ScrollInfo.nPage := Max(0, ClientHeight + 1); diff --git a/components/virtualtreeview/Source/VirtualTrees.ClipBoard.pas b/components/virtualtreeview/Source/VirtualTrees.ClipBoard.pas index 1fd7fc11..017a7362 100644 --- a/components/virtualtreeview/Source/VirtualTrees.ClipBoard.pas +++ b/components/virtualtreeview/Source/VirtualTrees.ClipBoard.pas @@ -101,7 +101,8 @@ type var // Clipboard format IDs used in OLE drag'n drop and clipboard transfers. CF_VIRTUALTREE, - CF_VTREFERENCE, + CF_VTREFERENCE, // Reference to a virtual tree + CF_VTHEADERREFERENCE, // A drag and drop of the column header took place CF_VRTF, CF_VRTFNOOBJS, // Unfortunately CF_RTF* is already defined as being // registration strings so I have to use different identifiers. diff --git a/components/virtualtreeview/Source/VirtualTrees.DataObject.pas b/components/virtualtreeview/Source/VirtualTrees.DataObject.pas index 5010ee3d..771b149d 100644 --- a/components/virtualtreeview/Source/VirtualTrees.DataObject.pas +++ b/components/virtualtreeview/Source/VirtualTrees.DataObject.pas @@ -5,6 +5,7 @@ interface uses WinApi.ActiveX, WinApi.Windows, + System.Classes, Vcl.Controls, VirtualTrees.Types; @@ -23,6 +24,7 @@ type TVTDataObject = class(TInterfacedObject, IDataObject) private FOwner : TCustomControl; // The tree which provides clipboard or drag data. + FHeader : TPersistent; // The tree which provides clipboard or drag data. FForClipboard : Boolean; // Determines which data to render with GetData. FFormatEtcArray : TFormatEtcArray; FInternalStgMediumArray : TInternalStgMediumArray; // The available formats in the DataObject @@ -41,7 +43,8 @@ type property InternalStgMediumArray : TInternalStgMediumArray read FInternalStgMediumArray write FInternalStgMediumArray; property Owner : TCustomControl read FOwner; public - constructor Create(AOwner : TCustomControl; ForClipboard : Boolean); virtual; + constructor Create(AOwner : TCustomControl; ForClipboard : Boolean); overload; + constructor Create(AHeader : TPersistent; AOwner : TCustomControl); overload; destructor Destroy; override; function DAdvise(const FormatEtc : TFormatEtc; advf : Integer; const advSink : IAdviseSink; out dwConnection : Integer) : HResult; virtual; stdcall; @@ -73,7 +76,16 @@ begin FOwner := AOwner; FForClipboard := ForClipboard; - TVTCracker(FOwner).GetNativeClipboardFormats(FFormatEtcArray); + if Assigned(FOWner) then + TVTCracker(FOwner).GetNativeClipboardFormats(FFormatEtcArray); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +constructor TVTDataObject.Create(AHeader: TPersistent; AOwner : TCustomControl); +begin + Create(AOwner, False); + FHeader := AHeader; end; //---------------------------------------------------------------------------------------------------------------------- @@ -338,8 +350,22 @@ var I : Integer; Data : PVTReference; begin + // See if this is a header column drag and drop + if (FormatEtcIn.cfFormat = CF_VTHEADERREFERENCE) and Assigned(FHeader) then + begin + Medium.HGlobal := GlobalAlloc(GHND or GMEM_SHARE, SizeOf(TVTReference)); + Data := GlobalLock(Medium.HGlobal); + Data.Process := GetCurrentProcessID; + Data.Tree := TBaseVirtualTree(FOwner); + GlobalUnLock(Medium.HGlobal); + Medium.tymed := TYMED_HGLOBAL; + Medium.unkForRelease := nil; + Exit(S_OK); + end; // if CF_VTHEADERREFERENCE + + // The tree reference format is always supported and returned from here. - if FormatEtcIn.cfFormat = CF_VTREFERENCE then + if (FormatEtcIn.cfFormat = CF_VTREFERENCE) and Assigned(FOWner) then begin // Note: this format is not used while flushing the clipboard to avoid a dangling reference // when the owner tree is destroyed before the clipboard data is replaced with something else. @@ -354,31 +380,29 @@ begin GlobalUnLock(Medium.HGlobal); Medium.tymed := TYMED_HGLOBAL; Medium.unkForRelease := nil; - Result := S_OK; + Exit(S_OK); end; - end - else - begin - try - // See if we accept this type and if not get the correct return value. - Result := QueryGetData(FormatEtcIn); - if Result = S_OK then + end; // if CF_VTREFERENCE + + try + // See if we accept this type and if not get the correct return value. + Result := QueryGetData(FormatEtcIn); + if Result = S_OK then + begin + for I := 0 to High(FormatEtcArray) do begin - for I := 0 to High(FormatEtcArray) do + if EqualFormatEtc(FormatEtcIn, FormatEtcArray[I]) then begin - if EqualFormatEtc(FormatEtcIn, FormatEtcArray[I]) then - begin - if not RenderInternalOLEData(FormatEtcIn, Medium, Result) then - Result := TVTCracker(FOwner).RenderOLEData(FormatEtcIn, Medium, FForClipboard); - Break; - end; + if not RenderInternalOLEData(FormatEtcIn, Medium, Result) then + Result := TVTCracker(FOwner).RenderOLEData(FormatEtcIn, Medium, FForClipboard); + Break; end; end; - except - ZeroMemory(@Medium, SizeOf(Medium)); - Result := E_FAIL; end; - end; + except + ZeroMemory(@Medium, SizeOf(Medium)); + Result := E_FAIL; + end; // try..except end; //---------------------------------------------------------------------------------------------------------------------- diff --git a/components/virtualtreeview/Source/VirtualTrees.DragImage.pas b/components/virtualtreeview/Source/VirtualTrees.DragImage.pas index face1aad..1aa3b878 100644 --- a/components/virtualtreeview/Source/VirtualTrees.DragImage.pas +++ b/components/virtualtreeview/Source/VirtualTrees.DragImage.pas @@ -15,7 +15,6 @@ uses type // Drag image support for the tree. TVTTransparency = 0 .. 255; - TVTBias = - 128 .. 127; // Simple move limitation for the drag image. TVTDragMoveRestriction = ( @@ -27,8 +26,7 @@ type TVTDragImageStates = set of ( disHidden, // Internal drag image is currently hidden (always hidden if drag image helper interfaces are used). disInDrag, // Drag image class is currently being used. - disPrepared, // Drag image class is prepared. - disSystemSupport // Running on Windows 2000 or higher. System supports drag images natively. + disPrepared // Drag image class is prepared. ); // Class to manage header and tree drag image during a drag'n drop operation. @@ -38,38 +36,16 @@ type FBackImage, // backup of overwritten screen area FAlphaImage, // target for alpha blending FDragImage : TBitmap; // the actual drag image to blend to screen - FImagePosition, // position of image (upper left corner) in screen coordinates - FLastPosition : TPoint; // last mouse position in screen coordinates - FTransparency : TVTTransparency; // alpha value of the drag image (0 - fully transparent, 255 - fully opaque) - FPreBlendBias, // value to darken or lighten the drag image before it is blended - FPostBlendBias : TVTBias; // value to darken or lighten the alpha blend result - FFade : Boolean; // determines whether to fade the drag image from center to borders or not FRestriction : TVTDragMoveRestriction; // determines in which directions the drag image can be moved FColorKey : TColor; // color to make fully transparent regardless of any other setting FStates : TVTDragImageStates; // Determines the states of the drag image class. - function GetVisible : Boolean; // True if the drag image is currently hidden (used only when dragging) - procedure InternalShowDragImage(ScreenDC : HDC); - procedure MakeAlphaChannel(Source, Target : TBitmap); public constructor Create(AOwner : TCustomControl); destructor Destroy; override; - function DragTo(P : TPoint; ForceRepaint : Boolean) : Boolean; procedure EndDrag; - function GetDragImageRect : TRect; - procedure HideDragImage; - procedure PrepareDrag(DragImage : TBitmap; ImagePosition, HotSpot : TPoint; const DataObject : IDataObject); - procedure RecaptureBackground(Tree : TCustomControl; R : TRect; VisibleRegion : HRGN; CaptureNCArea, ReshowDragImage : Boolean); - procedure ShowDragImage; - function WillMove(P : TPoint) : Boolean; - property ColorKey : TColor read FColorKey write FColorKey default clWindow; - property Fade : Boolean read FFade write FFade default False; - property ImagePosition : TPoint read FImagePosition; - property LastPosition : TPoint read FLastPosition; + procedure PrepareDrag(DragImage : TBitmap; HotSpot : TPoint; const DataObject: IDataObject; pColorKey: TColor = clWindow); property MoveRestriction : TVTDragMoveRestriction read FRestriction write FRestriction default dmrNone; - property PreBlendBias : TVTBias read FPreBlendBias write FPreBlendBias default 0; - property Transparency : TVTTransparency read FTransparency write FTransparency default 128; - property Visible : Boolean read GetVisible; end; implementation @@ -89,10 +65,6 @@ uses constructor TVTDragImage.Create(AOwner : TCustomControl); begin FOwner := AOwner; - FTransparency := 128; - FPreBlendBias := 0; - FPostBlendBias := 0; - FFade := False; FRestriction := dmrNone; FColorKey := clNone; end; @@ -108,218 +80,9 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TVTDragImage.GetVisible : Boolean; -// Returns True if the internal drag image is used (i.e. the system does not natively support drag images) and -// the internal image is currently visible on screen. -begin - Result := FStates * [disHidden, disInDrag, disPrepared, disSystemSupport] = [disInDrag, disPrepared]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTDragImage.InternalShowDragImage(ScreenDC : HDC); -// Frequently called helper routine to actually do the blend and put it onto the screen. -// Only used if the system does not support drag images. -var - BlendMode : TBlendMode; -begin - with FAlphaImage do - BitBlt(Canvas.Handle, 0, 0, Width, Height, FBackImage.Canvas.Handle, 0, 0, SRCCOPY); - if not FFade and (FColorKey = clNone) then - BlendMode := bmConstantAlpha - else - BlendMode := bmMasterAlpha; - with FDragImage do - AlphaBlend(Canvas.Handle, FAlphaImage.Canvas.Handle, Rect(0, 0, Width, Height), Point(0, 0), BlendMode, FTransparency, FPostBlendBias); - - with FAlphaImage do - BitBlt(ScreenDC, FImagePosition.X, FImagePosition.Y, Width, Height, Canvas.Handle, 0, 0, SRCCOPY); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTDragImage.MakeAlphaChannel(Source, Target : TBitmap); -// Helper method to create a proper alpha channel in Target (which must be in 32 bit pixel format), depending -// on the settings for the drag image and the color values in Source. -// Only used if the system does not support drag images. -type - PBGRA = ^TBGRA; - - TBGRA = packed record - case Boolean of - False : - (Color : Cardinal); - True : - (BGR : array [0 .. 2] of Byte; - Alpha : Byte); - end; - -var - Color, ColorKeyRef : COLORREF; - UseColorKey : Boolean; - SourceRun, TargetRun : PBGRA; - X, Y, MaxDimension, HalfWidth, HalfHeight : Integer; - T : Extended; -begin - UseColorKey := ColorKey <> clNone; - ColorKeyRef := ColorToRGB(ColorKey) and $FFFFFF; - // Color values are in the form BGR (red on LSB) while bitmap colors are in the form ARGB (blue on LSB) - // hence we have to swap red and blue in the color key. - with TBGRA(ColorKeyRef) do - begin - X := BGR[0]; - BGR[0] := BGR[2]; - BGR[2] := X; - end; - - with Target do - begin - MaxDimension := Max(Width, Height); - - HalfWidth := Width div 2; - HalfHeight := Height div 2; - for Y := 0 to Height - 1 do - begin - TargetRun := Scanline[Y]; - SourceRun := Source.Scanline[Y]; - for X := 0 to Width - 1 do - begin - Color := SourceRun.Color and $FFFFFF; - if UseColorKey and (Color = ColorKeyRef) then - TargetRun.Alpha := 0 - else - begin - // If the color is not the given color key (or none is used) then do full calculation of a bell curve. - T := Exp( - 8 * Sqrt(Sqr((X - HalfWidth) / MaxDimension) + Sqr((Y - HalfHeight) / MaxDimension))); - TargetRun.Alpha := Round(255 * T); - end; - Inc(SourceRun); - Inc(TargetRun); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragImage.DragTo(P : TPoint; ForceRepaint : Boolean) : Boolean; -// Moves the drag image to a new position, which is determined from the passed point P and the previous -// mouse position. -// ForceRepaint is True if something on the screen changed and the back image must be refreshed. - -var - ScreenDC : HDC; - DeltaX, DeltaY : Integer; - - // optimized drag image move support - RSamp1, RSamp2, // newly added parts from screen which will be overwritten - RDraw1, RDraw2, // parts to be restored to screen - RScroll, RClip : TRect; // ScrollDC of the existent background -begin - // Determine distances to move the drag image. Take care for restrictions. - case FRestriction of - dmrHorizontalOnly : - begin - DeltaX := FLastPosition.X - P.X; - DeltaY := 0; - end; - dmrVerticalOnly : - begin - DeltaX := 0; - DeltaY := FLastPosition.Y - P.Y; - end; - else // dmrNone - DeltaX := FLastPosition.X - P.X; - DeltaY := FLastPosition.Y - P.Y; - end; - - Result := (DeltaX <> 0) or (DeltaY <> 0) or ForceRepaint; - if Result then - begin - if Visible then - begin - // All this stuff is only called if we have to handle the drag image ourselves. If the system supports - // drag image then this is all never executed. - ScreenDC := GetDC(0); - try - if (Abs(DeltaX) >= FDragImage.Width) or (Abs(DeltaY) >= FDragImage.Height) or ForceRepaint then - begin - // If moved more than image size then just restore old screen and blit image to new position. - BitBlt(ScreenDC, FImagePosition.X, FImagePosition.Y, FBackImage.Width, FBackImage.Height, FBackImage.Canvas.Handle, 0, 0, SRCCOPY); - - GetPixel(ScreenDC, FImagePosition.X, FImagePosition.Y); - if ForceRepaint then - UpdateWindow(FOwner.Handle); - - Inc(FImagePosition.X, - DeltaX); - Inc(FImagePosition.Y, - DeltaY); - - BitBlt(FBackImage.Canvas.Handle, 0, 0, FBackImage.Width, FBackImage.Height, ScreenDC, FImagePosition.X, FImagePosition.Y, SRCCOPY); - end - else - begin - // overlapping copy - FillDragRectangles(FDragImage.Width, FDragImage.Height, DeltaX, DeltaY, RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2); - - with FBackImage.Canvas do - begin - // restore uncovered areas of the screen - if DeltaX = 0 then - begin - BitBlt(ScreenDC, FImagePosition.X + RDraw2.Left, FImagePosition.Y + RDraw2.Top, RDraw2.Right, RDraw2.Bottom, Handle, RDraw2.Left, RDraw2.Top, SRCCOPY); - end - else - begin - if DeltaY = 0 then - begin - BitBlt(ScreenDC, FImagePosition.X + RDraw1.Left, FImagePosition.Y + RDraw1.Top, RDraw1.Right, RDraw1.Bottom, Handle, RDraw1.Left, RDraw1.Top, SRCCOPY); - end - else - begin - BitBlt(ScreenDC, FImagePosition.X + RDraw1.Left, FImagePosition.Y + RDraw1.Top, RDraw1.Right, RDraw1.Bottom, Handle, RDraw1.Left, RDraw1.Top, SRCCOPY); - BitBlt(ScreenDC, FImagePosition.X + RDraw1.Left, FImagePosition.Y + RDraw1.Top, RDraw1.Right, RDraw1.Bottom, Handle, RDraw1.Left, RDraw1.Top, SRCCOPY); - end; - end; - - // move existent background - ScrollDC(Handle, DeltaX, DeltaY, RScroll, RClip, 0, nil); - - Inc(FImagePosition.X, - DeltaX); - Inc(FImagePosition.Y, - DeltaY); - - // Get first and second additional rectangle from screen. - if DeltaX = 0 then - begin - BitBlt(Handle, RSamp2.Left, RSamp2.Top, RSamp2.Right, RSamp2.Bottom, ScreenDC, FImagePosition.X + RSamp2.Left, FImagePosition.Y + RSamp2.Top, SRCCOPY); - end - else if DeltaY = 0 then - begin - BitBlt(Handle, RSamp1.Left, RSamp1.Top, RSamp1.Right, RSamp1.Bottom, ScreenDC, FImagePosition.X + RSamp1.Left, FImagePosition.Y + RSamp1.Top, SRCCOPY); - end - else - begin - BitBlt(Handle, RSamp1.Left, RSamp1.Top, RSamp1.Right, RSamp1.Bottom, ScreenDC, FImagePosition.X + RSamp1.Left, FImagePosition.Y + RSamp1.Top, SRCCOPY); - BitBlt(Handle, RSamp2.Left, RSamp2.Top, RSamp2.Right, RSamp2.Bottom, ScreenDC, FImagePosition.X + RSamp2.Left, FImagePosition.Y + RSamp2.Top, SRCCOPY); - end; - end; - end; - InternalShowDragImage(ScreenDC); - finally - ReleaseDC(0, ScreenDC); - end; - end; - FLastPosition.X := P.X; - FLastPosition.Y := P.Y; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - procedure TVTDragImage.EndDrag; begin - HideDragImage; FStates := FStates - [disInDrag, disPrepared]; - FBackImage.Free; FBackImage := nil; FDragImage.Free; @@ -330,41 +93,7 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TVTDragImage.GetDragImageRect : TRect; -// Returns the current size and position of the drag image (screen coordinates). -begin - if Visible then - begin - with FBackImage do - Result := Rect(FImagePosition.X, FImagePosition.Y, FImagePosition.X + Width, FImagePosition.Y + Height); - end - else - Result := Rect(0, 0, 0, 0); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTDragImage.HideDragImage; -var - ScreenDC : HDC; -begin - if Visible then - begin - Include(FStates, disHidden); - ScreenDC := GetDC(0); - try - // restore screen - with FBackImage do - BitBlt(ScreenDC, FImagePosition.X, FImagePosition.Y, Width, Height, Canvas.Handle, 0, 0, SRCCOPY); - finally - ReleaseDC(0, ScreenDC); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTDragImage.PrepareDrag(DragImage : TBitmap; ImagePosition, HotSpot : TPoint; const DataObject : IDataObject); +procedure TVTDragImage.PrepareDrag(DragImage : TBitmap; HotSpot : TPoint; const DataObject : IDataObject; pColorKey: TColor = clWindow); // Creates all necessary structures to do alpha blended dragging using the given image. // ImagePostion and HotSpot are given in screen coordinates. The first determines where to place the drag image while // the second is the initial mouse position. @@ -380,11 +109,11 @@ var begin Width := DragImage.Width; Height := DragImage.Height; + FColorKey := pColorKey; // Determine whether the system supports the drag helper interfaces. if Assigned(DataObject) and Succeeded(CoCreateInstance(CLSID_DragDropHelper, nil, CLSCTX_INPROC_SERVER, IDragSourceHelper, DragSourceHelper)) then begin - Include(FStates, disSystemSupport); lNullPoint := Point(0, 0); if Supports(DragSourceHelper, IDragSourceHelper2, lDragSourceHelper2) then lDragSourceHelper2.SetFlags(DSH_ALLOWDROPDESCRIPTIONTEXT); // Show description texts @@ -395,176 +124,16 @@ begin // Supply the drag source helper with our drag image. DragInfo.sizeDragImage.cx := Width; DragInfo.sizeDragImage.cy := Height; - DragInfo.ptOffset.X := Width div 2; - DragInfo.ptOffset.Y := Height div 2; + DragInfo.ptOffset := HotSpot; DragInfo.hbmpDragImage := CopyImage(DragImage.Handle, IMAGE_BITMAP, Width, Height, LR_COPYRETURNORG); DragInfo.crColorKey := ColorToRGB(FColorKey); if not Succeeded(DragSourceHelper.InitializeFromBitmap(@DragInfo, DataObject)) then begin DeleteObject(DragInfo.hbmpDragImage); - Exclude(FStates, disSystemSupport); - end; - end; - end - else - Exclude(FStates, disSystemSupport); - - if not (disSystemSupport in FStates) then - begin - FLastPosition := HotSpot; - - FDragImage := TBitmap.Create; - FDragImage.PixelFormat := pf32Bit; - FDragImage.SetSize(Width, Height); - - FAlphaImage := TBitmap.Create; - FAlphaImage.PixelFormat := pf32Bit; - FAlphaImage.SetSize(Width, Height); - - FBackImage := TBitmap.Create; - FBackImage.PixelFormat := pf32Bit; - FBackImage.SetSize(Width, Height); - - // Copy the given drag image and apply pre blend bias if required. - if FPreBlendBias = 0 then - with FDragImage do - BitBlt(Canvas.Handle, 0, 0, Width, Height, DragImage.Canvas.Handle, 0, 0, SRCCOPY) - else - AlphaBlend(DragImage.Canvas.Handle, FDragImage.Canvas.Handle, Rect(0, 0, Width, Height), Point(0, 0), bmConstantAlpha, 255, FPreBlendBias); - - // Create a proper alpha channel also if no fading is required (transparent parts). - MakeAlphaChannel(DragImage, FDragImage); - - FImagePosition := ImagePosition; - - // Initially the drag image is hidden and will be shown during the immediately following DragEnter event. - FStates := FStates + [disInDrag, disHidden, disPrepared]; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTDragImage.RecaptureBackground(Tree : TCustomControl; R : TRect; VisibleRegion : HRGN; CaptureNCArea, ReshowDragImage : Boolean); -// Notification by the drop target tree to update the background image because something in the tree has changed. -// Note: The passed rectangle is given in client coordinates of the current drop target tree (given in Tree). -// The caller does not check if the given rectangle is actually within the drag image. Hence this method must do -// all the checks. -// This method does nothing if the system manages the drag image. - -var - DragRect, ClipRect : TRect; - PaintTarget : TPoint; - PaintOptions : TVTInternalPaintOptions; - ScreenDC : HDC; - -begin - // Recapturing means we want the tree to paint the new part into our back bitmap instead to the screen. - if Visible then - begin - // Create the minimum rectangle to be recaptured. - MapWindowPoints(Tree.Handle, 0, R, 2); - DragRect := GetDragImageRect; - IntersectRect(R, R, DragRect); - - OffsetRgn(VisibleRegion, - DragRect.Left, - DragRect.Top); - - // The target position for painting in the drag image is relative and can be determined from screen coordinates too. - PaintTarget.X := R.Left - DragRect.Left; - PaintTarget.Y := R.Top - DragRect.Top; - - // The source rectangle is determined by the offsets in the tree. - MapWindowPoints(0, Tree.Handle, R, 2); - OffsetRect(R, - TBaseVirtualTree(Tree).OffsetX, - TBaseVirtualTree(Tree).OffsetY); - - // Finally let the tree paint the relevant part and upate the drag image on screen. - PaintOptions := [poBackground, poColumnColor, poDrawFocusRect, poDrawDropMark, poDrawSelection, poGridLines]; - with FBackImage do - begin - ClipRect.TopLeft := PaintTarget; - ClipRect.Right := ClipRect.Left + R.Right - R.Left; - ClipRect.Bottom := ClipRect.Top + R.Bottom - R.Top; - // TODO: somehow with clipping, the background image is not drawn on the - // backup image. Need to be diagnosed and fixed. For now, we have coded - // a work around in DragTo where this is used by using the condition - // IsInHeader. (found when solving issue 248) - ClipCanvas(Canvas, ClipRect, VisibleRegion); - TBaseVirtualTree(Tree).PaintTree(Canvas, R, PaintTarget, PaintOptions); - - if CaptureNCArea then - begin - // Header is painted in this part only so when you use this routine and want - // to capture the header in backup image, this flag should be ON. - // For the non-client area we only need the visible region of the window as limit for painting. - SelectClipRgn(Canvas.Handle, VisibleRegion); - // Since WM_PRINT cannot be given a position where to draw we simply move the window origin and - // get the same effect. - GetWindowRect(Tree.Handle, ClipRect); - SetCanvasOrigin(Canvas, DragRect.Left - ClipRect.Left, DragRect.Top - ClipRect.Top); - Tree.Perform(WM_PRINT, WPARAM(Canvas.Handle), PRF_NONCLIENT); - SetCanvasOrigin(Canvas, 0, 0); - end; - SelectClipRgn(Canvas.Handle, 0); - - if ReshowDragImage then - begin - GDIFlush; - ScreenDC := GetDC(0); - try - InternalShowDragImage(ScreenDC); - finally - ReleaseDC(0, ScreenDC); - end; end; end; end; end; -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTDragImage.ShowDragImage; -// Shows the drag image after it has been hidden by HideDragImage. -// Note: there might be a new background now. -// Also this method does nothing if the system manages the drag image. - -var - ScreenDC : HDC; -begin - if FStates * [disInDrag, disHidden, disPrepared, disSystemSupport] = [disInDrag, disHidden, disPrepared] then - begin - Exclude(FStates, disHidden); - - GDIFlush; - ScreenDC := GetDC(0); - try - BitBlt(FBackImage.Canvas.Handle, 0, 0, FBackImage.Width, FBackImage.Height, ScreenDC, FImagePosition.X, FImagePosition.Y, SRCCOPY); - - InternalShowDragImage(ScreenDC); - finally - ReleaseDC(0, ScreenDC); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragImage.WillMove(P : TPoint) : Boolean; -// This method determines whether the drag image would "physically" move when DragTo would be called with the same -// target point. -// Always returns False if the system drag image support is available. -begin - Result := Visible; - if Result then - begin - // Determine distances to move the drag image. Take care for restrictions. - case FRestriction of - dmrHorizontalOnly : - Result := FLastPosition.X <> P.X; - dmrVerticalOnly : - Result := FLastPosition.Y <> P.Y; - else // dmrNone - Result := (FLastPosition.X <> P.X) or (FLastPosition.Y <> P.Y); - end; - end; -end; end. diff --git a/components/virtualtreeview/Source/VirtualTrees.DragnDrop.pas b/components/virtualtreeview/Source/VirtualTrees.DragnDrop.pas index babc9c0e..4eb54873 100644 --- a/components/virtualtreeview/Source/VirtualTrees.DragnDrop.pas +++ b/components/virtualtreeview/Source/VirtualTrees.DragnDrop.pas @@ -10,7 +10,8 @@ uses Vcl.Graphics, Vcl.Controls, VirtualTrees.Types, - VirtualTrees.BaseTree; + VirtualTrees.BaseTree, + VirtualTrees.Header; type TEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc) @@ -31,6 +32,7 @@ type private FOwner, // The tree which is responsible for drag management. FDragSource : TBaseVirtualTree; // Reference to the source tree if the source was a VT, might be different than the owner tree. + FHeader : TVTHeader; FIsDropTarget : Boolean; // True if the owner is currently the drop target. FDataObject : IDataObject; // A reference to the data object passed in by DragEnter (only used when the owner tree is the current drop target). FDropTargetHelper : IDropTargetHelper; // Win2k > Drag image support @@ -50,6 +52,7 @@ type procedure ForceDragLeave; stdcall; function GiveFeedback(Effect : Integer) : HResult; stdcall; function QueryContinueDrag(EscapePressed : BOOL; KeyState : Integer) : HResult; stdcall; + class function GetTreeFromDataObject(const DataObject: TVTDragDataObject): TBaseVirtualTree; end; var @@ -69,6 +72,7 @@ var implementation uses + VirtualTrees.Clipboard, VirtualTrees.DataObject; type @@ -163,10 +167,6 @@ constructor TVTDragManager.Create(AOwner : TBaseVirtualTree); begin inherited Create; FOwner := AOwner; - - // Create an instance of the drop target helper interface. This will fail but not harm on systems which do - // not support this interface (everything below Windows 2000); - CoCreateInstance(CLSID_DragDropHelper, nil, CLSCTX_INPROC_SERVER, IID_IDropTargetHelper, FDropTargetHelper); end; //---------------------------------------------------------------------------------------------------------------------- @@ -212,10 +212,43 @@ begin Result := FIsDropTarget; end; +class function TVTDragManager.GetTreeFromDataObject(const DataObject: TVTDragDataObject): TBaseVirtualTree; +// Returns the owner/sender of the given data object by means of a special clipboard format +// or nil if the sender is in another process or no virtual tree at all. + +var + Medium: TStgMedium; + Data: PVTReference; + +begin + Result := nil; + if Assigned(DataObject) then + begin + StandardOLEFormat.cfFormat := CF_VTREFERENCE; + if DataObject.GetData(StandardOLEFormat, Medium) = S_OK then + begin + Data := GlobalLock(Medium.hGlobal); + if Assigned(Data) then + begin + if Data.Process = GetCurrentProcessID then + Result := Data.Tree; + GlobalUnlock(Medium.hGlobal); + end; + ReleaseStgMedium(Medium); + end; + end; +end; + //---------------------------------------------------------------------------------------------------------------------- function TVTDragManager.DragEnter(const DataObject : IDataObject; KeyState : Integer; Pt : TPoint; var Effect : Integer) : HResult; +var + Medium: TStgMedium; + HeaderFormatEtc: TFormatEtc; begin + if not Assigned(FDropTargetHelper) then + CoCreateInstance(CLSID_DragDropHelper, nil, CLSCTX_INPROC_SERVER, IID_IDropTargetHelper, FDropTargetHelper); + FDataObject := DataObject; FIsDropTarget := True; @@ -226,13 +259,24 @@ begin LockWindowUpdate(0); if Assigned(FDropTargetHelper) and FFullDragging then begin - if toAutoScroll in TreeView.TreeOptions.AutoOptions then + if (toAutoScroll in TreeView.TreeOptions.AutoOptions) and (toAcceptOLEDrop in TreeView.TreeOptions.MiscOptions) then FDropTargetHelper.DragEnter(FOwner.Handle, DataObject, Pt, Effect) else FDropTargetHelper.DragEnter(0, DataObject, Pt, Effect); // Do not pass handle, otherwise the IDropTargetHelper will perform autoscroll. Issue #486 end; - FDragSource := TreeView.GetTreeFromDataObject(DataObject); + FDragSource := GetTreeFromDataObject(DataObject); Result := TreeView.DragEnter(KeyState, Pt, Effect); + HeaderFormatEtc := StandardOLEFormat; + HeaderFormatEtc.cfFormat := CF_VTHEADERREFERENCE; + if (DataObject.GetData(HeaderFormatEtc, Medium) = S_OK) and (FDragSource = FOWner) then + begin + FHeader := FDragSource.Header; + FDRagSource := nil; + end + else + begin + fHeader := nil; + end; end; //---------------------------------------------------------------------------------------------------------------------- @@ -242,10 +286,12 @@ begin if Assigned(FDropTargetHelper) and FFullDragging then FDropTargetHelper.DragLeave; - TreeView.DragLeave; + if (toAcceptOLEDrop in TreeView.TreeOptions.MiscOptions) then + TreeView.DragLeave; FIsDropTarget := False; FDragSource := nil; FDataObject := nil; + fHeader := nil; Result := NOERROR; end; @@ -256,7 +302,13 @@ begin if Assigned(FDropTargetHelper) and FFullDragging then FDropTargetHelper.DragOver(Pt, Effect); - Result := TreeView.DragOver(FDragSource, KeyState, dsDragMove, Pt, Effect); + Result := NOERROR; + if Assigned(fHeader) then + begin + TreeView.Header.DragTo(Pt); + end + else if (toAcceptOLEDrop in TreeView.TreeOptions.MiscOptions) then + Result := TreeView.DragOver(FDragSource, KeyState, dsDragMove, Pt, Effect); end; //---------------------------------------------------------------------------------------------------------------------- @@ -266,7 +318,13 @@ begin if Assigned(FDropTargetHelper) and FFullDragging then FDropTargetHelper.Drop(DataObject, Pt, Effect); - Result := TreeView.DragDrop(DataObject, KeyState, Pt, Effect); + if Assigned(fHeader) then + begin + FHeader.ColumnDropped(Pt); + Result := NO_ERROR; + end + else + Result := TreeView.DragDrop(DataObject, KeyState, Pt, Effect); FIsDropTarget := False; FDataObject := nil; end; diff --git a/components/virtualtreeview/Source/VirtualTrees.DrawTree.pas b/components/virtualtreeview/Source/VirtualTrees.DrawTree.pas index 7229975c..284cbf21 100644 --- a/components/virtualtreeview/Source/VirtualTrees.DrawTree.pas +++ b/components/virtualtreeview/Source/VirtualTrees.DrawTree.pas @@ -40,7 +40,7 @@ type property OnGetNodeWidth: TVTGetNodeWidthEvent read FOnGetNodeWidth write FOnGetNodeWidth; end; - [ComponentPlatformsAttribute(pidWin32 or pidWin64)] + [ComponentPlatformsAttribute(pfidWindows)] TVirtualDrawTree = class(TCustomVirtualDrawTree) private function GetOptions: TVirtualTreeOptions; diff --git a/components/virtualtreeview/Source/VirtualTrees.FMX.pas b/components/virtualtreeview/Source/VirtualTrees.FMX.pas index 15caa1a2..fa2ad407 100644 --- a/components/virtualtreeview/Source/VirtualTrees.FMX.pas +++ b/components/virtualtreeview/Source/VirtualTrees.FMX.pas @@ -191,13 +191,14 @@ const SM_CXVSCROLL = 2; SM_CYHSCROLL = 3; var - // Clipboard format IDs used in OLE drag'n drop and clipboard transfers. - CF_VIRTUALTREE, - CF_VTREFERENCE, - CF_VRTF, - CF_VRTFNOOBJS, // Unfortunately CF_RTF* is already defined as being - // registration strings so I have to use different identifiers. - CF_HTML, + // Clipboard format IDs used in OLE drag'n drop and clipboard transfers. + CF_VIRTUALTREE, + CF_VTREFERENCE, // A reference to a virtual tree + CF_VTHEADERREFERENCE, // drapg and drop of column headers + CF_VRTF, + CF_VRTFNOOBJS, // Unfortunately CF_RTF* is already defined as being + // registration strings so I have to use different identifiers. + CF_HTML, CF_CSV: Word; type diff --git a/components/virtualtreeview/Source/VirtualTrees.Header.pas b/components/virtualtreeview/Source/VirtualTrees.Header.pas index 4d3eb280..440de4a3 100644 --- a/components/virtualtreeview/Source/VirtualTrees.Header.pas +++ b/components/virtualtreeview/Source/VirtualTrees.Header.pas @@ -197,7 +197,6 @@ type FNeedPositionsFix : Boolean; // True if FixPositions must still be called after DFM loading or Bidi mode change. FClearing : Boolean; // True if columns are being deleted entirely. FColumnPopupMenu : TPopupMenu; // Member for storing the TVTHeaderPopupMenu - function GetCount : Integer; function GetItem(Index : TColumnIndex) : TVirtualTreeColumn; function GetNewIndex(P : TPoint; var OldIndex : TColumnIndex) : Boolean; @@ -380,7 +379,6 @@ type function DoHeightTracking(var P : TPoint; Shift : TShiftState) : Boolean; virtual; function DoHeightDblClickResize(var P : TPoint; Shift : TShiftState) : Boolean; virtual; procedure DoSetSortColumn(Value : TColumnIndex; pSortDirection : TSortDirection); virtual; - procedure DragTo(P : TPoint); virtual; procedure FixedAreaConstraintsChanged(Sender : TObject); function GetColumnsClass : TVirtualTreeColumnsClass; virtual; function GetOwner : TPersistent; override; @@ -406,6 +404,8 @@ type procedure Assign(Source : TPersistent); override; procedure AutoFitColumns(); overload; procedure AutoFitColumns(Animated : Boolean; SmartAutoFitType : TSmartAutoFitType = smaUseColumnOption; RangeStartCol : Integer = NoColumn; RangeEndCol : Integer = NoColumn); overload; virtual; + procedure ColumnDropped(const P: TPoint); + procedure DragTo(P : TPoint); function InHeader(P : TPoint) : Boolean; virtual; function InHeaderSplitterArea(P : TPoint) : Boolean; virtual; procedure Invalidate(Column : TVirtualTreeColumn; ExpandToBorder : Boolean = False; UpdateNowFlag : Boolean = False); @@ -450,6 +450,7 @@ implementation uses WinApi.ShlObj, + WinApi.ActiveX, WinApi.UxTheme, System.Math, System.SysUtils, @@ -457,8 +458,8 @@ uses Vcl.Forms, VirtualTrees.HeaderPopup, VirtualTrees.BaseTree, - VirtualTrees.BaseAncestorVcl{to eliminate H2443 about inline expanding} - ; + VirtualTrees.BaseAncestorVcl, // to eliminate H2443 about inline expanding + VirtualTrees.DataObject; type TVirtualTreeColumnsCracker = class(TVirtualTreeColumns); @@ -479,6 +480,9 @@ type function TreeViewControl : TBaseVirtualTreeCracker; end; +const + cMargin = 2; // the margin between text and the header rectangle + cDownOffset = 1; // the offset of the column header text whit mouse button down //----------------- TVTFixedAreaConstraints ---------------------------------------------------------------------------- @@ -584,13 +588,6 @@ begin FMainColumn := NoColumn; FDragImage := TVTDragImage.Create(AOwner); - with FDragImage do - begin - Fade := False; - PreBlendBias := - 50; - Transparency := 140; - end; - fSplitterHitTolerance := 8; FFixedAreaConstraints := TVTFixedAreaConstraints.Create(Self); FFixedAreaConstraints.OnChange := FixedAreaConstraintsChanged; @@ -1254,27 +1251,7 @@ begin //Fix for various problems mentioned in issue 248. if NeedRepaint then - begin TBaseVirtualTreeCracker(FOwner).UpdateWindow(); - - //The new routine recaptures the backup image after the updatewindow - //Note: We could have called this unconditionally but when called - //over the tree, doesn't capture the background image. Since our - //problems are in painting of the header, we call it only when the - //drag image is over the header. - if - //determine the case when the drag image is or was on the header area - (InHeader(FOwner.ScreenToClient(FDragImage.LastPosition)) or InHeader(FOwner.ScreenToClient(FDragImage.ImagePosition))) then - begin - GDIFlush; - TBaseVirtualTreeCracker(FOwner).UpdateWindowAndDragImage(TBaseVirtualTree(FOwner), TBaseVirtualTreeCracker(FOwner).HeaderRect, True, True); - end; - //since we took care of UpdateWindow above, there is no need to do an - //update window again by sending NeedRepaint. So switch off the second parameter. - NeedRepaint := False; - end; - - FDragImage.DragTo(P, NeedRepaint); end; //---------------------------------------------------------------------------------------------------------------------- @@ -1422,8 +1399,8 @@ begin if I > NoColumn then Invalidate(FColumns[I]); end; - PrepareDrag(P, FDragStart); FStates := FStates - [hsDragPending] + [hsDragging]; + PrepareDrag(P, FDragStart); HandleHeaderMouseMove := True; Result := 0; end; @@ -1451,9 +1428,7 @@ function TVTHeader.HandleMessage(var Message : TMessage) : Boolean; var P : TPoint; - R : TRect; I : TColumnIndex; - OldPosition : Integer; HitIndex : TColumnIndex; NewCursor : TVTCursor; Button : TMouseButton; @@ -1682,54 +1657,7 @@ begin //successfull dragging moves columns with TWMLButtonUp(Message) do P := Tree.ClientToScreen(Point(XPos, YPos)); - GetWindowRect(Tree.Handle, R); - with FColumns do - begin - FDragImage.EndDrag; - - //Problem fixed: - //Column Header does not paint correctly after a drop in certain conditions - // ** The conditions are, drag is across header, mouse is not moved after - //the drop and the graphics hardware is slow in certain operations (encountered - //on Windows 10). - //Fix for the problem on certain systems where the dropped column header - //does not appear in the new position if the mouse is not moved after - //the drop. The reason is that the restore backup image operation (BitBlt) - //in the above EndDrag is slower than the header repaint in the code below - //and overlaps the new changed header with the older image. - //This happens because BitBlt seems to operate in its own thread in the - //graphics hardware and finishes later than the following code. - // - //To solve this problem, we introduce a small delay here so that the - //changed header in the following code is correctly repainted after - //the delayed BitBlt above has finished operation to restore the old - //backup image. - sleep(50); - - if (DropTarget > - 1) and (DropTarget <> DragIndex) and PtInRect(R, P) then - begin - OldPosition := FColumns[DragIndex].Position; - if FColumns.DropBefore then - begin - if FColumns[DragIndex].Position < FColumns[DropTarget].Position then - FColumns[DragIndex].Position := Max(0, FColumns[DropTarget].Position - 1) - else - FColumns[DragIndex].Position := FColumns[DropTarget].Position; - end - else - begin - if FColumns[DragIndex].Position < FColumns[DropTarget].Position then - FColumns[DragIndex].Position := FColumns[DropTarget].Position - else - FColumns[DragIndex].Position := FColumns[DropTarget].Position + 1; - end; - Tree.DoHeaderDragged(DragIndex, OldPosition); - end - else - Tree.DoHeaderDraggedOut(DragIndex, P); - DropTarget := NoColumn; - end; - Invalidate(nil); + ColumnDropped(P); end; Result := True; Message.Result := 0; @@ -1898,6 +1826,62 @@ begin end; end; +procedure TVTHeader.ColumnDropped(const P: TPoint); +var + R: TRect; + OldPosition: Integer; +begin + GetWindowRect(Tree.Handle, R); + with FColumns do + begin + FDragImage.EndDrag; + + //Problem fixed: + //Column Header does not paint correctly after a drop in certain conditions + // ** The conditions are, drag is across header, mouse is not moved after + //the drop and the graphics hardware is slow in certain operations (encountered + //on Windows 10). + //Fix for the problem on certain systems where the dropped column header + //does not appear in the new position if the mouse is not moved after + //the drop. The reason is that the restore backup image operation (BitBlt) + //in the above EndDrag is slower than the header repaint in the code below + //and overlaps the new changed header with the older image. + //This happens because BitBlt seems to operate in its own thread in the + //graphics hardware and finishes later than the following code. + // + //To solve this problem, we introduce a small delay here so that the + //changed header in the following code is correctly repainted after + //the delayed BitBlt above has finished operation to restore the old + //backup image. + sleep(50); + + if (DropTarget > - 1) and (DropTarget <> DragIndex) and PtInRect(R, P) then + begin + OldPosition := FColumns[DragIndex].Position; + if FColumns.DropBefore then + begin + if FColumns[DragIndex].Position < FColumns[DropTarget].Position then + FColumns[DragIndex].Position := Max(0, FColumns[DropTarget].Position - 1) + else + FColumns[DragIndex].Position := FColumns[DropTarget].Position; + end + else + begin + if FColumns[DragIndex].Position < FColumns[DropTarget].Position then + FColumns[DragIndex].Position := FColumns[DropTarget].Position + else + FColumns[DragIndex].Position := FColumns[DropTarget].Position + 1; + end; + Tree.DoHeaderDragged(DragIndex, OldPosition); + end + else + Tree.DoHeaderDraggedOut(DragIndex, P); + DropTarget := NoColumn; + FStates := FStates - [hsDragging, hsDragPending]; + end; + Invalidate(nil); +end; + //---------------------------------------------------------------------------------------------------------------------- procedure TVTHeader.ImageListChange(Sender : TObject); @@ -1915,9 +1899,11 @@ procedure TVTHeader.PrepareDrag(P, Start : TPoint); var Image : TBitmap; - ImagePos : TPoint; + HotSpot : TPoint; DragColumn : TVirtualTreeColumn; RTLOffset : TDimension; + lDataObject: IDataObject; + lDragEffect: DWord; // The last executed drag effect, not needed here begin //Determine initial position of drag image (screen coordinates). @@ -1945,19 +1931,19 @@ begin with DragColumn do FColumns.PaintHeader(Canvas, Rect(Left, 0, Left + Width, Height), Point( - RTLOffset, 0), RTLOffset); - if Tree.UseRightToLeftAlignment then - ImagePos := Tree.ClientToScreen(Point(DragColumn.Left + Tree.ComputeRTLOffset(True), 0)) - else - ImagePos := Tree.ClientToScreen(Point(DragColumn.Left, 0)); //Column rectangles are given in local window coordinates not client coordinates. - Dec(ImagePos.Y, FHeight); + HotSpot := Tree.ScreenToClient(P); + HotSpot.X := HotSpot.X - DragColumn.Left - cMargin; + HotSpot.Y := HotSpot.Y + Height - cMargin; // header is in the non-client area and so the coordinates are negative if hoRestrictDrag in FOptions then FDragImage.MoveRestriction := dmrHorizontalOnly else FDragImage.MoveRestriction := dmrNone; - FDragImage.PrepareDrag(Image, ImagePos, P, nil); - FDragImage.ShowDragImage; + + lDataObject := TVTDataObject.Create(Self, TreeView); + FDragImage.PrepareDrag(Image, HotSpot, lDataObject); + SHDoDragDrop(fOwner.Handle, lDataObject, nil, DROPEFFECT_MOVE, lDragEffect); // SHDoDragDrop() supports drag hints and drag images on Windows Vista and later finally Image.Free; end; @@ -2955,6 +2941,7 @@ begin PaintInfo.Column := Self; PaintInfo.TargetCanvas := Owner.HeaderBitmap.Canvas; + PaintInfo.TargetCanvas.Font := Header.Font; with PaintInfo, Column do begin @@ -5638,7 +5625,7 @@ var PaintRectangle := ATargetRect; // calculate text and glyph position - InflateRect(PaintRectangle, - 2, - 2); + InflateRect(PaintRectangle, - cMargin, - cMargin); DrawFormat := DT_TOP or DT_NOPREFIX; case CaptionAlignment of taLeftJustify : @@ -5655,7 +5642,7 @@ var // Move glyph and text one pixel to the right and down to simulate a pressed button. if IsDownIndex then begin - OffsetRect(TextRectangle, 1, 1); + OffsetRect(TextRectangle, cDownOffset, cDownOffset); Inc(GlyphPos.X); Inc(GlyphPos.Y); Inc(SortGlyphPos.X); @@ -5758,6 +5745,8 @@ var var TargetRect : TRect; MaxX : TDimension; + Count: Integer; + EndCol: TColumnIndex; begin if IsRectEmpty(R) then Exit; @@ -5814,7 +5803,21 @@ begin // Now go for each button. while (Run > NoColumn) and (TargetRect.Left < MaxX) do begin - TargetRect.Right := TargetRect.Left + Items[Run].Width; + + //let application decide how many columns can be spanned + Count:= 1; + TreeViewControl.DoColumnHeaderSpanning(Run, Count); + + if Count > FHeader.Columns.Count then Count := FHeader.Columns.Count; + if Count < 1 then Count := 1; + + EndCol:= Run; + TargetRect.Right := TargetRect.Left; + repeat + Inc(TargetRect.Right, Items[EndCol].Width); + Dec(Count); + EndCol := GetNextVisibleColumn(EndCol); + until (Count = 0) or (EndCol <= NoColumn); // create a clipping rect to limit painting to button area ClipCanvas(TargetCanvas, Rect(Max(TargetRect.Left, Target.X), Target.Y + R.Top, @@ -5825,7 +5828,8 @@ begin SelectClipRgn(Handle, 0); TargetRect.Left := TargetRect.Right; - Run := GetNextVisibleColumn(Run); + + Run := EndCol; end; end; end; diff --git a/components/virtualtreeview/Source/VirtualTrees.Types.pas b/components/virtualtreeview/Source/VirtualTrees.Types.pas index 7a2b82fc..444563d1 100644 --- a/components/virtualtreeview/Source/VirtualTrees.Types.pas +++ b/components/virtualtreeview/Source/VirtualTrees.Types.pas @@ -94,6 +94,7 @@ const // to implement optimized moves and other back references. CFSTR_VIRTUALTREE = 'Virtual Tree Data'; CFSTR_VTREFERENCE = 'Virtual Tree Reference'; + CFSTR_VTHEADERREFERENCE = 'Virtual Tree Header Reference'; CFSTR_HTML = 'HTML Format'; CFSTR_RTF = 'Rich Text Format'; CFSTR_RTFNOOBJS = 'Rich Text Format Without Objects'; @@ -127,14 +128,16 @@ type {$IFDEF VT_FMX} TDimension = Single; PDimension = ^Single; + TNodeHeight = Single; TVTCursor = TCursor; TVTDragDataObject = TDragObject; TVTBackground = TBitmap; TVTPaintContext = TCanvas; TVTBrush = TBrush; {$ELSE} - TDimension = Integer; // For Firemonkey support, see #841 + TDimension = Integer; // Introduced for Firemonkey support, see #841 PDimension = ^Integer; + TNodeHeight = NativeInt; TVTCursor = HCURSOR; IDataObject= WinApi.ActiveX.IDataObject; TVTDragDataObject = IDataObject; @@ -142,7 +145,7 @@ type TVTPaintContext = HDC; TVTBrush = HBRUSH; {$ENDIF} - TColumnIndex = type Integer; + TColumnIndex = {$if CompilerVersion < 36} type {$endif} Integer; // See issue #1276 TColumnPosition = type Cardinal; PCardinal = ^Cardinal; @@ -158,6 +161,23 @@ type TFormatEtcArray = array of TFormatEtc; TFormatArray = array of Word; + // See issue #1270. + // Taken from: https://learn.microsoft.com/en-us/windows/win32/menurc/about-cursors + // To be used with: LoadCursor(0, MAKEINTRESOURCE(TPanningCursor.MoveAll)) + TPanningCursor = ( + MoveAll = 32654, + MoveNS = 32652, + MoveEW = 32653, + MoveN = 32655, + MoveNE = 32660, + MoveE = 32658, + MoveSE = 32662, + MoveS = 32656, + MoveSW = 32661, + MoveW = 32657, + MoveNW = 32659 + ); + TSmartAutoFitType = ( smaAllColumns, // consider nodes in view only for all columns smaNoColumn, // consider nodes in view only for no column @@ -517,8 +537,7 @@ type tsVCLDragging, // VCL drag'n drop in progress. tsVCLDragPending, // One-shot flag to avoid clearing the current selection on implicit mouse up for VCL drag. tsVCLDragFinished, // Flag to avoid triggering the OnColumnClick event twice - tsWheelPanning, // Wheel mouse panning is active or soon will be. - tsWheelScrolling, // Wheel mouse scrolling is active or soon will be. + tsPanning, // Mouse panning is active. tsWindowCreating, // Set during window handle creation to avoid frequent unnecessary updates. tsUseExplorerTheme // The tree runs under WinVista+ and is using the explorer theme ); @@ -705,7 +724,7 @@ type TVTButtonFillMode = ( fmTreeColor, // solid color, uses the tree's background color fmWindowColor, // solid color, uses clWindow - fmShaded, // color gradient, Windows XP style (legacy code, use toThemeAware on Windows XP instead) + fmShaded, // no longer supported, use toThemeAware for Windows XP and later instead fmTransparent // transparent color, use the item's background color ); @@ -889,7 +908,7 @@ type private fIndex: Cardinal; // index of node with regard to its parent fChildCount: Cardinal; // number of child nodes - fNodeHeight: TDimension; // height in pixels + fNodeHeight: TNodeHeight; // height in pixels public States: TVirtualNodeStates; // states describing various properties of the node (expanded, initialized etc.) Align: Byte; // line/button alignment @@ -897,8 +916,7 @@ type CheckType: TCheckType; // indicates which check type shall be used for this node Dummy: Byte; // dummy value to fill DWORD boundary TotalCount: Cardinal; // sum of this node, all of its child nodes and their child nodes etc. - TotalHeight: TDimension; // height in pixels this node covers on screen including the height of all of its - // children + TotalHeight: TNodeHeight;// height in pixels this node covers on screen including the height of all of its children. _Filler: TDWordFiller; // Ensure 8 Byte alignment of following pointers for 64bit builds. Issue #1136 // Note: Some copy routines require that all pointers (as well as the data area) in a node are // located at the end of the node! Hence if you want to add new member fields (except pointers to internal @@ -919,14 +937,14 @@ type procedure SetLastChild(const pLastChild: PVirtualNode); inline; //internal method, do not call directly procedure SetIndex(const pIndex: Cardinal); inline; //internal method, do not call directly. procedure SetChildCount(const pCount: Cardinal); inline; //internal method, do not call directly. - procedure SetNodeHeight(const pNodeHeight: TDimension); inline; //internal method, do not call directly. + procedure SetNodeHeight(const pNodeHeight: TNodeHeight); inline; //internal method, do not call directly. property Index: Cardinal read fIndex; property ChildCount: Cardinal read fChildCount; property Parent: PVirtualNode read fParent; property PrevSibling: PVirtualNode read fPrevSibling; property NextSibling: PVirtualNode read fNextSibling; property LastChild: PVirtualNode read fLastChild; - property NodeHeight: TDimension read fNodeHeight; + property NodeHeight: TNodeHeight read fNodeHeight; private Data: record end; // this is a placeholder, each node gets extra data determined by NodeDataSize public @@ -1153,7 +1171,7 @@ begin Exit(@Self <> nil); end; -procedure TVirtualNode.SetNodeHeight(const pNodeHeight: TDimension); +procedure TVirtualNode.SetNodeHeight(const pNodeHeight: TNodeHeight); begin fNodeHeight := pNodeHeight; end; @@ -1345,12 +1363,8 @@ begin if not (csDesigning in ComponentState) then begin - if toAcceptOLEDrop in ToBeCleared then - RevokeDragDrop(Handle); if toFullRepaintOnResize in ToBeSet + ToBeCleared then RecreateWnd; - if toAcceptOLEDrop in ToBeSet then - RegisterDragDrop(Handle, DragManager as IDropTarget); if toVariableNodeHeight in ToBeSet then begin BeginUpdate(); diff --git a/components/virtualtreeview/Source/VirtualTrees.pas b/components/virtualtreeview/Source/VirtualTrees.pas index 4cc7e1cd..00e5c7ff 100644 --- a/components/virtualtreeview/Source/VirtualTrees.pas +++ b/components/virtualtreeview/Source/VirtualTrees.pas @@ -22,8 +22,6 @@ // (C) 1999-2001 digital publishing AG. All Rights Reserved. //---------------------------------------------------------------------------------------------------------------------- // -// For a list of recent changes please see file CHANGES.TXT -// // Credits for their valuable assistance and code donations go to: // Freddy Ertl, Marian Aldenhoevel, Thomas Bogenrieder, Jim Kuenemann, Werner Lehmann, Jens Treichler, // Paul Gallagher (IBO tree), Ondrej Kelle, Ronaldo Melo Ferraz, Heri Bender, Roland Beduerftig (BCB) @@ -62,18 +60,6 @@ interface {$LEGACYIFEND ON} {$WARN UNSUPPORTED_CONSTRUCT OFF} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$ifdef BCB} - {$HPPEMIT '#pragma comment(lib, "VirtualTreesCR")'} -{$else} - {$HPPEMIT '#pragma comment(lib, "VirtualTreesR")'} -{$endif} -{$HPPEMIT '#pragma comment(lib, "Shell32")'} -{$HPPEMIT '#pragma comment(lib, "uxtheme")'} -{$HPPEMIT '#pragma link "VirtualTrees.Accessibility"'} - uses Winapi.Windows, Winapi.Messages, Winapi.ActiveX, System.Classes, System.SysUtils, @@ -131,7 +117,7 @@ type TVTAutoOption = VirtualTrees.Types.TVTAutoOption; TVTAutoOptions = VirtualTrees.Types.TVTAutoOptions; TVTSelectionOption = VirtualTrees.Types.TVTSelectionOption; - TVstTextType = VirtualTrees.Types.TVstTextType; + TVSTTextType = VirtualTrees.Types.TVSTTextType; TVTHintMode = VirtualTrees.Types.TVTHintMode; TBaseVirtualTree = VirtualTrees.BaseTree.TBaseVirtualTree; IVTEditLink = VirtualTrees.BaseTree.IVTEditLink; @@ -348,7 +334,7 @@ type property Text[Node: PVirtualNode; Column: TColumnIndex]: string read GetText write SetText; end; - [ComponentPlatformsAttribute(pidWin32 or pidWin64)] + [ComponentPlatformsAttribute(pfidWindows)] TVirtualStringTree = class(TCustomVirtualStringTree) private function GetOptions: TStringTreeOptions; @@ -595,6 +581,7 @@ type property OnCanResize; property OnGesture; property Touch; + property OnColumnHeaderSpanning; end; //---------------------------------------------------------------------------------------------------------------------- diff --git a/components/virtualtreeview/packages/Delphi11.1/VirtualTreeView.groupproj b/components/virtualtreeview/packages/Delphi11.1/VirtualTreeView.groupproj deleted file mode 100644 index b0f33e51..00000000 --- a/components/virtualtreeview/packages/Delphi11.1/VirtualTreeView.groupproj +++ /dev/null @@ -1,48 +0,0 @@ - - - {CC6A9541-DD5C-4BCD-8914-016D8D2EAB3B} - - - - - - - VirtualTreesR.dproj - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/virtualtreeview/packages/Delphi11.1/VirtualTreesD.dpk b/components/virtualtreeview/packages/Delphi11.1/VirtualTreesD.dpk deleted file mode 100644 index f5b6e519..00000000 --- a/components/virtualtreeview/packages/Delphi11.1/VirtualTreesD.dpk +++ /dev/null @@ -1,40 +0,0 @@ -package VirtualTreesD; - -{$R *.res} -{$R '..\..\Design\VirtualTrees.dcr'} -{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO OFF} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES OFF} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE RELEASE} -{$ENDIF IMPLICITBUILDING} -{$DESCRIPTION 'VirtualTreeView Controls'} -{$DESIGNONLY} -{$IMPLICITBUILD OFF} - -requires - DesignIDE, - VirtualTreesR; - -contains - VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; - -end. diff --git a/components/virtualtreeview/packages/Delphi11.1/VirtualTreesD.dproj b/components/virtualtreeview/packages/Delphi11.1/VirtualTreesD.dproj deleted file mode 100644 index f823ce64..00000000 --- a/components/virtualtreeview/packages/Delphi11.1/VirtualTreesD.dproj +++ /dev/null @@ -1,127 +0,0 @@ - - - True - Package - Release - DCC32 - VCL - VirtualTreesD.dpk - Win32 - {A34BA07B-19B6-4C21-9DEE-65FCA52D00AB} - 19.4 - 1 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - VirtualTreesD - All - ..\..\build\$(Platform) - VirtualTreeView Controls - ..\..\Source - 00400000 - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - true - true - true - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 1053 - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - vcl;VirtualTreesR;$(DCC_UsePackage) - $(BDS)\BIN\Bds.exe - - - RELEASE;$(DCC_Define) - - - DEBUG;$(DCC_Define) - true - false - - - - MainSource - - - - - - - Base - - - Cfg_1 - Base - - - Cfg_2 - Base - - - - Delphi.Personality.12 - Package - - - - VirtualTreesD.dpk - - - - True - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1053 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - True - False - - - 12 - - - - diff --git a/components/virtualtreeview/packages/Delphi11.1/VirtualTreesR.dpk b/components/virtualtreeview/packages/Delphi11.1/VirtualTreesR.dpk deleted file mode 100644 index bae6130d..00000000 --- a/components/virtualtreeview/packages/Delphi11.1/VirtualTreesR.dpk +++ /dev/null @@ -1,56 +0,0 @@ -package VirtualTreesR; - -{$R *.res} -{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO OFF} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO OFF} -{$SAFEDIVIDE OFF} -{$STACKFRAMES OFF} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE RELEASE} -{$ENDIF IMPLICITBUILDING} -{$RUNONLY} -{$IMPLICITBUILD OFF} - -requires - vcl, - vclx; - -contains - VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas', - VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Colors in '..\..\Source\VirtualTrees.Colors.pas', - VirtualTrees.DataObject in '..\..\Source\VirtualTrees.DataObject.pas', - VirtualTrees.DragImage in '..\..\Source\VirtualTrees.DragImage.pas', - VirtualTrees.DragnDrop in '..\..\Source\VirtualTrees.DragnDrop.pas', - VirtualTrees.DrawTree in '..\..\Source\VirtualTrees.DrawTree.pas', - VirtualTrees.EditLink in '..\..\Source\VirtualTrees.EditLink.pas', - VirtualTrees.Export in '..\..\Source\VirtualTrees.Export.pas', - VirtualTrees.Header in '..\..\Source\VirtualTrees.Header.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees in '..\..\source\VirtualTrees.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', - VirtualTrees.Types in '..\..\Source\VirtualTrees.Types.pas', - VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas'; - -end. diff --git a/components/virtualtreeview/packages/Delphi11.1/VirtualTreesR.dproj b/components/virtualtreeview/packages/Delphi11.1/VirtualTreesR.dproj deleted file mode 100644 index ff0f94cb..00000000 --- a/components/virtualtreeview/packages/Delphi11.1/VirtualTreesR.dproj +++ /dev/null @@ -1,145 +0,0 @@ - - - True - Package - Release - DCC32 - VCL - VirtualTreesR.dpk - Win32 - {B62F3689-96E1-47D5-9FB2-2A2718281FDB} - 19.4 - 3 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - VirtualTreesR - All - ..\..\build\$(Platform) - ..\..\Source - 00400000 - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - true - true - true - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 1053 - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - 0 - RELEASE;$(DCC_Define) - false - 0 - - - DEBUG;$(DCC_Define) - true - false - - - - MainSource - - - - - - - - - - - - - - - - - - - - - - - - Base - - - Cfg_1 - Base - - - Cfg_2 - Base - - - - Delphi.Personality.12 - Package - - - - VirtualTreesR.dpk - - - - True - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1053 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - True - True - - - 12 - - - - - diff --git a/components/virtualtreeview/packages/Delphi11.2/VirtualTreeView.groupproj b/components/virtualtreeview/packages/Delphi11.2/VirtualTreeView.groupproj deleted file mode 100644 index b0f33e51..00000000 --- a/components/virtualtreeview/packages/Delphi11.2/VirtualTreeView.groupproj +++ /dev/null @@ -1,48 +0,0 @@ - - - {CC6A9541-DD5C-4BCD-8914-016D8D2EAB3B} - - - - - - - VirtualTreesR.dproj - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/virtualtreeview/packages/Delphi11.2/VirtualTreesD.dpk b/components/virtualtreeview/packages/Delphi11.2/VirtualTreesD.dpk deleted file mode 100644 index f5b6e519..00000000 --- a/components/virtualtreeview/packages/Delphi11.2/VirtualTreesD.dpk +++ /dev/null @@ -1,40 +0,0 @@ -package VirtualTreesD; - -{$R *.res} -{$R '..\..\Design\VirtualTrees.dcr'} -{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO OFF} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES OFF} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE RELEASE} -{$ENDIF IMPLICITBUILDING} -{$DESCRIPTION 'VirtualTreeView Controls'} -{$DESIGNONLY} -{$IMPLICITBUILD OFF} - -requires - DesignIDE, - VirtualTreesR; - -contains - VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; - -end. diff --git a/components/virtualtreeview/packages/Delphi11.2/VirtualTreesD.dproj b/components/virtualtreeview/packages/Delphi11.2/VirtualTreesD.dproj deleted file mode 100644 index 0dcd41cc..00000000 --- a/components/virtualtreeview/packages/Delphi11.2/VirtualTreesD.dproj +++ /dev/null @@ -1,127 +0,0 @@ - - - True - Package - Release - DCC32 - VCL - VirtualTreesD.dpk - Win32 - {A34BA07B-19B6-4C21-9DEE-65FCA52D00AB} - 19.5 - 1 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - VirtualTreesD - All - ..\..\build\$(Platform) - VirtualTreeView Controls - ..\..\Source - 00400000 - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - true - true - true - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 1053 - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - vcl;VirtualTreesR;$(DCC_UsePackage) - $(BDS)\BIN\Bds.exe - - - RELEASE;$(DCC_Define) - - - DEBUG;$(DCC_Define) - true - false - - - - MainSource - - - - - - - Base - - - Cfg_1 - Base - - - Cfg_2 - Base - - - - Delphi.Personality.12 - Package - - - - VirtualTreesD.dpk - - - - True - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1053 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - True - False - - - 12 - - - - diff --git a/components/virtualtreeview/packages/Delphi11.2/VirtualTreesR.dpk b/components/virtualtreeview/packages/Delphi11.2/VirtualTreesR.dpk deleted file mode 100644 index 001c4342..00000000 --- a/components/virtualtreeview/packages/Delphi11.2/VirtualTreesR.dpk +++ /dev/null @@ -1,60 +0,0 @@ -package VirtualTreesR; - -{$R *.res} -{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO OFF} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO OFF} -{$SAFEDIVIDE OFF} -{$STACKFRAMES OFF} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE RELEASE} -{$ENDIF IMPLICITBUILDING} -{$RUNONLY} -{$IMPLICITBUILD OFF} - -requires - vcl, - vclx; - -contains - VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas', - VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Colors in '..\..\Source\VirtualTrees.Colors.pas', - VirtualTrees.DataObject in '..\..\Source\VirtualTrees.DataObject.pas', - VirtualTrees.DragImage in '..\..\Source\VirtualTrees.DragImage.pas', - VirtualTrees.DragnDrop in '..\..\Source\VirtualTrees.DragnDrop.pas', - VirtualTrees.DrawTree in '..\..\Source\VirtualTrees.DrawTree.pas', - VirtualTrees.EditLink in '..\..\Source\VirtualTrees.EditLink.pas', - VirtualTrees.Export in '..\..\Source\VirtualTrees.Export.pas', - VirtualTrees.Header in '..\..\Source\VirtualTrees.Header.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees in '..\..\source\VirtualTrees.pas', - VirtualTrees.BaseTree in '..\..\source\VirtualTrees.BaseTree.pas', - VirtualTrees.AncestorVCL in '..\..\source\VirtualTrees.AncestorVCL.pas', - VirtualTrees.BaseAncestorVCL in '..\..\source\VirtualTrees.BaseAncestorVCL.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', - VirtualTrees.Types in '..\..\Source\VirtualTrees.Types.pas', - VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas'; - -end. - diff --git a/components/virtualtreeview/packages/Delphi11.2/VirtualTreesR.dproj b/components/virtualtreeview/packages/Delphi11.2/VirtualTreesR.dproj deleted file mode 100644 index 20e67da0..00000000 --- a/components/virtualtreeview/packages/Delphi11.2/VirtualTreesR.dproj +++ /dev/null @@ -1,147 +0,0 @@ - - - True - Package - Release - DCC32 - VCL - VirtualTreesR.dpk - Win32 - {B62F3689-96E1-47D5-9FB2-2A2718281FDB} - 19.5 - 3 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - VirtualTreesR - All - ..\..\build\$(Platform) - ..\..\Source - 00400000 - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - true - true - true - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 1053 - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - 0 - RELEASE;$(DCC_Define) - false - 0 - - - DEBUG;$(DCC_Define) - true - false - - - - MainSource - - - - - - - - - - - - - - - - - - - - - - - - - - - Base - - - Cfg_1 - Base - - - Cfg_2 - Base - - - - Delphi.Personality.12 - Package - - - - VirtualTreesR.dpk - - - - True - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1053 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - True - True - - - 12 - - - - diff --git a/components/virtualtreeview/packages/RAD Studio 10.4+/VirtualTreesR.dpk b/components/virtualtreeview/packages/RAD Studio 10.4+/VirtualTreesR.dpk index f65fc3b6..fd8bf7ad 100644 --- a/components/virtualtreeview/packages/RAD Studio 10.4+/VirtualTreesR.dpk +++ b/components/virtualtreeview/packages/RAD Studio 10.4+/VirtualTreesR.dpk @@ -9,7 +9,7 @@ package VirtualTreesR; {$EXTENDEDSYNTAX ON} {$IMPORTEDDATA ON} {$IOCHECKS ON} -{$LOCALSYMBOLS ON} +{$LOCALSYMBOLS OFF} {$LONGSTRINGS ON} {$OPENSTRINGS ON} {$OPTIMIZATION ON} diff --git a/components/virtualtreeview/packages/RAD Studio 10.4+/VirtualTreesR.dproj b/components/virtualtreeview/packages/RAD Studio 10.4+/VirtualTreesR.dproj index d5e40be0..8ee13576 100644 --- a/components/virtualtreeview/packages/RAD Studio 10.4+/VirtualTreesR.dproj +++ b/components/virtualtreeview/packages/RAD Studio 10.4+/VirtualTreesR.dproj @@ -6,7 +6,7 @@ DCC32 VCL VirtualTreesR.dpk - Win32 + Win64 {B62F3689-96E1-47D5-9FB2-2A2718281FDB} 20.1 3 @@ -120,7 +120,10 @@ VirtualTreesR.dpk - + + Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver + Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server + True False diff --git a/packages/Delphi11.1/heidisql.dpr b/packages/Delphi11.1/heidisql.dpr deleted file mode 100644 index a37910c4..00000000 --- a/packages/Delphi11.1/heidisql.dpr +++ /dev/null @@ -1,115 +0,0 @@ -program heidisql; - -uses - madExcept, - Forms, - SysUtils, - Dialogs, - Windows, - main in '..\..\source\main.pas' {MainForm}, - about in '..\..\source\about.pas' {AboutBox}, - connections in '..\..\source\connections.pas' {connform}, - loaddata in '..\..\source\loaddata.pas' {loaddataform}, - usermanager in '..\..\source\usermanager.pas' {UserManagerForm}, - preferences in '..\..\source\preferences.pas' {frmPreferences}, - tabletools in '..\..\source\tabletools.pas' {frmTableTools}, - printlist in '..\..\source\printlist.pas' {printlistForm}, - copytable in '..\..\source\copytable.pas' {CopyTableForm}, - insertfiles in '..\..\source\insertfiles.pas' {frmInsertFiles}, - apphelpers in '..\..\source\apphelpers.pas', - sqlhelp in '..\..\source\sqlhelp.pas' {frmSQLhelp}, - dbstructures in '..\..\source\dbstructures.pas', - dbstructures.mysql in '..\..\source\dbstructures.mysql.pas', - dbstructures.mssql in '..\..\source\dbstructures.mssql.pas', - dbstructures.postgresql in '..\..\source\dbstructures.postgresql.pas', - dbstructures.sqlite in '..\..\source\dbstructures.sqlite.pas', - dbstructures.interbase in '..\..\source\dbstructures.interbase.pas', - column_selection in '..\..\source\column_selection.pas' {frmColumnSelection}, - data_sorting in '..\..\source\data_sorting.pas' {frmDataSorting}, - createdatabase in '..\..\source\createdatabase.pas' {CreateDatabaseForm}, - updatecheck in '..\..\source\updatecheck.pas' {frmUpdateCheck}, - editvar in '..\..\source\editvar.pas' {frmEditVariable}, - view in '..\..\source\view.pas' {frmView}, - selectdbobject in '..\..\source\selectdbobject.pas' {frmSelectDBObject}, - texteditor in '..\..\source\texteditor.pas' {frmTextEditor}, - bineditor in '..\..\source\bineditor.pas' {frmBinEditor}, - grideditlinks in '..\..\source\grideditlinks.pas', - routine_editor in '..\..\source\routine_editor.pas' {frmRoutineEditor}, - table_editor in '..\..\source\table_editor.pas' {frmTableEditor}, - dbconnection in '..\..\source\dbconnection.pas', - trigger_editor in '..\..\source\trigger_editor.pas' {frmTriggerEditor: TFrame}, - searchreplace in '..\..\source\searchreplace.pas' {frmSearchReplace}, - event_editor in '..\..\source\event_editor.pas' {frmEventEditor: TFrame}, - loginform in '..\..\source\loginform.pas' {frmLogin}, - Cromis.DirectoryWatch in '..\..\source\Cromis.DirectoryWatch.pas', - exportgrid in '..\..\source\exportgrid.pas' {frmExportGrid}, - syncdb in '..\..\source\syncdb.pas' {frmSyncDB}, - gnugettext in '..\..\source\gnugettext.pas', - JumpList in '..\..\source\JumpList.pas', - extra_controls in '..\..\source\extra_controls.pas', - change_password in '..\..\source\change_password.pas' {frmPasswordChange}, - Vcl.Themes, - Vcl.Styles, - Vcl.Graphics, - theme_preview in '..\..\source\theme_preview.pas' {frmThemePreview}, - csv_detector in '..\..\source\csv_detector.pas' {frmCsvDetector}, - generic_types in '..\..\source\generic_types.pas', - customize_highlighter in '..\..\source\customize_highlighter.pas' {frmCustomizeHighlighter}, - Xml.VerySimple in '..\..\source\Xml.VerySimple.pas'; - -{.$R *.RES} -{$R ..\..\res\icon.RES} -{$R ..\..\res\icon-question.RES} -{$R ..\..\res\version.RES} -{$R ..\..\res\manifest.RES} -{$R ..\..\res\updater.RES} -{$R ..\..\res\styles.RES} - -var - AppLanguage: String; - WantedStyle: String; -begin - PostponedLogItems := TDBLogItems.Create(True); - //Application.MainFormOnTaskBar := True; - - // Use MySQL standard format for date/time variables: YYYY-MM-DD HH:MM:SS - // Be aware that Delphi internally converts the slashes in ShortDateFormat to the DateSeparator - FormatSettings.DateSeparator := '-'; - FormatSettings.TimeSeparator := ':'; - FormatSettings.ShortDateFormat := 'yyyy/mm/dd'; - FormatSettings.LongTimeFormat := 'hh:nn:ss'; - - AppSettings := TAppSettings.Create; - SecondInstMsgId := RegisterWindowMessage(APPNAME); - if (not AppSettings.ReadBool(asAllowMultipleInstances)) and CheckForSecondInstance then begin - AppSettings.Free; - Application.Terminate; - end else begin - - AppLanguage := AppSettings.ReadString(asAppLanguage); - // SysLanguage may be zh_CN, while we don't offer such a language, but anyway, this is just the current system language: - SysLanguage := gnugettext.DefaultInstance.GetCurrentLocaleName; - gnugettext.UseLanguage(AppLanguage); - // First time translation via dxgettext. - // Issue #3064: Ignore TFont, so "Default" on mainform for WinXP users does not get broken. - gnugettext.TP_GlobalIgnoreClass(TFont); - - Application.Initialize; - Application.Title := APPNAME; - Application.UpdateFormatSettings := False; - - // Try to set style name. If that fails, the user gets an error message box - reset it to default when that happened - WantedStyle := AppSettings.ReadString(asTheme); - TStyleManager.TrySetStyle(WantedStyle); - if TStyleManager.ActiveStyle.Name <> WantedStyle then begin - AppSettings.WriteString(asTheme, TStyleManager.ActiveStyle.Name); - end; - - Application.CreateForm(TMainForm, MainForm); - MainForm.AfterFormCreate; - Application.OnDeactivate := MainForm.ApplicationDeActivate; - Application.OnShowHint := MainForm.ApplicationShowHint; - Application.MainFormOnTaskBar := True; - Application.Run; - end; - end. diff --git a/packages/Delphi11.1/heidisql.dproj b/packages/Delphi11.1/heidisql.dproj deleted file mode 100644 index 4e767783..00000000 --- a/packages/Delphi11.1/heidisql.dproj +++ /dev/null @@ -1,1192 +0,0 @@ - - - {32493ED6-4F48-45D7-9D50-E4FA13F59063} - heidisql.dpr - True - Release - 3 - Application - VCL - 19.4 - Win64 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - false - false - ..\..\out\ - ..\..\build\$(Platform) - ..\..\components\synedit\build\$(Platform);..\..\components\virtualtreeview\build\$(Platform);..\..\components\synedit\source;..\..\components\virtualtreeview\source;..\..\source\detours\Source;..\..\source\vcl-styles-utils;..\..\source\sizegrip;$(DCC_UnitSearchPath) - $(BDS)\bin\default_app.manifest - false - false - Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;FMX.Canvas.GPU;System.Win;Data.Win;$(DCC_Namespace) - false - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=;CFBundleDisplayName=;UIDeviceFamily=;CFBundleIdentifier=;CFBundleVersion=;CFBundlePackageType=;CFBundleSignature=;CFBundleAllowMixedLocalizations=;UISupportedInterfaceOrientations=;CFBundleExecutable=;CFBundleResourceSpecification=;LSRequiresIPhoneOS=;CFBundleInfoDictionaryVersion=;CFBundleDevelopmentRegion=;package=;label=;versionCode=;versionName=;persistent=;restoreAnyVersion=;installLocation=;largeHeap=;theme= - false - true - false - 1033 - heidisql - Windows10|VCLSTYLE|$(BDSCOMMONDIR)\Styles\Windows10.vsf - - - Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - true - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - RELEASE;$(DCC_Define) - false - 0 - 0 - - - true - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - false - - - true - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - madExcept;$(DCC_Define) - - - true - DEBUG;$(DCC_Define) - false - - - true - Cfg_2 - true - true - Debug - - - None - 2 - 3 - madExcept;$(DCC_Define) - true - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - Debug - - - 2 - true - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - 3 - true - Debug - PerMonitorV2 - madExcept;$(DCC_Define) - - - - MainSource - - -
MainForm
- - -
AboutBox
- - -
connform
- - -
loaddataform
- - -
UserManagerForm
- - -
frmPreferences
- - -
frmTableTools
- - -
printlistForm
- - -
CopyTableForm
- - -
frmInsertFiles
- - - -
frmSQLhelp
- - - - - - - - -
frmColumnSelection
- - -
frmDataSorting
- - -
CreateDatabaseForm
- - -
frmUpdateCheck
- - -
frmEditVariable
- - -
frmView
- - -
frmSelectDBObject
- - -
frmTextEditor
- - -
frmBinEditor
- - - -
frmRoutineEditor
- - -
frmTableEditor
- - - -
frmTriggerEditor
- TFrame - - -
frmSearchReplace
- - -
frmEventEditor
- TFrame - - -
frmLogin
- - - -
frmExportGrid
- - -
frmSyncDB
- - - - - -
frmPasswordChange
- - -
frmThemePreview
- - -
frmCsvDetector
- - - -
frmCustomizeHighlighter
- dfm - - - - - Base - - - Cfg_1 - Base - - - Cfg_2 - Base - - - - Delphi.Personality.12 - - - - - heidisql.dpr - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1033 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver - Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server - - - - False - True - True - - False - - - - true - - - - - heidisql.exe - true - - - - - .\ - true - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - classes - 64 - - - classes - 64 - - - - - classes - 1 - - - classes - 1 - - - - - res\xml - 1 - - - res\xml - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - library\lib\armeabi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\mips - 1 - - - library\lib\mips - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\values-v21 - 1 - - - res\values-v21 - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-small - 1 - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - res\drawable-xlarge - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).launchscreen - 64 - - - ..\$(PROJECTNAME).launchscreen - 64 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - ..\ - 1 - - - - - Contents - 1 - - - Contents - 1 - - - Contents - 1 - - - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - - - - - - 12 - - - - - diff --git a/packages/Delphi11.1/heidisql.groupproj b/packages/Delphi11.1/heidisql.groupproj deleted file mode 100644 index a5158639..00000000 --- a/packages/Delphi11.1/heidisql.groupproj +++ /dev/null @@ -1,96 +0,0 @@ - - - {C4296A31-CCFB-4D2F-8BEC-26CD630E9987} - - - - - - - - - - - - - - - - - - - - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/packages/Delphi11.1/heidisql.mes b/packages/Delphi11.1/heidisql.mes deleted file mode 100644 index 52176f0d..00000000 --- a/packages/Delphi11.1/heidisql.mes +++ /dev/null @@ -1,164 +0,0 @@ -[GeneralSettings] -HandleExceptions=1 -AppendMapFileToBinary=1 -NoOwnMadExceptSettings=0 -CheckFileCrc=1 -CheckForFrozenMainThread=0 -FreezeTimeout=60000 -AutomaticallySaveBugReport=0 -AutoSaveBugReportIfNotSent=0 -AutomaticallyMailBugReport=0 -AutoMailProgressBox=0 -CopyBugReportToClipboard=0 -SuspendAllRunningThreads=0 -ShowPleaseWaitBox=1 -PleaseWaitIcon=plwait1 -AutomaticallyContinueApplication=1 -AutomaticallyRestartApplication=0 -AutomaticallyCloseApplication=0 -MailAddress= -SendInBackground=0 -Send32Icon=send321 -MailAsSmtpServer=0 -MailAsSmtpClient=0 -UploadViaHttp=1 -MailViaMapi=0 -MailViaMailto=0 -SmtpServer= -SmtpPort=0 -SmtpAccount= -SmtpPassword= -HttpServer=www.heidisql.com/bugreport.php -HttpPort=443 -HttpAccount= -HttpPassword= -BugReportFile=bugreport.txt -AttachBugReport=1 -AttachBugReportFile=1 -DeleteBugReportFile=1 -BugReportSendAs=bugreport.txt -BugReportZip= -ScreenShotDepth=0 -ScreenShotAppOnly=1 -ScreenShotSendAs=screenshot.png -ScreenShotZip= -AdditionalAttachments= -AppendBugReports=0 -BugReportFileSize=100000 -DontSaveDuplicateExceptions=1 -DontSaveDuplicateFreezings=1 -DuplicateExceptionDefinition=1 -DuplicateFreezeDefinition=2 -ShowExceptionBox=1 -OkBtnText=&OK -DetailsBtnText=&Details -PleaseWaitTitle=Information -PleaseWaitText=Please wait a moment... -MailSubject=bug report -MailBody=please find the bug report attached -SendBoxTitle=Sending bug report... -PrepareAttachMsg=Preparing attachments... -MxLookupMsg=Searching for mail server... -ConnectMsg=Connecting to server... -AuthMsg=Authentication... -SendMailMsg=Sending mail... -FieldsMsg=Setting fields... -SendAttachMsg=Sending attachments... -SendFinalizeMsg=Finalizing... -MailFailureMsg=Sorry, sending the bug report didn't work. -VersionVariable= -MesVersion=4 -LinkInCode=1 -ReportLeaks=0 -WindowsLogo=0 -CrashOnBuffer=0 -CrashOnUnderrun=0 -SendHelper=196608 -HttpSsl=1 -UploadToFogBugz=0 -UploadToBugZilla=0 -UploadToMantis=0 -BugTrackerAccount= -BugTrackerPassword= -BugTrackerProject= -BugTrackerArea= -BugTrackerAssignTo= -SmtpSsl=0 -SmtpTls=0 -BugTrackerTitle=%25appname%25, %25exceptMsg%25 -BugTrackerDescr=error details: %0d%0a%25errorDetails%25 -[ExceptionBox] -ShowButtonMailBugReport=1 -ShowButtonSaveBugReport=1 -ShowButtonPrintBugReport=0 -ShowButtonShowBugReport=1 -ShowButtonContinueApplication=1 -ShowButtonRestartApplication=1 -ShowButtonCloseApplication=1 -IconButtonSendBugReport=send1 -IconButtonSaveBugReport=save1 -IconButtonPrintBugReport=print1 -IconButtonShowBugReport=show1 -IconButtonContinueApplication=continue1 -IconButtonCantContinueApplication=cantContinue1 -IconButtonRestartApplication=restart1 -IconButtonCloseApplication=close1 -FocusedButton=0 -SendAssistant=SendAssistant -SaveAssistant= -PrintAssistant=PrintAssistant -AutomaticallyShowBugReport=0 -NoOwnerDrawButtons=0 -BigExceptionIcon=big1 -TitleBar=%25appname%25 -ExceptionMessage=An error occurred in the application. -FrozenMessage=The application seems to be frozen. -BitFaultMsg=The file "%25modname%25" seems to be corrupt! -MailBugReportText=send bug report -SaveBugReportText=save bug report -PrintBugReportText=print bug report -ShowBugReportText=show bug report -ContinueApplicationText=continue application -RestartApplicationText=restart application -CloseApplicationText=close application -[BugReport] -ListThreads=0 -ListModules=0 -ListHardware=0 -ShowCpuRegisters=0 -ShowStackDump=0 -Disassembly=0 -HideUglyItems=0 -ShowRelativeAddrs=0 -ShowRelativeLines=1 -FormatDisassembly=0 -LimitDisassembly=5 -EnabledPlugins= -[Filters] -Filter1ExceptionClasses=EDBEditError -Filter1DontCreateBugReport=1 -Filter1DontCreateScreenshot=1 -Filter1DontSuspendThreads=1 -Filter1DontCallHandlers=1 -Filter1ShowBox=3 -Filter1Assis= -Filter2ExceptionClasses= -Filter2DontCreateBugReport=0 -Filter2DontCreateScreenshot=0 -Filter2DontSuspendThreads=0 -Filter2DontCallHandlers=0 -Filter2ShowBox=0 -Filter2Assis= -GeneralDontCreateBugReport=0 -GeneralDontCreateScreenshot=0 -GeneralDontSuspendThreads=0 -GeneralDontCallHandlers=0 -GeneralShowBox=0 -GeneralAssis= -[Assistants] -Assistant1=SendAssistant|Send Assistant|ContactForm|DetailsForm|ScrShotForm -Assistant2=SaveAssistant|Save Assistant|ContactForm|DetailsForm -Assistant3=PrintAssistant|Print Assistant|ContactForm|DetailsForm -Forms1=TPF0%0eTMEContactForm%0bContactForm%07Message%0c%13%00%00%00Contact Information%08MinWidth%04%00%00%00%00%08OnAction%0c%1b%00%00%00madExcept.HandleContactForm%05Timer%04%00%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%08%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%08INVLabel%06Label1%07Caption%0c%0a%00%00%00your name:%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%08NameEdit%07Colored%09%07Enabled%09%05Lines%04%01%00%00%00%08Optional%09%0aOutputName%0c%0c%00%00%00contact name%0aOutputType%07%09nvoHeader%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%08INVLabel%06Label2%07Caption%0c%0b%00%00%00your email:%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%09EmailEdit%07Colored%09%07Enabled%09%05Lines%04%01%00%00%00%08Optional%08%0aOutputName%0c%0d%00%00%00contact email%0aOutputType%07%09nvoHeader%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%0bINVCheckBox%08MemCheck%07Caption%0c%0b%00%00%00remember me%07Checked%08%07Enabled%09%0aOutputName%0c%00%00%00%00%07Spacing%04%00%00%00%00%00%00%00 -Forms2=TPF0%0eTMEDetailsForm%0bDetailsForm%07Message%0c%0d%00%00%00Error Details%08MinWidth%04%00%00%00%00%08OnAction%0c%00%00%00%00%05Timer%04%00%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%08INVLabel%06Label1%07Caption%0c'%00%00%00in which situation did the error occur?%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%0bDetailsMemo%07Colored%09%07Enabled%09%05Lines%04%09%00%00%00%08Optional%08%0aOutputName%0c%0d%00%00%00error details%0aOutputType%07%0dnvoOwnSection%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%00 -Forms3=TPF0%0eTMEScrShotForm%0bScrShotForm%0dActiveControl%07%0bContinueBtn%07Message%0c%18%00%00%00Screenshot Configuration%08MinWidth%04%00%00%00%00%08OnAction%0c%1e%00%00%00madExcept.HandleScreenshotForm%05Timer%04%fa%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%08%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%0bINVCheckBox%0bAttachCheck%07Caption%0c%25%00%00%00attach a screenshot to the bug report%07Checked%09%07Enabled%09%0aOutputName%0c%00%00%00%00%07Spacing%04%00%00%00%00%00%00%08INVImage%0aScrShotImg%06Border%09%09Clickable%09%07Enabled%09%04File%0c%00%00%00%00%06Height%04%00%00%00%00%07Spacing%04%00%00%00%00%05Width%04%00%00%00%00%00%00%08INVLabel%06Label1%07Caption%0c%15%00%00%00(click to edit image)%07Enabled%09%07Spacing%04%00%00%00%00%00%00%00 diff --git a/packages/Delphi11.2/heidisql.dpr b/packages/Delphi11.2/heidisql.dpr deleted file mode 100644 index 418f5132..00000000 --- a/packages/Delphi11.2/heidisql.dpr +++ /dev/null @@ -1,117 +0,0 @@ -program heidisql; - -uses - madExcept, - Vcl.Forms, - System.SysUtils, - Vcl.Dialogs, - Vcl.Controls, - Winapi.Windows, - main in '..\..\source\main.pas' {MainForm}, - about in '..\..\source\about.pas' {AboutBox}, - connections in '..\..\source\connections.pas' {connform}, - loaddata in '..\..\source\loaddata.pas' {loaddataform}, - usermanager in '..\..\source\usermanager.pas' {UserManagerForm}, - preferences in '..\..\source\preferences.pas' {frmPreferences}, - tabletools in '..\..\source\tabletools.pas' {frmTableTools}, - printlist in '..\..\source\printlist.pas' {printlistForm}, - copytable in '..\..\source\copytable.pas' {CopyTableForm}, - insertfiles in '..\..\source\insertfiles.pas' {frmInsertFiles}, - apphelpers in '..\..\source\apphelpers.pas', - sqlhelp in '..\..\source\sqlhelp.pas' {frmSQLhelp}, - dbstructures in '..\..\source\dbstructures.pas', - dbstructures.mysql in '..\..\source\dbstructures.mysql.pas', - dbstructures.mssql in '..\..\source\dbstructures.mssql.pas', - dbstructures.postgresql in '..\..\source\dbstructures.postgresql.pas', - dbstructures.sqlite in '..\..\source\dbstructures.sqlite.pas', - dbstructures.interbase in '..\..\source\dbstructures.interbase.pas', - column_selection in '..\..\source\column_selection.pas' {frmColumnSelection}, - data_sorting in '..\..\source\data_sorting.pas' {frmDataSorting}, - createdatabase in '..\..\source\createdatabase.pas' {CreateDatabaseForm}, - updatecheck in '..\..\source\updatecheck.pas' {frmUpdateCheck}, - editvar in '..\..\source\editvar.pas' {frmEditVariable}, - view in '..\..\source\view.pas' {frmView}, - selectdbobject in '..\..\source\selectdbobject.pas' {frmSelectDBObject}, - texteditor in '..\..\source\texteditor.pas' {frmTextEditor}, - bineditor in '..\..\source\bineditor.pas' {frmBinEditor}, - grideditlinks in '..\..\source\grideditlinks.pas', - routine_editor in '..\..\source\routine_editor.pas' {frmRoutineEditor}, - table_editor in '..\..\source\table_editor.pas' {frmTableEditor}, - dbconnection in '..\..\source\dbconnection.pas', - trigger_editor in '..\..\source\trigger_editor.pas' {frmTriggerEditor: TFrame}, - searchreplace in '..\..\source\searchreplace.pas' {frmSearchReplace}, - event_editor in '..\..\source\event_editor.pas' {frmEventEditor: TFrame}, - loginform in '..\..\source\loginform.pas' {frmLogin}, - Cromis.DirectoryWatch in '..\..\source\Cromis.DirectoryWatch.pas', - exportgrid in '..\..\source\exportgrid.pas' {frmExportGrid}, - syncdb in '..\..\source\syncdb.pas' {frmSyncDB}, - gnugettext in '..\..\source\gnugettext.pas', - JumpList in '..\..\source\JumpList.pas', - extra_controls in '..\..\source\extra_controls.pas', - change_password in '..\..\source\change_password.pas' {frmPasswordChange}, - Vcl.Themes, - Vcl.Styles, - Vcl.Graphics, - theme_preview in '..\..\source\theme_preview.pas' {frmThemePreview}, - csv_detector in '..\..\source\csv_detector.pas' {frmCsvDetector}, - generic_types in '..\..\source\generic_types.pas', - customize_highlighter in '..\..\source\customize_highlighter.pas' {frmCustomizeHighlighter}, - Xml.VerySimple in '..\..\source\Xml.VerySimple.pas', - Sequal.Suggest in '..\..\source\Sequal.Suggest.pas' {SequalSuggestForm}, - reformatter in '..\..\source\reformatter.pas' {frmReformatter}; - -{.$R *.RES} -{$R ..\..\res\icon.RES} -{$R ..\..\res\icon-question.RES} -{$R ..\..\res\version.RES} -{$R ..\..\res\manifest.RES} -{$IFDEF CPUX64}{$R ..\..\res\updater.RES}{$ENDIF} -{$R ..\..\res\styles.RES} - -var - AppLanguage: String; - WantedStyle: String; -begin - PostponedLogItems := TDBLogItems.Create(True); - //Application.MainFormOnTaskBar := True; - - // Use MySQL standard format for date/time variables: YYYY-MM-DD HH:MM:SS - // Be aware that Delphi internally converts the slashes in ShortDateFormat to the DateSeparator - FormatSettings.DateSeparator := '-'; - FormatSettings.TimeSeparator := ':'; - FormatSettings.ShortDateFormat := 'yyyy/mm/dd'; - FormatSettings.LongTimeFormat := 'hh:nn:ss'; - - AppSettings := TAppSettings.Create; - SecondInstMsgId := RegisterWindowMessage(APPNAME); - if (not AppSettings.ReadBool(asAllowMultipleInstances)) and CheckForSecondInstance then begin - AppSettings.Free; - Application.Terminate; - end else begin - - AppLanguage := AppSettings.ReadString(asAppLanguage); - // SysLanguage may be zh_CN, while we don't offer such a language, but anyway, this is just the current system language: - SysLanguage := gnugettext.DefaultInstance.GetCurrentLocaleName; - gnugettext.UseLanguage(AppLanguage); - // First time translation via dxgettext. - // Issue #3064: Ignore TFont, so "Default" on mainform for WinXP users does not get broken. - gnugettext.TP_GlobalIgnoreClass(TFont); - - Application.Initialize; - Application.Title := APPNAME; - Application.UpdateFormatSettings := False; - - // Try to set style name. If that fails, the user gets an error message box - reset it to default when that happened - WantedStyle := AppSettings.ReadString(asTheme); - TStyleManager.TrySetStyle(WantedStyle); - if TStyleManager.ActiveStyle.Name <> WantedStyle then begin - AppSettings.WriteString(asTheme, TStyleManager.ActiveStyle.Name); - end; - Application.CreateForm(TMainForm, MainForm); - MainForm.AfterFormCreate; - Application.OnDeactivate := MainForm.ApplicationDeActivate; - Application.OnShowHint := MainForm.ApplicationShowHint; - Application.MainFormOnTaskBar := True; - Application.Run; - end; - end. diff --git a/packages/Delphi11.2/heidisql.dproj b/packages/Delphi11.2/heidisql.dproj deleted file mode 100644 index 92b5e3c2..00000000 --- a/packages/Delphi11.2/heidisql.dproj +++ /dev/null @@ -1,1184 +0,0 @@ - - - {32493ED6-4F48-45D7-9D50-E4FA13F59063} - heidisql.dpr - True - Debug - 3 - Application - VCL - 19.5 - Win64 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - false - false - ..\..\out\ - ..\..\build\$(Platform) - ..\..\components\synedit\build\$(Platform);..\..\components\virtualtreeview\build\$(Platform);..\..\components\synedit\source;..\..\components\virtualtreeview\source;..\..\source\detours\Source;..\..\source\vcl-styles-utils;..\..\source\sizegrip;$(DCC_UnitSearchPath) - $(BDS)\bin\default_app.manifest - false - false - false - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=;CFBundleDisplayName=;UIDeviceFamily=;CFBundleIdentifier=;CFBundleVersion=;CFBundlePackageType=;CFBundleSignature=;CFBundleAllowMixedLocalizations=;UISupportedInterfaceOrientations=;CFBundleExecutable=;CFBundleResourceSpecification=;LSRequiresIPhoneOS=;CFBundleInfoDictionaryVersion=;CFBundleDevelopmentRegion=;package=;label=;versionCode=;versionName=;persistent=;restoreAnyVersion=;installLocation=;largeHeap=;theme= - false - true - false - 1033 - heidisql - Vcl;System;Winapi;System.Win;Data;$(DCC_Namespace) - false - false - false - - - true - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - RELEASE;$(DCC_Define) - false - 0 - 0 - - - true - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - false - Debug - madExcept;$(DCC_Define) - 3 - 2 - true - - - true - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - Debug - 2 - true - madExcept;$(DCC_Define) - 3 - - - true - DEBUG;$(DCC_Define) - false - - - None - 2 - 3 - madExcept;$(DCC_Define) - true - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - Debug - - - 2 - true - CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - 3 - Debug - PerMonitorV2 - madExcept;$(DCC_Define) - - - - MainSource - - -
MainForm
- - -
AboutBox
- - -
connform
- - -
loaddataform
- - -
UserManagerForm
- - -
frmPreferences
- - -
frmTableTools
- - -
printlistForm
- - -
CopyTableForm
- - -
frmInsertFiles
- - - -
frmSQLhelp
- - - - - - - - -
frmColumnSelection
- - -
frmDataSorting
- - -
CreateDatabaseForm
- - -
frmUpdateCheck
- - -
frmEditVariable
- - -
frmView
- - -
frmSelectDBObject
- - -
frmTextEditor
- - -
frmBinEditor
- - - -
frmRoutineEditor
- - -
frmTableEditor
- - - -
frmTriggerEditor
- TFrame - - -
frmSearchReplace
- - -
frmEventEditor
- TFrame - - -
frmLogin
- - - -
frmExportGrid
- - -
frmSyncDB
- - - - - -
frmPasswordChange
- - -
frmThemePreview
- - -
frmCsvDetector
- - - -
frmCustomizeHighlighter
- - - -
SequalSuggestForm
- dfm - - -
frmReformatter
- dfm - - - - Base - - - Cfg_1 - Base - - - Cfg_2 - Base - - - - Delphi.Personality.12 - - - - - heidisql.dpr - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1033 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - - - - True - True - - False - - - - - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - classes - 64 - - - classes - 64 - - - - - res\xml - 1 - - - res\xml - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - library\lib\armeabi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\mips - 1 - - - library\lib\mips - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\values-v21 - 1 - - - res\values-v21 - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-small - 1 - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - res\drawable-xlarge - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset - 1 - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - ..\ - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).launchscreen - 64 - - - ..\$(PROJECTNAME).launchscreen - 64 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - ..\ - 1 - - - - - Contents - 1 - - - Contents - 1 - - - Contents - 1 - - - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - - - - - - - 12 - - - - - diff --git a/packages/Delphi11.2/heidisql.groupproj b/packages/Delphi11.2/heidisql.groupproj deleted file mode 100644 index 8541c5f9..00000000 --- a/packages/Delphi11.2/heidisql.groupproj +++ /dev/null @@ -1,96 +0,0 @@ - - - {C4296A31-CCFB-4D2F-8BEC-26CD630E9987} - - - - - - - - - - - - - - - - - - - - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/packages/Delphi11.2/heidisql.mes b/packages/Delphi11.2/heidisql.mes deleted file mode 100644 index cf4d3b4f..00000000 --- a/packages/Delphi11.2/heidisql.mes +++ /dev/null @@ -1,164 +0,0 @@ -[GeneralSettings] -HandleExceptions=1 -AppendMapFileToBinary=1 -NoOwnMadExceptSettings=0 -CheckFileCrc=1 -CheckForFrozenMainThread=0 -FreezeTimeout=60000 -AutomaticallySaveBugReport=0 -AutoSaveBugReportIfNotSent=0 -AutomaticallyMailBugReport=0 -AutoMailProgressBox=0 -CopyBugReportToClipboard=0 -SuspendAllRunningThreads=0 -ShowPleaseWaitBox=1 -PleaseWaitIcon=plwait1 -AutomaticallyContinueApplication=1 -AutomaticallyRestartApplication=0 -AutomaticallyCloseApplication=0 -MailAddress= -SendInBackground=0 -Send32Icon=send321 -MailAsSmtpServer=0 -MailAsSmtpClient=0 -UploadViaHttp=1 -MailViaMapi=0 -MailViaMailto=0 -SmtpServer= -SmtpPort=0 -SmtpAccount= -SmtpPassword= -HttpServer=www.heidisql.com/bugreport.php -HttpPort=0 -HttpAccount= -HttpPassword= -BugReportFile=bugreport.txt -AttachBugReport=1 -AttachBugReportFile=1 -DeleteBugReportFile=1 -BugReportSendAs=bugreport.txt -BugReportZip= -ScreenShotDepth=0 -ScreenShotAppOnly=1 -ScreenShotSendAs=screenshot.png -ScreenShotZip= -AdditionalAttachments= -AppendBugReports=0 -BugReportFileSize=100000 -DontSaveDuplicateExceptions=1 -DontSaveDuplicateFreezings=1 -DuplicateExceptionDefinition=1 -DuplicateFreezeDefinition=2 -ShowExceptionBox=1 -OkBtnText=&OK -DetailsBtnText=&Details -PleaseWaitTitle=Information -PleaseWaitText=Please wait a moment... -MailSubject=bug report -MailBody=please find the bug report attached -SendBoxTitle=Sending bug report... -PrepareAttachMsg=Preparing attachments... -MxLookupMsg=Searching for mail server... -ConnectMsg=Connecting to server... -AuthMsg=Authentication... -SendMailMsg=Sending mail... -FieldsMsg=Setting fields... -SendAttachMsg=Sending attachments... -SendFinalizeMsg=Finalizing... -MailFailureMsg=Sorry, sending the bug report didn't work. -VersionVariable= -MesVersion=4 -LinkInCode=1 -ReportLeaks=0 -WindowsLogo=0 -CrashOnBuffer=0 -CrashOnUnderrun=0 -SendHelper=196608 -HttpSsl=1 -UploadToFogBugz=0 -UploadToBugZilla=0 -UploadToMantis=0 -BugTrackerAccount= -BugTrackerPassword= -BugTrackerProject= -BugTrackerArea= -BugTrackerAssignTo= -SmtpSsl=0 -SmtpTls=0 -BugTrackerTitle=%25appname%25, %25exceptMsg%25 -BugTrackerDescr=error details: %0d%0a%25errorDetails%25 -[ExceptionBox] -ShowButtonMailBugReport=1 -ShowButtonSaveBugReport=1 -ShowButtonPrintBugReport=0 -ShowButtonShowBugReport=1 -ShowButtonContinueApplication=1 -ShowButtonRestartApplication=1 -ShowButtonCloseApplication=1 -IconButtonSendBugReport=send1 -IconButtonSaveBugReport=save1 -IconButtonPrintBugReport=print1 -IconButtonShowBugReport=show1 -IconButtonContinueApplication=continue1 -IconButtonCantContinueApplication=cantContinue1 -IconButtonRestartApplication=restart1 -IconButtonCloseApplication=close1 -FocusedButton=0 -SendAssistant=SendAssistant -SaveAssistant= -PrintAssistant=PrintAssistant -AutomaticallyShowBugReport=0 -NoOwnerDrawButtons=0 -BigExceptionIcon=big1 -TitleBar=%25appname%25 -ExceptionMessage=An error occurred in the application. -FrozenMessage=The application seems to be frozen. -BitFaultMsg=The file "%25modname%25" seems to be corrupt! -MailBugReportText=send bug report -SaveBugReportText=save bug report -PrintBugReportText=print bug report -ShowBugReportText=show bug report -ContinueApplicationText=continue application -RestartApplicationText=restart application -CloseApplicationText=close application -[BugReport] -ListThreads=0 -ListModules=0 -ListHardware=0 -ShowCpuRegisters=0 -ShowStackDump=0 -Disassembly=0 -HideUglyItems=0 -ShowRelativeAddrs=0 -ShowRelativeLines=1 -FormatDisassembly=0 -LimitDisassembly=5 -EnabledPlugins= -[Filters] -Filter1ExceptionClasses=EDBEditError -Filter1DontCreateBugReport=1 -Filter1DontCreateScreenshot=1 -Filter1DontSuspendThreads=1 -Filter1DontCallHandlers=1 -Filter1ShowBox=3 -Filter1Assis= -Filter2ExceptionClasses= -Filter2DontCreateBugReport=0 -Filter2DontCreateScreenshot=0 -Filter2DontSuspendThreads=0 -Filter2DontCallHandlers=0 -Filter2ShowBox=0 -Filter2Assis= -GeneralDontCreateBugReport=0 -GeneralDontCreateScreenshot=0 -GeneralDontSuspendThreads=0 -GeneralDontCallHandlers=0 -GeneralShowBox=0 -GeneralAssis= -[Assistants] -Assistant1=SendAssistant|Send Assistant|ContactForm|DetailsForm|ScrShotForm -Assistant2=SaveAssistant|Save Assistant|ContactForm|DetailsForm -Assistant3=PrintAssistant|Print Assistant|ContactForm|DetailsForm -Forms1=TPF0%0eTMEContactForm%0bContactForm%07Message%0c%13%00%00%00Contact Information%08MinWidth%04%00%00%00%00%08OnAction%0c%1b%00%00%00madExcept.HandleContactForm%05Timer%04%00%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%08%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%08INVLabel%06Label1%07Caption%0c%0a%00%00%00your name:%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%08NameEdit%07Colored%09%07Enabled%09%05Lines%04%01%00%00%00%08Optional%09%0aOutputName%0c%0c%00%00%00contact name%0aOutputType%07%09nvoHeader%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%08INVLabel%06Label2%07Caption%0c%0b%00%00%00your email:%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%09EmailEdit%07Colored%09%07Enabled%09%05Lines%04%01%00%00%00%08Optional%08%0aOutputName%0c%0d%00%00%00contact email%0aOutputType%07%09nvoHeader%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%0bINVCheckBox%08MemCheck%07Caption%0c%0b%00%00%00remember me%07Checked%08%07Enabled%09%0aOutputName%0c%00%00%00%00%07Spacing%04%00%00%00%00%00%00%00 -Forms2=TPF0%0eTMEDetailsForm%0bDetailsForm%07Message%0c%0d%00%00%00Error Details%08MinWidth%04%00%00%00%00%08OnAction%0c%00%00%00%00%05Timer%04%00%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%08INVLabel%06Label1%07Caption%0c'%00%00%00in which situation did the error occur?%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%0bDetailsMemo%07Colored%09%07Enabled%09%05Lines%04%09%00%00%00%08Optional%08%0aOutputName%0c%0d%00%00%00error details%0aOutputType%07%0dnvoOwnSection%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%00 -Forms3=TPF0%0eTMEScrShotForm%0bScrShotForm%0dActiveControl%07%0bContinueBtn%07Message%0c%18%00%00%00Screenshot Configuration%08MinWidth%04%00%00%00%00%08OnAction%0c%1e%00%00%00madExcept.HandleScreenshotForm%05Timer%04%fa%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%08%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%0bINVCheckBox%0bAttachCheck%07Caption%0c%25%00%00%00attach a screenshot to the bug report%07Checked%09%07Enabled%09%0aOutputName%0c%00%00%00%00%07Spacing%04%00%00%00%00%00%00%08INVImage%0aScrShotImg%06Border%09%09Clickable%09%07Enabled%09%04File%0c%00%00%00%00%06Height%04%00%00%00%00%07Spacing%04%00%00%00%00%05Width%04%00%00%00%00%00%00%08INVLabel%06Label1%07Caption%0c%15%00%00%00(click to edit image)%07Enabled%09%07Spacing%04%00%00%00%00%00%00%00 diff --git a/packages/Delphi12.1/heidisql.groupproj b/packages/Delphi12.1/heidisql.groupproj index 8541c5f9..c86a77c8 100644 --- a/packages/Delphi12.1/heidisql.groupproj +++ b/packages/Delphi12.1/heidisql.groupproj @@ -3,10 +3,10 @@ {C4296A31-CCFB-4D2F-8BEC-26CD630E9987} - + - + @@ -30,22 +30,22 @@ - + - + - + - + - + - +