diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 000000000..1870c80ab --- /dev/null +++ b/.gitattributes @@ -0,0 +1,2 @@ +# Disable any line endings auto conversion. +* -text \ No newline at end of file diff --git a/.gitignore b/.gitignore index 10ae397ca..b1ef1e6cc 100644 --- a/.gitignore +++ b/.gitignore @@ -1,44 +1,58 @@ -# Compiled source # -################### -*.dcu -*.obj -*.exe -*.bpl -*.bpi -*.dcp -*.rsm -*.stat -*.map - -# Generated source # -################### -*.hpp - -# Backup files # -################### -*.~* - -# IDE Files # -################### -*.dproj.local -*.groupproj.local -*.identcache -*.dsk -*.tvsconfig -*.otares -*.drc -*.rc -*.res -*.local - -# Output Folders # -################### -/Win32 -/Win64 -/OSX32 -/__history -*.bak -*.Patch -VirtualTreeView.zip -*.#00 -*.pch +# Compiled source # +################### +*.dcu +*.obj +*.exe +*.bpl +*.bpi +*.dcp +*.rsm +*.stat +*.map +*.d +*.o + +# Generated source # +################### +*.hpp + +# Backup files # +################### +*.~* +__recovery + +# IDE Files # +################### +*.dproj.local +*.groupproj.local +*.identcache +*.dsk +*.tvsconfig +*.otares +*.drc +*.rc +*.res +*.local +*.dsv + +# Output Folders # +################### +/Win32 +/Win64 +/OSX32 +/__history +*.bak +*.Patch +VirtualTreeView.zip +*.#00 +*.pch +*.skincfg +*.a +Packages/RAD Studio XE3/VirtualTreesR.lib +*.lib + +# Folder with repro projects # +############################## +/#* +Tests/dunitx-results.xml +Tests/TestInsightSettings.ini diff --git a/CHANGES.txt b/CHANGES.txt deleted file mode 100644 index 84eb140cd..000000000 --- a/CHANGES.txt +++ /dev/null @@ -1,1811 +0,0 @@ -V7.2.1: (07 Mar 2019) -See: https://github.com/Virtual-TreeView/Virtual-TreeView/milestone/14?closed=1 - -V7.2: (18 Feb 2019) -See: https://github.com/Virtual-TreeView/Virtual-TreeView/milestone/12?closed=1 - -V7.1: (27 Dec 2018) -See: https://github.com/Virtual-TreeView/Virtual-TreeView/milestone/11?closed=1 - -V7.0: (22 Jul 2018) - * The support for Windows XP/2003 has been dropped (issue #707). This means: - - We did not intentionally break XP support. - - We do no longer test on Windows XP/2003 - - We may accept pull request for XP support if the code quality is sufficient. - - We recommend to use the V6 branch on Windows XP - * BREAKING CHANGE: Removed property TBaseVirtualTree.HintAnimation. Issue #730. - * BREAKING CHANGE: Renamed unit "VTHeaderPopup" to "VirtualTrees.HeaderPopup" - Renamed unit "VTAccessibility" to "VirtualTrees.Accessibility" - Renamed unit "VTAccessibilityFactory" to "VirtualTrees.AccessibilityFactory" - * Fixed issue #804: Remove MMXAvailable and related stuff - * Fixed issue #736: TVTDragManager.GetDataObject() should not use TVTDataObject in case the OnCreateDataObject event handler returned nil - * Fixed issue #756: OnMeasureItem called before data is assigned to node - * Fixed issue #745: Pressing SPACE should change the check-state of all selected nodes - * Fixed Issue #369: Centralize Left Content Margin calculation - * Pull Request #800: Fixed an incorrect calculation of the string edit link height. - * Pull request #796: Fixed a bug where hints of type hmTooltip had incorrect (random) position when when HitPosition was not hiOnItemLabel. - * Fixed issue #796: Utility images are not DPI Scaled - * Fixed issue #794: ScrollIntoView() by column centers column also when center is false - * Fixed issue #789: Issues with toHideSelection - * Fixed issue #792: "Invalid window handle" when using styles - * Fixed issue #788: Wrong logic in GetEffectiveColor. coStyleColor has been added to DefaultColumnOptions. - * Fixed issue #783: TVirtualTreeColumns.HandleClick() may trigger sorting twice - * Fixed issue #781: "~" not working on German keyboard - * Fixed issue #779: Overlay Images with Index < 15 not drawn when OnGetImageIndexEx is used - * Fixed issue #777: Margin is applied right of tree lines, but should be applied left of them. - * Pull request #776: ScrollIntoView centers horizontally enen without Columns defined - * Fixed issue #764: When toAlwaysSelectNode is on, no node is auto-selected after the tree is cleared. - * Fixed issue #769: GetImageSize Fails if kind ikState and not assigned(StateImages) - * Fixed issue #766: Incorrect HotTrack with Touch-Scrolling - * Pull request #761: Add TBaseVirtualTree.OnAddHeaderPopupItem event and 'Size Column to Fit' menu item to TVTHeaderPopupMenu. - * Fixed issue #760: TVirtualTreeColumns.GetFirstVisibleColumn() cause AV if called between BeginUpdate() and EndUpdate() - * Fixed issue #759: TBaseVirtualTree.InitNode() overrides check state of top level nodes set in OnInitNode event handler - * Fixed issue #757: Header popup menu opens twice - * Fixed issue #758: The OnColumnVisibilityChanged event is not always fired - * Fixed issue #754: TBaseVirtualTree.InternalAddToSelection() may cause access violation. Thx@nminkov for the patch. - * Fixed issue #753: TVirtualTreeColumns.EndUpdate() resets column order - * Fixed issue #752: HandleDrawSelection() does not correctly take horizontal scroll position into account - * Fixed issue #750: Plus/Minus sizes are not scaled in DPI aware applications - * Fixed issue #748: Per Monitor Dpi Scaling - Scrollbar Not Correct after Dpi Change - * Enhancement #735: Add event that is fired when a check state is needed. - * Fixed issue #743: Ugly drawing of selection in report mode when VCL Styles are used - * Fixed issue #742: TVTHeader.ParentFont should be True by default - * Fixed issue #740: TVTHeaderPopupMenu should not delete menu items added at designtime - * Fixed issue #739: TVTHeader should use a popup menu if assigned - * Fixed issue #738: Deadlock on application close in ReleaseThreadReference - * Fixed issue #737: Export problem when OnBeforeNodeExport is not assigned - * Fixed issue #723: Turn event OnAfterNodeExport into a procedure. This is a BREAKING CHNAGE. - * Fixed issue #734: DefaultText property ignored - * Fixed issue #724: Error when reading "old" streams - * Fixed issue #397: Horizontal autoscroll on focus does not properly scroll node into view if column width is larger than client width - * Fixed issue #727: Header not repainted after loading from stream - * Fixed issue #726: Incorrect header hot painting - * Fixed issue #722: Simplify custom header drawing while keeping default drawing - * Fixed issue #467: Multi level checkboxes and BeginUpdate/EndUpdate issue - * Fixed issue #391: Change property HotNode: Add a setter - * Fixed issue #767: Remove type TOldVTOption and ReadOldOptions() - * Removed flag toDisableAutoscrollOnFocus from default configuration of a new Virtual TreeView to achieve a more common behavior with default properties. - * poResizeToFitItem is now set by default in TVTHeaderPopupMenu.Options - -V6.7: (29 May 2017) - * Fixed issue #714: Integer overflow in TBaseVirtualTree's InternalAddFromStream - * Fixed issue #500: Issue with node selection "from code" for disabled nodes with toLevelSelectConstraint option - * Fixed issue #499: Incorrect behavior with toLevelSelectConstraint and ctrl+A - * Fixed issue #649: Cell navigation problems with toAutoSpanColumns for left and right keys - * Fixed issue #712: Strange behaviour of AutoFitColumns - * Fixed issue #718: Shift + Right-Click should not extend selection - * Fixed issue #706: Integer overflow in DetermineScrollDirections when timeGetTime wraps - * Fixed issue #407: TVirtualDrawTree.InvalidateNode does not clear vsHeightMeasured - * Enhancement #669: Create sample project for C++ Builder - * Enhancement #708: New option toSyncCheckboxesWithSelection improves multi-selection for touch UI that synchonizes selection and check-state - * Fixed issue #717: The option toUseExplorerTheme does not draw lines in place of buttons removed by toAutoHideButtons - * Fixed issue #716: Tab key navigation does not work properly with Auto Span Columns - * Fixed issue #720: A review of all Demos is needed to fix GetText, GetHint, etc to assign in DFM instead of assigning in FormCreate - -V6.6 (04 Apr 2017) - * Fixed issue #705: Added support for RAD Studio 10.2 Tokyo - * Fixed issue #702: Access Violation at designtime when RootNodeCount is >0 - * Fixed issue #703: Possibly wrong selection if nodes are selected during DeleteChildren() - * Fixed issue #700: If the user clicked a node, we are no longer centering this node if the option toCenterScrollIntoView is set. - * Fixed issue #691: When the user uses Cursor-Left/Right, the Virtual TreeView should perform horizontal scrolling if there is no other operation - * Fixed issue #699: TVTColors.GetColor: Honor user defined colors also when StyleServices are enabled (Thx to luebbe for PR) - * Fixed issue #698: Horizontal scrollbar may not update when turning on or off columns - * Fixed issue #350: TVirtualTreeColumn.fLeft should be in protected part - * Fixed issue #312: When unfocusing a node while the Spacebar is still pressed, the check state should be toggled - * Fixed issue #161: Shift+End does not work as expected with toGridExtension + toFullRowSelect options set - * Fixed issue #697: OnChange not fired when unselecting nodes - * Fixed issue #692: HitInfo for OnNodeClick event may differ much from HandleMouseDown - * Fixed issue #687 by extracting new method DeleteNodes() from existing DeleteSelectedNodes(). - * Fixed issue #689: Possible Integer overflow in PaintColumnHeader() when dragging a column to first position. - * Fixed issue #693: TVirtualTreeAccessibility.accSelect() should handle the flag SELFLAG_EXTENDSELECTION - * Fixed issue #690: Tree shouldn't keep selected elements, if toAlwaysSelectNode is set and other elements are selected without ctrl-modifier - * Improved non-breaking implementation of #622: The deprecated property CheckImageKind is no longer written to DFM files, - but read properly from old DFMs. Thx to the-Aroich for providing it. - * Some minor tweaks on Virtual TreeView source code and sample projects - -V6.5: (18 Jan 2017) - * License change from LGPL to "LGPL with static linking exception". See issue #673 for details. - * Enhancement #662: Background image now supports transparency - * Fixed #677: Improved per monitor dpi awareness. NodeHeight is now scaled as well if toAutoScale is set. - * Fixed #289: HintMode hmHintAndDefault: Default Hint does not change to node specific hint when the mouse is moved to a node. - * Fixed #674: HintMode hmHintAndDefault: If the BidiMode is right to left, the Default Hint fails to appear - * Fixed #139: hoDblClickResize doesn't work correctly with InitalState ivsMultiline - * Fixed #668: Removed unnecessary #include - * Fixed #670: Make it possible to override RangeX - * Fixed #676: VCL themed scrollbar does not update correctly after adding children - * Fixed #626: Wrong hot node selection during mouse movement over different nodes - * Fixed #679: The OnChange event when right clicking a node should always be fired before the OnPopup event - * Fixed #678: Occasional Access Violation in GetDisplayRect - * Fixed #682: Drag & Drop range exception - -V6.4.1: (26 Oct 2016) - * Fixed #549: Drawing issue with toCheckSupport an toExtendedFocus - * Fixed #663: Exception pressing return on an edited item with no columns) - * Fixed #661: Minimal Demo 2 different problems, can't select on start up, multiple clicks causes error - * Fixed problem with wrongly drawn checkbox in column headers. - * VirtualTreePerItemAction now initializes all nodes before it works with them and changes e.g. the check state. - * TBaseVirtualTree.DoGetImageIndex() now always tries to assign a default image list as result, even if OnGetImage and OnGetImageEx are not assigned. So derived controls do not need to make this step. - -V6.4: (28 Sep 2016) - * Fixed #622: [BREAKING CHANGE] Removed all 16x16 fixed sized checkbox-imagelists. - The property CheckImageKind supports the values ckSystemDefault and ckCustom only and should be considered deprecated. - * Fixed #640: Edit control for in-place editing wrongly scaled in high-dpi scenarios - * Fixed #627: It should be possible to use OnGetImageIndexEx without having imagelists assigned - * Added assertion that verifies if an imageindex is supplied but no valid imagelist is available for this imageindex - * Fixed #148: Background Images now support other formats than just bitmaps. - * Fixed #623: GetHint calculates wrong width for HintText - * Fixed #633: High dpi scaling was performed two times - * Fixed #544, #427: Header painting problem with BiDiMode right to left - * TBaseVirtualTree.EnsureNodeSelected() only scrolls the selected node into the view, if no one was previously selected. - * Fixed #248: VT Header draws smudged - * Fixed #643: VT Header dropmark appears even if dragged column won't change position - * Fixed #310: Incorrect selection paint when toAutoSpanColumns, toGridExtensions and toExtendedFocus are set - * Fixed #653: GetFirstVisibleChild/NoInit check for wrong node if IncludeFiltered=True (thx to A. Hausladen) - * Fixed #659: GetLastVisibleChild/NoInit checks wrong node - * Fixed #647: New option to set the way of selecting next cell for editing in grid mode - * Fixed #645: Can't link 64 bit VCL app with VirtualTreeView in C++ Builder 10.1 Berlin - * Fixed #656: Fixed memory leaks in Advanced Demo - * Enhancement #631: Added new Demo project CharityEvents to demonstrate the use of Interfaces for node's data and for data presentation - * Fixed #658: Column Header does not paint correctly after a drop in certain conditions - * Fixed #639: Scrolbars are not correctly themed under certain cirumstances when using a VCL theme. - * Fixed #624: Wrong y-postion of checkboxes in high-dpi display mode - * Fixed #548: Add flag coStyleColor to TVirtualTreeColumn.Options (prefer background color of VCL style over TVirtualTreeColumn.Color) - * Fixed #660: Fix AV when tree is modified in OnEdited event - * Some minor tweaks on Virtual TreeView source code and sample projects - -V6.3: (17 May 2016) - * Added support for RAD Studio 10.1 Berlin - * Implemented #607: Disabled checkbox images should be available - * Fixed #612: hotkey handing and toReverseFullExpandHotKey - * Fixed #602: Dangling WM_Timer and doubled OnChange calls - * Fixed #606: High DPI Inheritance of Form. TBaseVirtualTree.ChangeScale() now respects inherited property ScalingFlags - * Fixed #608: Horizontal lines paint bug on scroll. - * Fixed #605 : If a new node is selected by left click, OnChange event should not fire with `nil` in-between. - * TBaseVirtualTree.EnsureNodeSelected() no longer changes scroll position unless necessary to make the selected node visible. - * Pull request #609: Updated unit "Contributions/GenericWrapper/VirtualTreeWrapper.pas" - * Started adding unit tests with DUnitX. - * Minor tweaks. - -V6.2.3 (11 Feb 2016) - * Fixed accidental remove of vsReleaseCallOnUserDataRequired flag which can cause mem leaks. - * TVirtualNode.SetData() now sets the vsOnFreeNodeCallRequired flag for all types of user data and so is consisted with other SetData / GetData methods. - * TCustomVirtualStringTree.SetChildCount() now calls ResetInternalData()= with Recurse = False to avoid that all siblings of the new children are reseted recursively. See isuue #576 - * TCustomVirtualStringTree.ResetInternalData() now respects the Recursive parameter - -V6.2.2 (20 Jan 2016) - * Issue #603: If the node already has children, then its nodeheight is valid and we must not remove its total height, but rather its height - * Fixed issue #599: Possible infinite loop in GetPreviousVisibleNoInit() - * Added new method TBaseVirtualTree.InitRecursive() as workaround for issue #597: Initializes a node and optionally its children up to a certain level. - * Issue #598: SetData, like GetData no longer forces the "class" constraint on its generic parameter - * Fixed issue #596 by moving initialization of global variable Watcher also to InitializeGlobalStructures() - Now ensuring using interlocked function that InitializeGlobalStructures() is executed only once - * Fixed issue #458: If the Virtual TreeView control is placed on a control that has the StyleEx flag WS_EX_COMPOSITED set, horizontal scrolloing does not update the header - * Fixed issue #595: Before using SetTimer, check for valid WindowHandle - * Fixed issue #594: Basic TVirtualStringTree Colors does not apply - * Fixed issue #591: Now calling UnRegisterStyleHook() for the style class in "VirtualTrees.StyleHooks". - * Fixed #590: Allow to store InternalData also for (internal) root node - * if only one node is selected, make sure the focused node changes with the selected node - * Added assertion that ensures that BeginUpdate() is called from main thread only. - * Getter function GetCheckedCount() is protected now instead of public - -V6.2.1 (06 Nov 2015) - * #585: Checkboxes now have the correct size and scale properly on high dpi systems. - * #588: Fixed HTML clipboard export - * #586: TBaseVirtualTree.SetChildCount() no longer calls to ReInitNode(Node, True). This caused the OnInitChildren-Event to be fired twice. - * Adjusted GetNodeDataAt() and GetFirstSelectedNodeData() to work with interfaces. - * If multi selection is not allowed and so only one node can be selected, make sure the focused node changes with the selected node in SetSelected() - * Added packages for the C++Builder 10. - -V6.2 (09 Sep 2015) - * Issue #582: Added support and packages for RAD Studio 10 Seattle - * Issue #580: Added support for Delphi package manager Delphinus - * Fixed issue #571: Grid mode and extended selection leads to drawing inconsistencies - * Fixed issue #569 which includes a fix for AddChild(). - * Fixed issue #568: Integer overflow when reiniting nodes and using ivsFiltered - * Merged pull request #564 which includes a fix for ComputeNodeHeight() and single line nodes - * Merged pull request #563 which prevents an access violation when using custom check images in column headers - * Merged pull request #561 which makes VclStyleChanged() virtual - * Fixed issue #557: Using isFiltered in InitNode leads to integer overflows or bogus rendering - * Fixed issue #556: Variable height and more than 1 level results in incorrect RangeY - * Fixed issue #555: The OnChange event is not fired in case the selected node is deleted through DeleteChildren(). Although no the option toAlwaysSelectNode is set, the parent node was not selected afterwards. - * Fixed issue #553: painting failure with variable NodeHeight - * Fixed issue #551: Some overlay images were drawn ghosted like the main image, some not. - * TBaseVirtualTree.PrepareBitmaps() now fires the OnPrepareButtonImages event also in case VCL styles are used. - * Added implementation for TVirtualTreeAccessibility.accSelect() so that screen readers and especially UI testing tools can use MSAA to select specific elements in the control. - * Property OnColumnVisibilityChanged is now published. - * Now using type TImageIndex instead of integer for variables and parameters that store an image index. - -V6.1 (02 June 2015) - * Implemented Issue #530: Removed all AnsiString code from export routines. Breaking changes: - - TCustomVirtualStringTree.ContentToText() is now based on (Unicode)string and no longer on AnsiString. - - TCustomVirtualStringTree.ContentToUnicode() is now deprecated, use ContentToText() instead. - * Implemented issue #536: Add export event that is triggered for each cell - - Added new event OnGetCellText which has new TVSTGetCellTextEventArgs record as parameter. - This event could supersede the OnGetText event in a future version. - - All export formats now also export static text, in case the toShowStaticText flag is set - * Fixed issue #545: VCL Themes: Background of scrollbars is erased with wrong color - * Fixed issue #487: When OnAddToSelection is called, GetFirstSelected returns nil - * Fixed issue #542: AllocateInternalDataArea() was broken for derived classes - This was a result of issue #507. Now the user node data comes before the internal data. - Therefore it is important to use the function InternalData() to access the internal data of a node. - * Fixed issue #541: Duplicate call of EndEdit() - * Fixed issue #123: Triangle button is not shown for hot node - * Fixed issue #347: With VCL-Themes: No expand-pluses seen under Windows classic theme - * Fixed copy&paste error is source code related to issue #519 - -V6.0 (13 Apr 2015) - * Issue #509: Added new option hoAutoColumnPopupMenu to TVTHeaderOption. - * Issue #457: Virtual TreeView no longer react on standard actions for TEdit controls - We added standard actions for copy, cut, paste, delete, select all, check, uncheck in the new unit "VirtualTrees.Actions". - * Issue #484: ContentToHTML() no longer pre-encodes the HTML in UTF-8 but returns a Unicodestring - * Issue #507: Added to TBaseVirtualTree: - function GetNodeData(pNode: PVirtualNode): T; - function GetNodeDataAt(pXCoord: Integer; pYCoord: Integer): T; - function GetFirstSelectedNodeData(): T; overload; - function GetInterfaceFromNodeData(pNode: PVirtualNode): T; - procedure SetNodeData(pNode: PVirtualNode; pUserData: Pointer); - procedure SetNodeData(pNode: PVirtualNode; const pUserData: IInterface); - procedure SetNodeData(pNode: PVirtualNode; pUserData: T); - Similar functions have also been added to the TVirtualNode record. - * The grid demo of the "Advanced" project now uses a class instead of a record and the new generic functions from issue #502. - * Issue #519: Changed plus/minus buttons so that hot tracking of the buttons is always on, independent of toHotTrack. - * Issue #514: The splitter area in the column header should be configurable - * Issue #515: The value for Indent should get scaled too if the toAutoScale flag is set - * Issue #511: From the unit VirtualTres new units have been extracted to reduce its size. - * Issue #483 for TVTOperationKind.okExport: All exports can now be cancelled using CancelOperation() - * Issue #362: InternalConnectNode: AdjustTotalHeight not called if Node not FullyVisible - * Issue #506: Autosort is being triggered at design-time. - * Issue #486: AutoScroll is performed although toAutoScroll is not set. - * DoMeasureItem() now ensures that the node was initialized. - * Issue #493: Editing with DblClick should always open editor immediately. - * TVirtualTreeColumns.UpdatePositions() now exits immediately if the control is destroying, ths prevents AVs. - * Added support for CBuilder XE7. - * A larger patch from Diemtar Rösler was applied which addresses various issue regarding VCL styles (especially #478 and #491). - * Supporting only Delphi / C++ Builder XE3 and higher - * Improved support for C++ Builder - -V5.5.3: (08 Jan 2015) - * Fixed issue #495: Incorrect text vertical align when changing font in OnPaintText - * Fixed Issue #496: Access violation at VT destroy - * Fixed issue #498: Node totalheight not initialized properly when adding new node and using toVariableNodeHeight - -V5.5.2: (10 Nov 2014) - * Various improvements regarding code style - * Implemented #471: Add emVisibleDueToExpansion and emSelected to TVTExportMode - * Fixed issue #488: XE7 packages should depend on one another and use suffix 21 - * Fixed issue #462: Undo r636, make VirtualTreesD require VirtualTreesR again - * Fixed issue #489 XE2 compiler switch error - -V5.5.1: (13 Oct 2014) - * Fixed issue #479: The style hooks for the VCL styles are now registered for TVirtualStringTree and TVirtualDrawTree instead of TBaseVirtualTree, which makes it easier to use own style hooks in derived classes. - * Partial fix for issue #478: The standard VCL property StyleElemets (public in TControl in RAD Studio XE3 and higher) is now supported and published for TVirtualStringTree and TVirtualDrawTree (XE3 and higher). This means you can define if the font and the backgrounbd color is taken from the VCL style or the control's properties. Leaving out seBorder is not yet working well, more work will be necessary. - * Fixed issue #473: Return type of GetUtilityImages should be TCustomImageList - * Fix for issue #470: VCL Styles and sorting failure - * Added missing inherited to CMMouseEnter() - * Fixed issue #468: Redundant code in CreateSystemImageSet() - * Fixed issue #482: AutoScale() could cause exception during form load. - * Added fix for #466: No parent window if column created in constructor - * Fixed issue #446: ScrollIntoView does not work properly after applying patch from issue #339 - * Improvements for toAlwaysSelectNode option: Selection of next sibling has been improved in case the currently selected node is being removed. - * Added missing begin/end-block in MeasureItemHeight() - * Improved fix for issue #438: Now correctly initializing member of property TVTColors.UnfocusedColor - * Improved fix for issue #447: DoMeasureItem() was called for Node instead of Child. - * Minor improvement in appearance of border lines in HTML export. - * Fixed issue #480: Warning when compiling Delphi XE2 packages - * Fixed #472: Redundant conditions in TVclStyleScrollBarsHook.WMMouseMove - * Fixed #476: Simplify TVTDragImage.WillMove() - * Fixed issue #485: unit VirtualTrees does not compile with {$TYPEDADDRESS ON} - -V5.5: (11 Sep 2014) - * Added packages for RAD Studio XE7 / Delphi XE7 - * Fixed issue #464: Vertical grid lines not computed correctly for spanned cells with header auto resize - * Fixed issue #442: Scrollbars are not updated for active VCL Style under XE2 - * Fixed issue #463: HTML export shows grid lines in IE and Chrome, but not in Firefox - * Fixed issue #460: Access violation in design time when setting "CheckBox" to True for a Virtual Treeview Column - * Fixed issue #72: Call Application.CancelHint only if the current control is showing the hint - * Fixed issue #461: corrected condition in TBaseVirtualTree.ScrollIntoView, so that not only partially (by the fixed area) covered columns but also totally covered columns are scrolled in view - * Fixed issue #450: Regional letters entered using Right+Alt should also trigger the incremental search. - * Improvemtns for toAlwaysSelectNode: - Clicking the free space below the tree nodes no longer deselects the selected node. - We now prevent toggling of the selection of the last selected node if toAlwaysSelectNode is set in TreeOptions. - * Fixed issue #447: SetChildCount() now calls DoMeasureItem() instead of using DefaultNodeHeight. - * Fixed issue #444: ERangeError in TBaseVirtualTree.CMMouseWheel - * TBaseVirtualTree.MeasureItemHeight() is virtual now. - * Fixed issue #445 MultiSelect behavior: Can't drag node which is not selected - * Fixed Issue #443: TVirtualTreeColumns.ColumnFromPosition on right border of fixed column - * Fixed issue #339: Problems with fixed column - * Implemented #410: Small extension of TStringEditLink: Allow creating own edit control by moving the creation of TVTEdit from constructor to virtual PrepareEdit with assigned check. - * Implemented #409: Extend THitInfo record with hit coordinates - * Added suggestions of #438: Make some members visible to derived classes - * Fixed issue #440: Context menu does not pop up if there is no selected node - * Added C++ Builder link demand to VirtualTreesR.Lib as {$HPPEMIT} - * Improved installation instructions, especially for C++ Builder - -V5.4.1: (26 May 2014) - * Added packages for C++ Builder XE6 - * If toAutoChangeScale is set in AutoOptions, the Virtual TreeView control now - increases the DefaultNodeHeight if the font size is too large to fit. - * If toAutoChangeScale is set in AutoOptions, the columns widths are now adjusted too. - * Improved implementation for toRestoreSelection option - * Fixed possible AV in PaintNodeButton() - * Now ensuring that both GetHorzScrollBarSliderRect() and - GetVertScrollBarSliderRect() return a valid value for every code path (Thx to - Dmitri Dmitrienko). This could cause strange out of resources exceptions with VCL - styles enabled. - * Fixed issue #434: Application compiled with Delphi 7 stops responding when you call AddChild - * A few minor changes - -V5.4.0: (22 Apr 2014) - * Added support for XE6. - * Added new option toRestoreSelection to TVTSelectionOptions: Set to true if upon refill the previously - elected nodes should be selected again. The nodes will be identified by its caption only. - * Added new option toAlwaysSelectNode to TVTSelectionOption enum. If this flag is set, the treeview tries to - lways have a node selected. This behavior is closer to the Windows TreeView and useful in Windows Explorer - tyle applications. It is also useful for accessible applications which can indicate having the focus by - isplaying a selection. - * Added function TBaseVirtualTree.IsEmpty which returns True if the control has no nodes. - * Fixed a wrongly drawn selection after the user scrolled horizontally. - * Fixed issue #423: Change property TVirtualTreeColumn.Tag to NativeInt. - * Implemented #415: Added feature for design time column header dragging and resizing. (Thx to fr0st.brutal) - * Fixed issue #180: Memory leak in grid demo of Advanced project - * Implemented #422: Added TBaseVirtualTree.GetFirstChildNoInit() - * Fixed issue #420: Add coEditable to TVTColumnOption) by applying the supplied path. Thx to Stefan Glienke. - * Fixed issue #419: Some issues with changing to edit mode with clicking - * Fixed issue #430: TVTDragManager memory leak with visual inheritance. Thx to Andreas Hausladen for the patch. - * Fixed issue #431: Visual bug when using TStringEditLink with large node heights - * TVclStyleScrollBarsHook.WMMouseMove(): Now preventing possible range check error exception. - * Now handling WM_MOVE and WM_POSCHNAGED correctly in TVclStyleScrollBarsHook (Thx to Dmitri Dmitrienko) - * Preventing possible stack overflow in TVirtualTreeHintWindow.ActivateHint (Thx to Dmitri Dmitrienko) - * Added packages for C++ Builder XE5. - * Some minor changes, improvements and fixes have been incorporated - -V5.3.0: (04 Jan 2014) - * Fix for issue #159 (Cursor missing in edit with non-standard DPI): Ensuring a minimum size of the edit control - * Fixed issue #403: Declare TVTGetNodeProc as reference to procedure (for D2009+) - * Fixed issue #402: TVTEdit.CNCommand discard all notification except EN_UPDATE due to missing inherited - * Corrected fix for issue #376 (Incorrect selection paint when toGridExtensions is included in the MiscOptions) - * Fixed issue #401: OnNodeClick event doesn't trigger in some case, coFixed set for a column - * Modified #316 (concerning r498). The fix for #316 will only be applied in case toMultiSelect is set. - If toMultiSelect is not set we can start a drag anywhere in the row. - * ContentToHTML() and ContentToRTF() now return a string of type RawByteString. - Because the generated strings are pre-encoded in UTF-8, the previous type AnsiString caused - problems in Delphi 2009+ e.g. when this string was written using the VCL TStreamWriter class. - The helper class TBufferedAnsiString therefore uses RywByteString now as type too. - * Fixed issue #399: EditDelay not working - * Fixed issue #400: AltGr+A does not behave as expected for foreign keyboard layouts in VTEdit - * Fixed issue #388: VirtualStringTree with toFixedIndent causes range check error - * Edit box when editing a node in a tree with toFixedIndent now has the correct indent - * Fixed issue #392: Now ensuring that MeasureItemHeight() is only called from the main thread. - * Fixed #383: Clear vsHasChildren for a node without children even if the children count didn't change. - * Fixed #377: Wrong font (size, etc) in TargetCanvas in MeasureItem for first node - * Fixed issue #398 (hoAutoResize causes DFM designer to be modified after loading) by calling TControl.Updating()/Updated() in AdjustAutoSize() - * Preventing possible AV in TBaseVirtualTree.FontChanged() - * Fixed 32Bit Integer overflows in Win64 build in TBufferedAnsiString. - -V5.2.2: (30 Oct 2013) -- Added support for Delphi / RAD Studio XE5 -- Fixed issue #371: property OnGesture is now published. -- Fixed issue #365: No longer changing timer resolution globally -- Fixed issue #347: No expand-pluses seen under Windopws classic theme for a vcl styled application -- Fixed issue #373: Scrollbar does not size properly for more than 2000 nodes with variable node height: - The OnMeasureItem event is triggered only in case the toVariableNode flags in included in MiscOptions -- Fixed issue #376: Incorrect selection paint when toGridExtensions is included in the MiscOptions -- Improved displaying of EmptyListMessage text, especially when scrolling horizontally. -- Fixed issue #61: EditCursor missing with manifest + toThemeAware + vsMultiline -- Fixed issue #352: Minor improvement in calculation of right margin of hint window. - -V5.2.1: (06 Sep 2013) -- Fixed #352 and #354 by modifying the implementation of #237 so that a focused node is ensured only if the - control is being entered using the TAB key. This is consistent with the behavior of the Windows Explorer. -- Fixed issue #360 (In the calculation of the horizontal scroll bar static text should be considered) by - calling DoGetNodeExtraWidth() in TBaseVirtualTree.GetMaxRightExtend() -- Used fix proposed in issue #361 to fix issue #357 (AV in advanced demo - PropertiesDemo form in XE3+) -- Removed call to TCustomStyleEngine.UnRegisterStyleHook() to fix issue #359/#355 -- Fixed issue #358: Horizontal Scrollbar issue when expand ing and scrollbars get visible -- Fixed issue #355/#345: exception regarding style services - -V5.2: (09 Aug 2013) -- OnMouseEnter and OnMouseLeave events have been added (#238) -- Improved dpi scaling for VirtualTreeView and Header -- toAutoChangeScale and toAutoSort are now among the defualt values for TCustomVirtualTreeOptions.AutoOptions -- Fixed issue #237: Auto focus the first node on enter if there is no focused node -- Fixed issue #344: Cannot select row by Ctrl+Click on empty column -- Fixed issue #206: Column painting issue with coWrapCaption in Options -- Fixed issue #128: OleUninitialize in FinalizeGlobalStructures can hang when using Virtual Treeview in a DLL -- Added new public property LastDragEffect which supplies the last executed drag effect. -- Added virtual method GetNodeImageSize() which can be overridden if one needs different sized images. -- Added new public property LastDragEffect which supplies the last executed drag effect. -- Fixed issue #206: Column painting issue with coWrapCaption in Options -- Fixed issue #336 by ignoring PARENTDOUBLEBUFFEREDCHANGED message. -- Fixed issue #342 by adding a new implementation of the VCL's DoubleBuffered property. - The inherited DoubleBuffered property of TWinControl must not be set to True! -- A few minor improvements have been added. - -V5.1.3: (17 Apr 2013) -- Fixed #340: GetHitTestInfoAt on right border of fixed column. -- Fixed #337: Cannot "grab" item for dragging, odd behaviour of multi selecting with the selection - rectangle when toFullRowSelect is True but toSimpleDrawSelection is False. (thx to Stefan Glienke) -- Fixed #341: Error when unloading DLL due to missing UnRegisterStyleHook -- Improved fix for #323: The fix applied in V5.1.2 was a breaking change for some projects, especially - if not all the initialization was done in the OnInitNode event (reported as #338). vsInitialUserData - has been renamed to vsOnFreeNodeCallRequired and is now set when GetNodeData is called. This fixes - the possible memory leak reported in #323 and has better backward compatibility. -- Fixed #316: These fixes are to make the treeview behave more like the windows explorer regarding - selecting and dragging. Thanks to Stefan Glienke. -- Fixed #333: Possible Integer overflow in 64Bit builds. -- Compatibility with / packages for Delphi Xe$ / RAD Studio XE4 have been added. - -V5.1.2 (04 Apr 2013): - - Added function TVirtualTreeColumns.GetFirstColumn that returns the first column in display order. - - Fixed issue #322: CaptionAlignment is not being restored by Header.LoadFromStream(). - - TBaseVirtualTree.GetNodeData() now calls InitNode() if the node had not beend initialized. - This fixes issue #323 (Memory leak when the Node has children ) - - Fixed issue #326: Application hangs when aborting OLE Copy/Paste Operation - - Added new option poResizeToFitItem to TVTHeaderPopupOption: Adds an item which, if clicked, - resizes all columns to fit by calling TVTHeader.AutoFitColumns() - - Property RangeX is now public in the class TVirtualStringTree (#327) - - TVirtualTreeColumns.HandleClick(): No longer triggering auto sort if just the checkbox in the header was clicked - - TBaseVirtualTree.SetCheckType new resets PVirtualNode.CheckState only if the check state does not fit the new check type - - Fixed issue #321: Delphi2009: undeclared identifier: 'fState' in VirtualTrees.pas:DrawDisabledImage() - - Fixed issue #315: hoHeaderClickAutoSort was only working if toAutoSort is also set - -V5.1.1 (07 Feb 2013): - - Fixed issue #313: Translucent selection rectangle completely broken when PaintBackground is used - - Fixed issue #314: Only if toAutoSort is True non-expanded nodes will be excluded from sorting. - This restores the behavior of V5.0.X. - - Fixed issue #306: Drag image was broken except for CF_HDROP - - Fixed issue #305: Broken hint drawing with classic windows theme and toUseExplorerTheme - - Fixed issue #298: Bad canvas parameters in OnBeforeCellPaint method - - If NodeDataSize has its default value -1, now sizeof(Pointer) is used at runtime as actual value. - This makes it easier to store a simple Pointer with each node indepedent of the target platform (32/64Bit). - - Fixed issue #300: Made the hint text more centered in the hint window - - If TVirtualTreeColumn.CheckBox is set to True in Designer, then hoShowImages is now added to Header.Options - - Fixed issue #302: AV when painting sorted header column containing checkbox - - Now soring subnodes when they get expanded and the toAutoSort flag is set - - Added fix for ugly drawn disabled images (thx to S. Glienke). See also: - http://stackoverflow.com/questions/6003018/make-disabled-menu-and-toolbar-images-look-better - http://qc.embarcadero.com/wc/qcmain.aspx?d=86879 - - Fixed issue #299: Draw themed focus rectangle with toUseExplorerTheme - - Fixed issue #198: Wrong check images - - Removed file VTConfig.inc. The former $ifdef ReverseFullExpandHotKey is now a flag in the - TVTMiscOption enumeration. The $ifdef TntSupport can be defined at the beginning of the unit VirtualTrees. - - Added new optional parameter "Recursive" to TBaseVirtualTree.Sort() - -V5.1.0 (05 Nov 2012): - - Fixed issue #291: Empty hint strings are shown when using custom hint window classes - - Added support for VCl styles of RAD Studio XE2 and higher. (Thanks to Dietmar Rösler, issue #288) - - Fixed issue #285: access violation when mouse down over checkbox sometimes - - Fixed issue #293: OnAdvancedHeaderDraw is called with wrong PaintInfo.PaintRectangle - - Improved creation of IDragSourceHelper and added support for IDragSourceHelper2 - - Fixed problem with drawing selection rectangle after canceled rename - - Improved creation of IDragSourceHelper and added support for IDragSourceHelper2 - - Fixed issue regarding activating explorer theme - - Fixed issue #222: FDottedBrush is never released in the tree is never shown - - Fixed issue #52: Misalignement of CheckBox and TreeLine/Buttons - - Fixed issue #43: VT stop repaint after Windows visual style change - - Fixed issue #66: column auto-resize makes not aware of StaticText - - Fixed issue #53: Misalignment Images Columns > 0 - - Fixed issue #176: Multiline Aligment Problem - - Fixed issue #283: VTV no longer allows to drop above or below when using Full row selection - - Fixed issue #173: Two suggestions about class member visibilities - - Fixed issue #192: Fixed column painting bug when OffsetX > 0 - - Fixed Delphi 2007 Designer package - -V5.0.1 (06 Sep 2012): - - Added Support for RAD Studio XE3 - - Fixed definition of event OnAfterHeaderExport, it used the same member variable as OnBeforeHeaderExport. - - Fixed problem with Delphi 2007 package - - Delphi 2009 and 2010 packages are also implicit build packages now, like those for XE and XE2 (issue #279) - - Fixed #251: Added supoort for C++ Builder XE2 - - Fixed #274: Wrong stop condition in TBaseVirtualTree.GetLastVisible - - Fixed runtime package of Delphi 7 - - Fixed issue #273: Incremental search for international symbols not working in Delphi 2009-XE2 - - A few minor bug fixes have been incorporated - -July 03, 2012 - - Release of V5.0.0 final -June 11-30, 2012 - - Release of V5.0.0 RC2 - - Removed dependecy on file Compilers.inc - - Removed dependency on file MSAAIntf.pas - - Removed folder Common - - Fixed issue #252: Incorrect width of edit control rectangle when grid extensions are set - - Fixed issue #259: Hit position wrong when Indent is not default - - Fixed issue #253: Compatibility issues with XE2's VCL style checkboxes - - Fixed issue #265: Lib suffix not set for all configurations in Delphi XE2 package - - Bug fix: Functions GetLastVisible and GetLastVisibleNoInit return correct results even if some anchestor of the last visible node is not effectively visible - - Improvement: Added functions GetNextSiblingNoInit and GetPreviousSiblingNoInit - - "Res" folder of Advanced sample was not included in ZIP archive - - Added folder "Contributions" to release -June 01-10, 2012 - - Release of V5.0.0 RC1 - - Updated help file for V5.0 -April 2012 - - Added support for theming of hint window (thanks to Arno Garrels and Uwe Schuster) - - TBaseVirtualTree.CheckParentCheckState: Fixed duplicate recursion to parent nodes -March 2012 - - Fixed painting of Windows7/Vista style Explorer selection in case tsUseExplorerTheme is in TreeOptions - - Ctrl + A now selects all items -January 2012 - - Bug fix: Fixed a potential access violation in TBaseVirtualTree.FullCollapse in case of toChildrenAbove -December 2011 - - Fixed compiler warning in RAD Studio XE2 regarding deprecated ThemeServices -September 2011 - - The property EmptyListMessage may now contain linebreaks in Delphi 2009 and higher, the text in now printed in dark gray. - - Support for flat scroll bars has been removed. - - Global variables InWin2k and IsWinXP, enum member hsXPStyle, function DrawXPButton() and support for Windows 2000 has been removed. - - Global variable IsWinNT and support for Windows 9x has been removed. - - Improvement: Added support for Delphi XE2 and 64Bit compiler. - - Support for Delphi 5/6 and C++ Builder 5/6 has been dropped. - - Bug fix: Fixed a potential integer overflow in TBaseVirtualTree.ToggleNode in case of toChildrenAbove and NodeInView - - Bug fix: Fixed a potential Assertion in TBaseVirtualTree.ToggleNode by checking GetFirstVisible before calling GetDisplayRect - - Bug fix: TCustomVirtualTreeOptions.SetPaintOptions correctly changes the VisibleCount when toShowFilteredNodes is toggled - - Improvement: Added new functions TBaseVirtualTree.DetermineDropMode - - Improvement: Added usage of TBaseVirtualTree.DetermineDropMode in TBaseVirtualTree.DragOver - - Improvement: Made EffectiveOffsetX accessible via read-only protected property for easier subclassing - - Improvement: Moved TBaseVirtualTree.DetermineLineImageAndSelectLevel from private to protected for easier subclassing - - Improvement: Sorted TBaseVirtualTree.SetEmptyListMessage -August 2011 - - Improvement: Minor code improvements -April 2011 - - Bug fix: Reverted change of November 2010 (Creating the WorkerThread will no longer change System.IsMultiThread) - it caused sporadic AVs during app start which disappeared after revering the change. This code can lead to a wrong value - of System.IsMultiThread which causes the memory manager to assume a single threaded application. - - Bug fix: When advancing to the next item while in edit mode, we are now also calling CanEdit(). -February 2011 - - Bug fix: In case the LastStructureChangeNode is deleted before the StructureChange event is fired, - the reference to the LastStructureChangeNode is cleared to avoid providing an invalid node -January 2011 - - Improvement: RTF export now uses landscape paper format and smaller margins, so that more of the contents - fits on the page - - Improvement: New Option hoHeaderClickAutoSort for TVTHeader.Options: Clicks on the header will make the - clicked column the SortColumn or toggle sort direction if it already was the sort column - - Improvement: Pressing the tab key in edit mode advances to the next node in edit node, just like the - Windows 7 Explorer does it. - - Bug fix: No longer auto-scrolling horizontally when the focused node changes if toFullRowSelect is turned on. - - Bug fix: Fixed a clipping issue when drawing unbuffered -December 2010 - - Improvement: TBaseVirtualTree.HandleMouseUp now checks CanEdit just in case toEditOnClick - - Bug fix: TotalNodeHeights are now correctly adjusted when toggling toShowHiddenNodes - - Bug fix: Fixed BCB compiler error due to re-defining IDropTargetHelper - - Improvement: New TVTInternalPaintOption poUnbuffered to directly paint onto a given canvas (especially useful - when printing and/or scaling via world transformations) - - Improvement: Refactored header painting to be more flexible (e.g. for printing) - - Improvement: Made additional fields accessible via protected read-only properties for easier subclassing -November 2010 - - Improvement: All calls to SetWindowOrgEx now respect the canvas' transformation - - Improvement: TBaseVirtualTree.GetNodeHeight will no longer measure the node height, if the node is about - to be deleted - - Improvement: Made TBaseVirtualTree.FRangeX and FRangeY accessible via read-only protected property - - Improvement: Unified clipping handling - - Improvement: Added new color setting "SelectionTextColor" - - Improvement: Creating the WorkerThread will no longer change System.IsMultiThread - - Bug fix: Fixed a potential integer overflow in TBaseVirtualTree.ToggleNode - - Bug fix: TBaseVirtualTree.ToggleNode now measures the child node heights before summing them - - Improvement: Made some private field of TVTHeader and TVirtualTreeColumns protected to make writing - derived classes easier - - Improvement: Enclosed call to DoDragDrop in TBaseVirtualTree.CMDrag in a try..finally block - - Improvement: The default inplace editor now resizes itself even when the tree is in grid mode - - Bug fix: TBaseVirtualTree.PrepareBitmaps now checks the existance of the main column correctly - - Bug fix: TBaseVirtualTree.UpdateEditBounds now checks wether the focused node is assigned - - Improvement: TBaseVirtualTree.FHintData is now available to derived classes via the protected property HintData -October 2010 - - Bug fix: Now taking horizontal scroll position into account when drawing text of EmptyListMessage property - - Bug fix: Prevented potential "index out of bounds" exception in TVirtualTreeHintWindow.CalcHintRect - - Bug fix - Issue #187: Showing a dialog in OnChange or OnRemoveSelection event handlers can cause the VT to - enter mode for drawing selection rectangle. - - Improvement: Made inherited event OnCanResize published for TVirtualStringTree for Delphi 2010 and later - - Improvement: TBaseVirtualTree.ToggleNode now tries to keep the visual position of the toggled node, - even when toChildrenAbove is set -September 2010 - - Improvement: Added additional check regarding the tree reference to TVirtualTreeHintWindow.AnimationCallback - - Improvement: Made TBaseVirtualTree.AdjustImageBorder protected and virtual - - Improvement: TVirtualTreeColumns now observes if the focused column is removed - - Improvement: Made compatible with Delphi XE (Thanks to Roman Kassebaum) -August 2010 - - Improvement: TCustomVirtualStringTree.DoTextMeasuring now returns TSize - - Improvement: Renamed TVTMeasureTextWidthEvent to TVTMeasureTextEvent and introduced new - event TCustomVirtualStringTree.OnMeasureTextHeight - - Improvement: Made TBaseVirtualTree.GetMaxColumnWidth virtual - - Bug fix: TBaseVirtualTree.OnRemoveFromSelection is now triggered by TBaseVirtualTree.RemoveFromSelection - as intended -July 2010 - - Bug fix: Toggling toShowFilteredNodes will now update the node counts in the tree even if its handle has not - been allocated so far - - Bug fix: TBaseVirtualTree.FindNodeInSelection should now work correctly with nodes above the 2gb boundary - - Bug fix: Nodes that are about to be deleted are now removed from TBaseVirtualTree.FDragSelection - - Bug fix: Changed TBaseVirtualTree.WMKeyDown to correctly handle special keys in Unicode based Delphi versions - - Bug fix: Changed declaration of TBaseVirtualTree.EmptyListMessage to UnicodeString - - Improvement: Added new property TBaseVirtualTree.EmptyListMessage. If this property is not empty, the assigned - text will be displayed if there are no nodes to display, similar to the Windows XP file search. - - Improvement: Added tstChecked to TVSTTextSourceType enumeration and support for the new flag to - GetRenderStartValues(). So you can export only checked nodes. -June 2010 - - Bug fix: range select with no nodes will no longer result in an access violation - - Bug fix: TBaseVirtualTree.SetVisible now correctly decrements the visible node count - - Bug fix: TStringEditLink.BeginEdit now calls AutoAdjustSize to ensure a consistent size of the edit field - - Improvement: TVTHeader.AutoFitColumns is now declared virtual - - Bug fix: header captions were badly positioned text if Extra Large fonts have been activated in the Windows - display options -May 2010 - - Improvement: TBaseVirtualTree.PaintTree is now declared virtual - - Bug fix: corrected calculations regarding tree height and visible count when using filtered nodes -April 2010 - - Bug fix: Changed TBaseVirtualTree.SetChildCount and TBaseVirtualTree.InitNode to correctly handle filtered nodes - - Bug fix: Ctrl+Click on a node often cause a delayed update of the displayed selection due to a missing (or - misplaced) call to Invalidate() in HandleClickSelection(). - - Bug fix: Shift+PgUp and Shift+PgDown now behave like a usual List(View) and select the node of the previous/ - next page. The behaviourly that was formerly assigned to these shortcuts is now triggeres when using - Shift+Alt+PgUp / Shift+Alt+PgDown -March 2010 - - Bug fix: TBaseVirtualTree.CMMouseLeave now checks if the header is assigned before working with it - - Bug fix: TCustomVirtualTreeOptions.SetPaintOptions will now invalidate the node cache if toChildrenAbove is - changed - - Bug fix: TBaseVirtualTree.HandleMouseUp will no longer cause an AV if HitInfo.HitNode is not assigned and - tsToggleFocusedSelection is set - - Improvement: new properties TBaseVirtualTree.OnAddToSelection and TBaseVirtualTree.OnRemoveFromSelection - - Bug fix: fixed a whole bunch of painting issues regarding drag & drop - - Bug fix: fixed TBaseVirtualTree.DragFinished to generate a button up event in case of using OLE drag & drop - - Bug fix: TBaseVirtualTree.DeleteChildren no longer fails if the given node is nil -January 2010 - - Bug fix: Removed defaults from TVirtualTreeColumn.BiDiMode and TVirtualTreeColumn.Color - - Bug fix: Clearing the columns while editing no longer raises an exception - - Improvement: refactored handling of long running operations - - Bug fix: TBaseVirtualTree.OnGetHelpContext now delivers the currently focused column instead of always 0 - - Improvement: the sort operation can now be canceled - - Improvement: all BeginOperation/EndOperation pairs are now enclosed in try..finally blocks - - Bug fix: the combination of toUseExplorerTheme and toFullRowSelect now also works correct when no columns are - defined -December 2009 - - Bug fix: TVTHeader.HandleMessage now correctly handles double click autosizing when the index differs from - its position -November 2009 - - Bug fix: TBaseVirtualTree.AdjustTotalHeight didn't change the height of invisible nodes which caused some trouble - when making those nodes visible again - - Improvement: a column is no longer painted 'down' if its check box was clicked - - Bug fix: one can no longer toggle the check state of a column with the right mouse button - - Bug fix: one can no longer toggle the check state of a node with the right mouse button - - Bug fix: TCustomVirtualTreeOptions.SetPaintOptions no longer accidentally removed the the explorer theme - - Bug fix: Fixed a potential Integer overflow in TBaseVirtualTree.CalculateVerticalAlignments -October 2009 - - Bug fix: enabling checkbox support for a column is now possible without assigning a dummy imagelist - - Bug fix: checkboxes in the header are now correctly aligned - - Improvement: changed TBaseVirtualTree.PaintCheckImage to be usable by TVirtualTreeColumns.PaintHeader to be - able to paint themed header checkboxes - - Bug fix: TBaseVirtualTree.GetCheckImage now correctly handles cases when Node is nil and ImgCheckType is either - ctTriStateCheckBox or ctNone - - Bug fix: TBaseVirtualTree.HasImage now implicitly initializes the given node if needed to avoid requesting the - imageindex for nodes that are not initialized - - Bug fix: fixed possible AV when setting toExplorerTheme with no columns defined - - Improvement: new events TBaseVirtualTree.OnSaveTree and TBaseVirtualTree.OnLoadTree -September 2009 - - Bug fix: TBaseVirtualTree.OnColumnClick will no longer be triggered twice - - Improvement: new TVirtualNodeInitState ivsReInit to indicate that a node is about to be re-initialized - - Bug fix: TCustomVirtualStringTree.DoTextMeasuring now makes use of the parameter Width of the - OnMeasureTextWidth event - - Bug fix: TBaseVirtualTree.DetermineLineImageAndSelectLevel will no longer access LineImage[-1] - - Bug fix: clearing the columns now correctly reset TBaseVirtualTree.FFocusedColumn - - Improvement: explorer style painting is now more close to the real explorer - - Bug fix: TCustomVirtualStringTree.TContentToHTML.WriteStyle will no longer produce invalid CSS - - Bug fix: the parameter DragEffect of TBaseVirtualTree.DragAndDrop is now var as it should be -August 2009 - - Bug fix: TBaseVirtualTree.MoveTo now initializes the target node using the target tree - - Bug fix: TBaseVirtualTree.FVisibleCount is now calculated correctly when using filtered nodes - - Improvement: introduced new initial node state ivsFiltered -July 2009 - - Improvement: modified TVTHeader.HandleHeaderMouseMove to make resizing the autosize column with the - mouse possible - - Improvement: modified TBaseVirtualTree.DoCreateEditor so that applications can now return NIL in OnCreateEditor - to use the standard editor of the tree - - Bug fix: pressing CTRL + PgUp/PgDown no longer leads to an index-out-of-bounds exception if no columns are used - - Bug fix: avoided race condition between TBaseVirtualTree.DeleteNode and the worker thread - - Bug fix: TBaseVirtualTree.ToggleNode could produce an overflow if range checking was enabled - - Bug fix: TWorkerThread will no longer reference the tree after it has been destroyed (Mantis issue #384) - - Improvement: removed support for Delphi versions older than Delphi 7 - - Improvement: removed local memory manager -June 2009 - - Bug fix: TBaseVirtualTree.InternalConnectNode checked the expanded state of the wrong node if Mode was - amAddChildFirst or amAddChildLast - - Improvement: 'hidden nodes' are now called 'filtered nodes' - - Improvement: converted line endings back to CR/LF - - Improvement: new events TBaseVirtualTree.OnCanSplitterResizeNode and TBaseVirtualTree.OnCanSplitterResizeHeader - - Improvement: made TVirtualTreeColumns.DoCanSplitterResize virtual - - Improvement: made some methods of TVirtualTreeHintWindow protected to make subclassing easier - - Bug fix: fixed some issues concerning the vista theme handling - - Improvement: unified source code indentation -May 2009 - - Improvement: new TVTMiscOption toEditOnClick, toEditOnDblClick to control if editing can be started with a single - click or a double click - - Bug fix: the internal pointers of TBufferedAnsiString are now PAnsiChar to work correctly with Delphi 2009 -April 2009 - - Bug fix: TBaseVirtualTree.GetVisibleParent no longer returns the given node in case it is fully visible - - Improvement: fixed a potential issue in TVirtualTreeColumns.TotalWidth in case it is called before - FPositionToIndex is initialized - - Bug fix: TBaseVirtualTree.CollectSelectedNodesLTR and TBaseVirtualTree.CollectSelectedNodesRTL handle straight - vertical selection rectangles no longer as empty - - Bug fix: TCheckImageKind.ckSystemDefault now works as intended - - Improvement: made the following methods of TBaseVirtualTree virtual: PrepareCell, AddChild, BeginUpdate, - EndUpdate and SortTree - - Improvement: made TBaseVirtualTree.PrepareCell protected - - Improvement: moved some members of TVTEdit and TStringEditLink from private to protected - - Improvement: re-designed header click handling - - Improvement: new TVTPaintOption toShowHiddenNodes to globally ignore the hidden state of nodes - - Improvement: individual nodes can now be hidden without affecting their children - - Improvement: re-designed Explorer theme drawing - - Bug fix: corrected allocation problems in TBufferedAnsiString and TWideBufferedString -March 2009 - - Bug fix: fixed an issue in TVirtualTreeColumns.HandleClick that could lead to a case where no header click event - is triggered - - Bug fix: fixed an issue in TBaseVirtualTree.HandleHotTrack that could lead to an endless loop under certain - conditions - - Improvement: removed unused variables in TVirtualTreeColumn.ComputeHeaderLayout - - Bug fix: corrected TBaseVirtualTree.GetVisibleParent - - Improvement: extended hot node tracking to track the hot column too - - Improvement: new THitPosition hiOnItemButtonExact used to draw hot buttons when using Windows Vista's Explorer - theme - - Improvement: new TVTPaintOption toHideTreeLinesIfThemed to consider toShowTreeLines only if running unthemed - - Improvement: new TVTPaintOption toUseExplorerTheme to draw the tree like Windows Vista's Explorer treeview -February 2009 - - Bug fix: reverted the implementation of DrawTextW back to the one prior to 4.8.1 as the line end detection - lead to a compiler warning under Delphi 2009 - - Bug fix: corrected implementation of GetStringDrawRect to match its declaration (UnicodeString vs WideString) - - Bug fix: the node focus will no longer change if a TVTMiscOption.toGridExtensions is set and one clicks right of - (or left of, if right-to-left reading) the last column - - Bug fix: fixed an issue with TVTHeader.Assign that could lead to an access violation if the header is created at - runtime - - Bug fix: one can no longer change a node's height with the right mouse button even if toNodeHeightResize and - toRightClickSelect are set - - Improvement: TVTAutoOption.toDisableAutoScrollOnFocus now works for nodes too - - Improvement: new property TBaseVirtualTree.SelectionLocked to disable changing the selection - - Improvement: made the dual-scroll effect in TBaseVirtualTree.ToggleNode much smoother - - Bug fix: removed off-by-1 errors in TBaseVirtualTree.ToggleNode - - Bug fix: added a check for FUpdateCount to TBaseVirtualTree.SetUpdateState as otherwise every call to - TBaseVirtualTree.DoBeforeCellPaint to get the cell content margin within an Begin/EndUpdate-block would - re-enable painting - - Bug fix: TVTHeader.HandleMessage could provide a wrong column index to OnBeforeColumnWidthTracking in some cases - - Improvement: new properties TBaseVirtualTree.OnBeforeAutoFitColumn, TBaseVirtualTree.OnAfterAutoFitColumn - - Improvement: new procedures TBaseVirtualTree.CancelOperation, TBaseVirtualTree.BeginOperation, - TBaseVirtualTree.EndOperation and new property TBaseVirtualTree.OperationCanceled to enable the - application to stop (possibly) long-running operations - - Improvement: integrated changes from Andreas Hausladen - - Improvement: integrated changes from Dmitry Zegebart where applicable - - Bug fix: removed off-by-1 error in TBaseVirtualTree.GetDisplayRect - - Bug fix: changed the size of the buffer used in TBaseVirtualTree.PaintTree to paint the area below the last node - as the bitmap was not completely erased using previous size under certain conditions - - Bug fix: fixed TBaseVirtualTree.GetPreviousLevel -January 2009 - - Bug fix: removed off-by-1 error in TBaseVirtualTree.GetBottomNode - - Improvement: improved speed of TBaseVirtualTree.GetMaxColumnWidth when using UseSmartColumnWidth - - Version is now 4.8.0 -December 2008 - - Bug fix: modified TBaseVirtualTree.UpdateHorizontalScrollbar and TBaseVirtualTree.UpdateVerticalScrollbar to - recalculate the tree's dimensions even if an update is in progress - - Improvement: renamed TVTHeaderState hsTracking and hsTrackPending to hsColumnWidthTracking and - hsColumnWidthTrackPending - - Improvement: modified TBaseVirtualTree.GetFirstVisible and TBaseVirtualTree.GetFirstVisibleNoInit to optionally - take a node to specify where to start - - Improvement: modified TVTAfterGetMaxColumnWidthEvent to make the result of TBaseVirtualTree.GetMaxColumnWidth - changable - - Bug fix: corrected TBaseVirtualTree.GetMaxColumnWidth to consider toFixedIndent and no longer take nodes into - account that are just above or below the visible area - - Improvement: new property TVirtualTreeColumns.DefaultWidth - - Improvement: new property TVTHeader.FixedAreaConstraints (new class TVTFixedAreaConstraints) to limit the - fixed area (header, fixed columns) to a percentage of the client area -November 2008 - - Improvement: new cursor added: crVertSplit used for height tracking - - Improvement: changed type of TVTHeader.Height from Cardinal to Integer to make boundary checks easier - - Improvement: new properties TVTHeader.MinHeight and TVTHeader.MaxHeight - - Improvement: new VirtualTreeStates tsNodeHeightTracking and tsNodeHeightTrackPending - - Improvement: new HeaderStates hsHeightTracking and hsHeightTrackPending - - Improvement: new TVTMiscOption toNodeHeightResize to allow changing node heights via mouse - - Improvement: new TVTHeaderOption hoHeightResize to allow changing header height via mouse - - Improvement: new properties TBaseVirtualTree.OnHeaderHeightTracking, TBaseVirtualTree.OnHeaderDblClickResize, - TBaseVirtualTree.OnColumnWidthTracking, TBaseVirtualTree.OnColumnWidthDblClickResize, - TBaseVirtualTree.OnNodeHeightTracking, TBaseVirtualTree.OnNodeHeightDblClickResize - - Improvement: new function TVTHeader.ResizeColumns to resize multiple columns at once - - Improvement: TVTHeader.DetermineSplitterIndex is no longer influenced by non-resizable columns - - Bug fix: TBaseVirtualTree.ToggleNode now uses DoStateChange to modify FStates - - Bug fix: TBaseVirtualTree.DoBeforeCellPaint now saves the update rect if CellPaintMode is cpmGetContentMargin - and restores it afterwards - - Improvement: modified TBaseVirtualTree.CmMouseWheel to handle mice with wheel delta < 120 correctly - - Improvement: modified TVTHeader.LoadFromStream and WriteToStream to save ParentFont - - Improvement: TVTHeader.Font is now only stored by Delphi if ParentFont is False (Mantis issue #217) - - Bug fix: corrected TVTHeader.Create to set TVTHeader.FOptions correctly to the default value (Mantis issue #333) - - Improvement: new TVTAnimationOption toAdvancedAnimatedToggle to scroll the node to be toggled animatedly instead - of just scroll its child nodes animatedly - - Improvement: added VirtualTreeState tsToggling to eliminate artefacts caused by TBaseVirtualTree.DoSetOffsetXY - while toggling - - Bug fix: corrected button handling when toFixedIndent is set - - Improvement: redesigned TBaseVirtualTree.ToggleNode to harmonize the visual toggle behaviour independent of - toChildrenAbove - - Improvement: made TBaseVirtualTree.CanEdit public - - Improvement: added parameter ConsiderChildrenAbove to TGetNextNodeProc - - Improvement: modified all variants of TBaseVirtualTree.GetFirst and TBaseVirtualTree.GetLast to optionally - consider toChildrenAbove -October 2008 - - Bug fix: removed 'FVisibleCount := 0' from TBaseVirtualTree.Clear as this would lead to incorrect VisibleCount in - read-only mode - - Bug fix: fixed a condition in TBaseVirtualTree.ToggleCallback that could lead to artefacts - - Improvement: changed the implementation of TBaseVirtualTree.GetNext/GetPrevious so that no penalties occur if - toChildrenAbove is not set - - Improvement: TBaseVirtualTree.ToggleNode will no longer leave nodes with state vsToggeling if an exception - occurs - - Improvement: improved behaviour of TBaseVirtualTree.ToggleNode in case toChildrenAbove is set - - Bug fix: corrected TBaseVirtualTree.ScrollIntoView to behave as expected when no fixed columns exist - - Bug fix: extended TBaseVirtualTree.InitializeLineImageAndSelectLevel to eliminate artifacts while scrolling with - toChildrenAbove set - - Bug fix: corrected CompareNodePositions to consider toChildrenAbove - - Bug fix: corrected ToggleNode to scroll correctly if toChildrenAbove and toAnimatedToggle are set - - Improvement: new TVTPaintOption toFixedIndent to draw the tree with a fixed ident (instead of node level - dependent indents) - - Improvement: new TVTPaintOption toChildrenAbove to draw children nodes above their parent -August 2008 - - Improvement: redesigned and overloaded TBaseVirtualTree.ScrollIntoView in order to use vertical scrolling - separately - - Improvement: optimized TBaseVirtualTree.ScrollIntoView for horizontal scrolling - - Improvement: in TBaseVirtualTree.WMKeyDown column navigation for VK_PRIOR and VK_NEXT is now handled in same way - as row navigation - - Improvement: new TVTHeaderOption hoDisableAnimatedResize to disable animated resize for all columns - - Improvement: new TVTColumnOption coDisableAnimatedResize to disable animated resize for a specific column - - Improvement: in TBaseVirtualTree.UpdateHorizontalScrollBar and TBaseVirtualTree.UpdateVerticalScrollBar scrollbar - updates now avoided for tsUpdating in FStates -July 2008 - - Improvement: in TBaseVirtualTree.WMHScroll the horizontal page scrolling now considers fixed columns - - Improvement: in TBaseVirtualTree.ScrollIntoView the case of FFocusedColumn being invalid is considered - - Improvement: in TBaseVirtualTree.HandleMouseDown DoFocusNode is not called if node focus did not change - - Improvement: in TBaseVirtualTree.SetFocusedColumn the focused node will only be invalidate if it was actually - scrolled into view - - Improvement: new TVTColumnOption coAllowFocus to affect column focus behaviour - - Improvement: new function TVTHeader.AllowFocus to check wether a column can be focused - - Improvement: in TBaseVirtualTree.SetFocusedColumn the old colunm and the new column are both invalidated - - Improvement: merged latest changes from Jim into current code base. -June 2008 - - Improvement: new property TVirtualTreeColumns.Count - - Bug fix: in TVirtualTreeColumns.AnimatedResize the column is validated (to avoid "List index out of bounds") - - Improvement: the content retangle of the cell can be modified via the OnBeforeCellPaint event, the cell paint - mode indicates wether OnBeforeCellPaint is called for painting the cell or just for getting the - cell content margin - - Improvement: new functions added: TBaseVirtualTree.DoGetCellContentMargins, - TCustomVirtualDrawTree.DoGetCellContentMargin - - Improvement: new property: TCustomVirtualDrawTree.OnGetCellContentMargin - - Improvement: in TBaseVirtualTree.GetMaxColumnWidth the cell content margin is considered - - Improvement: in TBaseVirtualTree.CMHintShow the cell content margin is considered for singleline tooltips - - Improvement: new function added: TVTHeader.DoGetPopupMenu (to query the application via TreeView.FOnGetPopupMenu - for a column specific header popup menu) - - Improvement: new property added: TBaseVirtualTree.OnCanSplitterResizeColumn, - new function added: TVirtualTreeColumns.GetScrollWidth - - Improvement: horizontal page scrolling now uses the average column width (of all visible, non-fixed columns) as - scroll amount - - Improvement: procedure TBaseVirtualTree.CMMouseWheel redesigned - - Bug fix: TVTHeader.DetermineSplitterIndex works correctly even when using fixed columns - - Bug fix: on right-to-left BiDiMode TVirtualTreeColumns.PaintHeader respects (left) scroll bar correctly - - Bug fix: for multiline tooltips also the column width is checked to determine the tooltip is needed or - unnecessary - - Improvement: the result value of GetUseSmartColumnWidth is initialized correctly - - Improvement: added hoFullRepaintOnResize to TVTHeaderOption to enable full header repainting (instead of - repainting all subsequent columns only) on resizing a column - - Bug fix: horizontal page scrolling via mouse wheel now works correctly, i.e. in TBaseVirtualTree.CMMouseWheel - ScrollCount includes GetVisibleFixedWidth and FIndent - - Improvement: new TVTColumnOption coSmartResize to avoid contradicting the virtual paradigm - - Improvement: horizontal scrolling via mouse wheel can be forced by holding the shift key - - Improvement: new parameter for function TBaseVirtualTree.GetMaxColumnWidth added: UseSmartColumnWidth (to - avoid contradicting the virtual paradigm, i.e. leave nodes out of consideration which are not in - view) - - Improvement: new parameters for TVTHeader.AutoFitColumns added: SmartAutoFitType, RangeStartCol and - RangeEndCol - - Improvement: new parameters for events FOnAfterAutoFitColumns, FOnBeforeAutoFitColumns, FOnAfterGetMaxColumnWidth - and FOnBeforeGetMaxColumnWidth added - - Version is now 4.6.0 -May 2008 - - Improvement: new properties: FOnAfterAutoFitColumns, FOnBeforeAutoFitColumns, FOnAfterGetMaxColumnWidth and - FOnBeforeGetMaxColumnWidth - - Bug fix: FDropTargetNode is considered in TBaseVirtualTree.DoFreeNode -August 2007 - - for accessibility, added an OnGetImageText event that can be used to give accessible text to images used in nodes. - - Implemented an ImageText property used by the VTAccessibility unit to retrieve text for a given node and its column. - - Switched loading of accessibility libraries to dynamic from static to avoid problems in Win95 -June 2007 - - Bug fix: Fixed a problem with potentially large amount of nodes (larger than 2 billion) in - TBaseVirtualTree.SetChildCount. - - Bug fix: remove hint if any in case the tree loses the focus. - - Improvement: TVirtualTreeColumns.HandleClick is now virtual, introduced TVTHeader.DoSetSortColumn. - - Bug fix: compiler error due to old variable reference when enabling flat scrollbars. -May 2007 - - Improvement: new functions: GetPreviousSelected, GetPreviousChecked, GetCheckedCount, - GetPreviousCutCopy, GetCutCopyCount, GetFirstLeaf, GetNextLeaf, - GetPreviousLeaf, GetFirstLevel, GetNextLevel, GetPreviousLevel - - Improvement: new properties: CheckedCount, CutCopyCount - - Improvement: DoFocusChanging for finding a valid column (TBaseVirtualTree.WMKeyDown) -March 2007 - - Improvement: adjusted accessibility implementation to compile with pre-BDS IDEs. - - If a column is not visible, MultiColumnAccessibility now will not include it. -January 2007 - - Improvement: added code donation from Marco Zehe (with help from Sebastian Modersohn) which implements the - MS accessibility interface for Virtual Treeview. -December 2006 - - Improvement: bidi mode implementation finished (toAutoBidiColumnOrdering introduced) - - Change: right-to-left flag removed from shorten string methods/events (not necessary) - - Version is now 4.5.0 -November 2006 - - Bug fix: Total height is wrong on reading from stream -September 2006 - - Bug fix: Mantis issue #326 -July 2006 -- Change: value for crHeaderSplit cursor conflicts with other resource IDs, so I changed it. -- Published OnStartDrag in VirtualDrawTree. -April 2006 - - Bug fix: check for MMX availabiltiy is missing in some places before calling MMX code - - Bug fix: flag for VCL dragging was removed too late causing all kind of problems with mouse up code in VCL drag mode. - - Bug fix: If the past mode in ProcessOLEData is amInsertAfter then nodes where inserted in the wrong order. -March 2006 - - Bug fix: total count and total height is wrong after loading from stream - - Bug fix: variable node height computation - - Bug fix: FLastChangedNode was not reset in DoFreeNode -February 2006 - - Improvement: GetFirstChecked now also has a default value for its state parameter. - - Improvement: avoid potential reentrancy problems in paint code by checking for the paint state there. -January 2006 - - Bug fix: disabled images are now drawn like enabled ones (with respect to position, indices etc.). - - Improvement: New property BottomSpace, allows to specify an additional area below the last node in the tree. - - Bug fix: VT.EndUpdate did not invalidate the cache so the cache was never used again after that. - - Improvement: tree states for double clicks (left, middle, right). -December 2005 - - Bug fix: check for column index for auto setting main column if the current one is deleted. - -For full document history see help file. - * Fixed issue #692: HitInfo for OnNodeClick event may differ much from HandleMouseDown - * Fixed issue #687 by extracting new method DeleteNodes() from existing DeleteSelectedNodes(). - * Fixed issue #689: Possible Integer overflow in PaintColumnHeader() when dragging a column to first position. - * Fixed issue #693: TVirtualTreeAccessibility.accSelect() should handle the flag SELFLAG_EXTENDSELECTION - * Fixed issue #690: Tree shouldn't keep selected elements, if toAlwaysSelectNode is set and other elements are selected without ctrl-modifier - -V6.5: (18 Jan 2017) - * License change from LGPL to "LGPL with static linking exception". See issue #673 for details. - * Enhancement #662: Background image now supports transparency - * Fixed #677: Improved per monitor dpi awareness. NodeHeight is now scaled as well if toAutoScale is set. - * Fixed #289: HintMode hmHintAndDefault: Default Hint does not change to node specific hint when the mouse is moved to a node. - * Fixed #674: HintMode hmHintAndDefault: If the BidiMode is right to left, the Default Hint fails to appear - * Fixed #139: hoDblClickResize doesn't work correctly with InitalState ivsMultiline - * Fixed #668: Removed unnecessary #include - * Fixed #670: Make it possible to override RangeX - * Fixed #676: VCL themed scrollbar does not update correctly after adding children - * Fixed #626: Wrong hot node selection during mouse movement over different nodes - * Fixed #679: The OnChange event when right clicking a node should always be fired before the OnPopup event - * Fixed #678: Occasional Access Violation in GetDisplayRect - * Fixed #682: Drag & Drop range exception - -V6.4.1: (26 Oct 2016) - * Fixed #549: Drawing issue with toCheckSupport an toExtendedFocus - * Fixed #663: Exception pressing return on an edited item with no columns) - * Fixed #661: Minimal Demo 2 different problems, can't select on start up, multiple clicks causes error - * Fixed problem with wrongly drawn checkbox in column headers. - * VirtualTreePerItemAction now initializes all nodes before it works with them and changes e.g. the check state. - * TBaseVirtualTree.DoGetImageIndex() now always tries to assign a default image list as result, even if OnGetImage and OnGetImageEx are not assigned. So derived controls do not need to make this step. - -V6.4: (28 Sep 2016) - * Fixed #622: [BREAKING CHANGE] Removed all 16x16 fixed sized checkbox-imagelists. - The property CheckImageKind supports the values ckSystemDefault and ckCustom only and should be considered deprecated. - * Fixed #640: Edit control for in-place editing wrongly scaled in high-dpi scenarios - * Fixed #627: It should be possible to use OnGetImageIndexEx without having imagelists assigned - * Added assertion that verifies if an imageindex is supplied but no valid imagelist is available for this imageindex - * Fixed #148: Background Images now support other formats than just bitmaps. - * Fixed #623: GetHint calculates wrong width for HintText - * Fixed #633: High dpi scaling was performed two times - * Fixed #544, #427: Header painting problem with BiDiMode right to left - * TBaseVirtualTree.EnsureNodeSelected() only scrolls the selected node into the view, if no one was previously selected. - * Fixed #248: VT Header draws smudged - * Fixed #643: VT Header dropmark appears even if dragged column won't change position - * Fixed #310: Incorrect selection paint when toAutoSpanColumns, toGridExtensions and toExtendedFocus are set - * Fixed #653: GetFirstVisibleChild/NoInit check for wrong node if IncludeFiltered=True (thx to A. Hausladen) - * Fixed #659: GetLastVisibleChild/NoInit checks wrong node - * Fixed #647: New option to set the way of selecting next cell for editing in grid mode - * Fixed #645: Can't link 64 bit VCL app with VirtualTreeView in C++ Builder 10.1 Berlin - * Fixed #656: Fixed memory leaks in Advanced Demo - * Enhancement #631: Added new Demo project CharityEvents to demonstrate the use of Interfaces for node's data and for data presentation - * Fixed #658: Column Header does not paint correctly after a drop in certain conditions - * Fixed #639: Scrolbars are not correctly themed under certain cirumstances when using a VCL theme. - * Fixed #624: Wrong y-postion of checkboxes in high-dpi display mode - * Fixed #548: Add flag coStyleColor to TVirtualTreeColumn.Options (prefer background color of VCL style over TVirtualTreeColumn.Color) - * Fixed #660: Fix AV when tree is modified in OnEdited event - * Some minor tweaks on Virtual TreeView source code and sample projects - -V6.3: (17 May 2016) - * Added support for RAD Studio 10.1 Berlin - * Implemented #607: Disabled checkbox images should be available - * Fixed #612: hotkey handing and toReverseFullExpandHotKey - * Fixed #602: Dangling WM_Timer and doubled OnChange calls - * Fixed #606: High DPI Inheritance of Form. TBaseVirtualTree.ChangeScale() now respects inherited property ScalingFlags - * Fixed #608: Horizontal lines paint bug on scroll. - * Fixed #605 : If a new node is selected by left click, OnChange event should not fire with `nil` in-between. - * TBaseVirtualTree.EnsureNodeSelected() no longer changes scroll position unless necessary to make the selected node visible. - * Pull request #609: Updated unit "Contributions/GenericWrapper/VirtualTreeWrapper.pas" - * Started adding unit tests with DUnitX. - * Minor tweaks. - -V6.2.3 (11 Feb 2016) - * Fixed accidental remove of vsReleaseCallOnUserDataRequired flag which can cause mem leaks. - * TVirtualNode.SetData() now sets the vsOnFreeNodeCallRequired flag for all types of user data and so is consisted with other SetData / GetData methods. - * TCustomVirtualStringTree.SetChildCount() now calls ResetInternalData()= with Recurse = False to avoid that all siblings of the new children are reseted recursively. See isuue #576 - * TCustomVirtualStringTree.ResetInternalData() now respects the Recursive parameter - -V6.2.2 (20 Jan 2016) - * Issue #603: If the node already has children, then its nodeheight is valid and we must not remove its total height, but rather its height - * Fixed issue #599: Possible infinite loop in GetPreviousVisibleNoInit() - * Added new method TBaseVirtualTree.InitRecursive() as workaround for issue #597: Initializes a node and optionally its children up to a certain level. - * Issue #598: SetData, like GetData no longer forces the "class" constraint on its generic parameter - * Fixed issue #596 by moving initialization of global variable Watcher also to InitializeGlobalStructures() - Now ensuring using interlocked function that InitializeGlobalStructures() is executed only once - * Fixed issue #458: If the Virtual TreeView control is placed on a control that has the StyleEx flag WS_EX_COMPOSITED set, horizontal scrolloing does not update the header - * Fixed issue #595: Before using SetTimer, check for valid WindowHandle - * Fixed issue #594: Basic TVirtualStringTree Colors does not apply - * Fixed issue #591: Now calling UnRegisterStyleHook() for the style class in "VirtualTrees.StyleHooks". - * Fixed #590: Allow to store InternalData also for (internal) root node - * if only one node is selected, make sure the focused node changes with the selected node - * Added assertion that ensures that BeginUpdate() is called from main thread only. - * Getter function GetCheckedCount() is protected now instead of public - -V6.2.1 (06 Nov 2015) - * #585: Checkboxes now have the correct size and scale properly on high dpi systems. - * #588: Fixed HTML clipboard export - * #586: TBaseVirtualTree.SetChildCount() no longer calls to ReInitNode(Node, True). This caused the OnInitChildren-Event to be fired twice. - * Adjusted GetNodeDataAt() and GetFirstSelectedNodeData() to work with interfaces. - * If multi selection is not allowed and so only one node can be selected, make sure the focused node changes with the selected node in SetSelected() - * Added packages for the C++Builder 10. - -V6.2 (09 Sep 2015) - * Issue #582: Added support and packages for RAD Studio 10 Seattle - * Issue #580: Added support for Delphi package manager Delphinus - * Fixed issue #571: Grid mode and extended selection leads to drawing inconsistencies - * Fixed issue #569 which includes a fix for AddChild(). - * Fixed issue #568: Integer overflow when reiniting nodes and using ivsFiltered - * Merged pull request #564 which includes a fix for ComputeNodeHeight() and single line nodes - * Merged pull request #563 which prevents an access violation when using custom check images in column headers - * Merged pull request #561 which makes VclStyleChanged() virtual - * Fixed issue #557: Using isFiltered in InitNode leads to integer overflows or bogus rendering - * Fixed issue #556: Variable height and more than 1 level results in incorrect RangeY - * Fixed issue #555: The OnChange event is not fired in case the selected node is deleted through DeleteChildren(). Although no the option toAlwaysSelectNode is set, the parent node was not selected afterwards. - * Fixed issue #553: painting failure with variable NodeHeight - * Fixed issue #551: Some overlay images were drawn ghosted like the main image, some not. - * TBaseVirtualTree.PrepareBitmaps() now fires the OnPrepareButtonImages event also in case VCL styles are used. - * Added implementation for TVirtualTreeAccessibility.accSelect() so that screen readers and especially UI testing tools can use MSAA to select specific elements in the control. - * Property OnColumnVisibilityChanged is now published. - * Now using type TImageIndex instead of integer for variables and parameters that store an image index. - -V6.1 (02 June 2015) - * Implemented Issue #530: Removed all AnsiString code from export routines. Breaking changes: - - TCustomVirtualStringTree.ContentToText() is now based on (Unicode)string and no longer on AnsiString. - - TCustomVirtualStringTree.ContentToUnicode() is now deprecated, use ContentToText() instead. - * Implemented issue #536: Add export event that is triggered for each cell - - Added new event OnGetCellText which has new TVSTGetCellTextEventArgs record as parameter. - This event could supersede the OnGetText event in a future version. - - All export formats now also export static text, in case the toShowStaticText flag is set - * Fixed issue #545: VCL Themes: Background of scrollbars is erased with wrong color - * Fixed issue #487: When OnAddToSelection is called, GetFirstSelected returns nil - * Fixed issue #542: AllocateInternalDataArea() was broken for derived classes - This was a result of issue #507. Now the user node data comes before the internal data. - Therefore it is important to use the function InternalData() to access the internal data of a node. - * Fixed issue #541: Duplicate call of EndEdit() - * Fixed issue #123: Triangle button is not shown for hot node - * Fixed issue #347: With VCL-Themes: No expand-pluses seen under Windows classic theme - * Fixed copy&paste error is source code related to issue #519 - -V6.0 (13 Apr 2015) - * Issue #509: Added new option hoAutoColumnPopupMenu to TVTHeaderOption. - * Issue #457: Virtual TreeView no longer react on standard actions for TEdit controls - We added standard actions for copy, cut, paste, delete, select all, check, uncheck in the new unit "VirtualTrees.Actions". - * Issue #484: ContentToHTML() no longer pre-encodes the HTML in UTF-8 but returns a Unicodestring - * Issue #507: Added to TBaseVirtualTree: - function GetNodeData(pNode: PVirtualNode): T; - function GetNodeDataAt(pXCoord: Integer; pYCoord: Integer): T; - function GetFirstSelectedNodeData(): T; overload; - function GetInterfaceFromNodeData(pNode: PVirtualNode): T; - procedure SetNodeData(pNode: PVirtualNode; pUserData: Pointer); - procedure SetNodeData(pNode: PVirtualNode; const pUserData: IInterface); - procedure SetNodeData(pNode: PVirtualNode; pUserData: T); - Similar functions have also been added to the TVirtualNode record. - * The grid demo of the "Advanced" project now uses a class instead of a record and the new generic functions from issue #502. - * Issue #519: Changed plus/minus buttons so that hot tracking of the buttons is always on, independent of toHotTrack. - * Issue #514: The splitter area in the column header should be configurable - * Issue #515: The value for Indent should get scaled too if the toAutoScale flag is set - * Issue #511: From the unit VirtualTres new units have been extracted to reduce its size. - * Issue #483 for TVTOperationKind.okExport: All exports can now be cancelled using CancelOperation() - * Issue #362: InternalConnectNode: AdjustTotalHeight not called if Node not FullyVisible - * Issue #506: Autosort is being triggered at design-time. - * Issue #486: AutoScroll is performed although toAutoScroll is not set. - * DoMeasureItem() now ensures that the node was initialized. - * Issue #493: Editing with DblClick should always open editor immediately. - * TVirtualTreeColumns.UpdatePositions() now exits immediately if the control is destroying, ths prevents AVs. - * Added support for CBuilder XE7. - * A larger patch from Diemtar Rösler was applied which addresses various issue regarding VCL styles (especially #478 and #491). - * Supporting only Delphi / C++ Builder XE3 and higher - * Improved support for C++ Builder - -V5.5.3: (08 Jan 2015) - * Fixed issue #495: Incorrect text vertical align when changing font in OnPaintText - * Fixed Issue #496: Access violation at VT destroy - * Fixed issue #498: Node totalheight not initialized properly when adding new node and using toVariableNodeHeight - -V5.5.2: (10 Nov 2014) - * Various improvements regarding code style - * Implemented #471: Add emVisibleDueToExpansion and emSelected to TVTExportMode - * Fixed issue #488: XE7 packages should depend on one another and use suffix 21 - * Fixed issue #462: Undo r636, make VirtualTreesD require VirtualTreesR again - * Fixed issue #489 XE2 compiler switch error - -V5.5.1: (13 Oct 2014) - * Fixed issue #479: The style hooks for the VCL styles are now registered for TVirtualStringTree and TVirtualDrawTree instead of TBaseVirtualTree, which makes it easier to use own style hooks in derived classes. - * Partial fix for issue #478: The standard VCL property StyleElemets (public in TControl in RAD Studio XE3 and higher) is now supported and published for TVirtualStringTree and TVirtualDrawTree (XE3 and higher). This means you can define if the font and the backgrounbd color is taken from the VCL style or the control's properties. Leaving out seBorder is not yet working well, more work will be necessary. - * Fixed issue #473: Return type of GetUtilityImages should be TCustomImageList - * Fix for issue #470: VCL Styles and sorting failure - * Added missing inherited to CMMouseEnter() - * Fixed issue #468: Redundant code in CreateSystemImageSet() - * Fixed issue #482: AutoScale() could cause exception during form load. - * Added fix for #466: No parent window if column created in constructor - * Fixed issue #446: ScrollIntoView does not work properly after applying patch from issue #339 - * Improvements for toAlwaysSelectNode option: Selection of next sibling has been improved in case the currently selected node is being removed. - * Added missing begin/end-block in MeasureItemHeight() - * Improved fix for issue #438: Now correctly initializing member of property TVTColors.UnfocusedColor - * Improved fix for issue #447: DoMeasureItem() was called for Node instead of Child. - * Minor improvement in appearance of border lines in HTML export. - * Fixed issue #480: Warning when compiling Delphi XE2 packages - * Fixed #472: Redundant conditions in TVclStyleScrollBarsHook.WMMouseMove - * Fixed #476: Simplify TVTDragImage.WillMove() - * Fixed issue #485: unit VirtualTrees does not compile with {$TYPEDADDRESS ON} - -V5.5: (11 Sep 2014) - * Added packages for RAD Studio XE7 / Delphi XE7 - * Fixed issue #464: Vertical grid lines not computed correctly for spanned cells with header auto resize - * Fixed issue #442: Scrollbars are not updated for active VCL Style under XE2 - * Fixed issue #463: HTML export shows grid lines in IE and Chrome, but not in Firefox - * Fixed issue #460: Access violation in design time when setting "CheckBox" to True for a Virtual Treeview Column - * Fixed issue #72: Call Application.CancelHint only if the current control is showing the hint - * Fixed issue #461: corrected condition in TBaseVirtualTree.ScrollIntoView, so that not only partially (by the fixed area) covered columns but also totally covered columns are scrolled in view - * Fixed issue #450: Regional letters entered using Right+Alt should also trigger the incremental search. - * Improvemtns for toAlwaysSelectNode: - Clicking the free space below the tree nodes no longer deselects the selected node. - We now prevent toggling of the selection of the last selected node if toAlwaysSelectNode is set in TreeOptions. - * Fixed issue #447: SetChildCount() now calls DoMeasureItem() instead of using DefaultNodeHeight. - * Fixed issue #444: ERangeError in TBaseVirtualTree.CMMouseWheel - * TBaseVirtualTree.MeasureItemHeight() is virtual now. - * Fixed issue #445 MultiSelect behavior: Can't drag node which is not selected - * Fixed Issue #443: TVirtualTreeColumns.ColumnFromPosition on right border of fixed column - * Fixed issue #339: Problems with fixed column - * Implemented #410: Small extension of TStringEditLink: Allow creating own edit control by moving the creation of TVTEdit from constructor to virtual PrepareEdit with assigned check. - * Implemented #409: Extend THitInfo record with hit coordinates - * Added suggestions of #438: Make some members visible to derived classes - * Fixed issue #440: Context menu does not pop up if there is no selected node - * Added C++ Builder link demand to VirtualTreesR.Lib as {$HPPEMIT} - * Improved installation instructions, especially for C++ Builder - -V5.4.1: (26 May 2014) - * Added packages for C++ Builder XE6 - * If toAutoChangeScale is set in AutoOptions, the Virtual TreeView control now - increases the DefaultNodeHeight if the font size is too large to fit. - * If toAutoChangeScale is set in AutoOptions, the columns widths are now adjusted too. - * Improved implementation for toRestoreSelection option - * Fixed possible AV in PaintNodeButton() - * Now ensuring that both GetHorzScrollBarSliderRect() and - GetVertScrollBarSliderRect() return a valid value for every code path (Thx to - Dmitri Dmitrienko). This could cause strange out of resources exceptions with VCL - styles enabled. - * Fixed issue #434: Application compiled with Delphi 7 stops responding when you call AddChild - * A few minor changes - -V5.4.0: (22 Apr 2014) - * Added support for XE6. - * Added new option toRestoreSelection to TVTSelectionOptions: Set to true if upon refill the previously - elected nodes should be selected again. The nodes will be identified by its caption only. - * Added new option toAlwaysSelectNode to TVTSelectionOption enum. If this flag is set, the treeview tries to - lways have a node selected. This behavior is closer to the Windows TreeView and useful in Windows Explorer - tyle applications. It is also useful for accessible applications which can indicate having the focus by - isplaying a selection. - * Added function TBaseVirtualTree.IsEmpty which returns True if the control has no nodes. - * Fixed a wrongly drawn selection after the user scrolled horizontally. - * Fixed issue #423: Change property TVirtualTreeColumn.Tag to NativeInt. - * Implemented #415: Added feature for design time column header dragging and resizing. (Thx to fr0st.brutal) - * Fixed issue #180: Memory leak in grid demo of Advanced project - * Implemented #422: Added TBaseVirtualTree.GetFirstChildNoInit() - * Fixed issue #420: Add coEditable to TVTColumnOption) by applying the supplied path. Thx to Stefan Glienke. - * Fixed issue #419: Some issues with changing to edit mode with clicking - * Fixed issue #430: TVTDragManager memory leak with visual inheritance. Thx to Andreas Hausladen for the patch. - * Fixed issue #431: Visual bug when using TStringEditLink with large node heights - * TVclStyleScrollBarsHook.WMMouseMove(): Now preventing possible range check error exception. - * Now handling WM_MOVE and WM_POSCHNAGED correctly in TVclStyleScrollBarsHook (Thx to Dmitri Dmitrienko) - * Preventing possible stack overflow in TVirtualTreeHintWindow.ActivateHint (Thx to Dmitri Dmitrienko) - * Added packages for C++ Builder XE5. - * Some minor changes, improvements and fixes have been incorporated - -V5.3.0: (04 Jan 2014) - * Fix for issue #159 (Cursor missing in edit with non-standard DPI): Ensuring a minimum size of the edit control - * Fixed issue #403: Declare TVTGetNodeProc as reference to procedure (for D2009+) - * Fixed issue #402: TVTEdit.CNCommand discard all notification except EN_UPDATE due to missing inherited - * Corrected fix for issue #376 (Incorrect selection paint when toGridExtensions is included in the MiscOptions) - * Fixed issue #401: OnNodeClick event doesn't trigger in some case, coFixed set for a column - * Modified #316 (concerning r498). The fix for #316 will only be applied in case toMultiSelect is set. - If toMultiSelect is not set we can start a drag anywhere in the row. - * ContentToHTML() and ContentToRTF() now return a string of type RawByteString. - Because the generated strings are pre-encoded in UTF-8, the previous type AnsiString caused - problems in Delphi 2009+ e.g. when this string was written using the VCL TStreamWriter class. - The helper class TBufferedAnsiString therefore uses RywByteString now as type too. - * Fixed issue #399: EditDelay not working - * Fixed issue #400: AltGr+A does not behave as expected for foreign keyboard layouts in VTEdit - * Fixed issue #388: VirtualStringTree with toFixedIndent causes range check error - * Edit box when editing a node in a tree with toFixedIndent now has the correct indent - * Fixed issue #392: Now ensuring that MeasureItemHeight() is only called from the main thread. - * Fixed #383: Clear vsHasChildren for a node without children even if the children count didn't change. - * Fixed #377: Wrong font (size, etc) in TargetCanvas in MeasureItem for first node - * Fixed issue #398 (hoAutoResize causes DFM designer to be modified after loading) by calling TControl.Updating()/Updated() in AdjustAutoSize() - * Preventing possible AV in TBaseVirtualTree.FontChanged() - * Fixed 32Bit Integer overflows in Win64 build in TBufferedAnsiString. - -V5.2.2: (30 Oct 2013) -- Added support for Delphi / RAD Studio XE5 -- Fixed issue #371: property OnGesture is now published. -- Fixed issue #365: No longer changing timer resolution globally -- Fixed issue #347: No expand-pluses seen under Windopws classic theme for a vcl styled application -- Fixed issue #373: Scrollbar does not size properly for more than 2000 nodes with variable node height: - The OnMeasureItem event is triggered only in case the toVariableNode flags in included in MiscOptions -- Fixed issue #376: Incorrect selection paint when toGridExtensions is included in the MiscOptions -- Improved displaying of EmptyListMessage text, especially when scrolling horizontally. -- Fixed issue #61: EditCursor missing with manifest + toThemeAware + vsMultiline -- Fixed issue #352: Minor improvement in calculation of right margin of hint window. - -V5.2.1: (06 Sep 2013) -- Fixed #352 and #354 by modifying the implementation of #237 so that a focused node is ensured only if the - control is being entered using the TAB key. This is consistent with the behavior of the Windows Explorer. -- Fixed issue #360 (In the calculation of the horizontal scroll bar static text should be considered) by - calling DoGetNodeExtraWidth() in TBaseVirtualTree.GetMaxRightExtend() -- Used fix proposed in issue #361 to fix issue #357 (AV in advanced demo - PropertiesDemo form in XE3+) -- Removed call to TCustomStyleEngine.UnRegisterStyleHook() to fix issue #359/#355 -- Fixed issue #358: Horizontal Scrollbar issue when expand ing and scrollbars get visible -- Fixed issue #355/#345: exception regarding style services - -V5.2: (09 Aug 2013) -- OnMouseEnter and OnMouseLeave events have been added (#238) -- Improved dpi scaling for VirtualTreeView and Header -- toAutoChangeScale and toAutoSort are now among the defualt values for TCustomVirtualTreeOptions.AutoOptions -- Fixed issue #237: Auto focus the first node on enter if there is no focused node -- Fixed issue #344: Cannot select row by Ctrl+Click on empty column -- Fixed issue #206: Column painting issue with coWrapCaption in Options -- Fixed issue #128: OleUninitialize in FinalizeGlobalStructures can hang when using Virtual Treeview in a DLL -- Added new public property LastDragEffect which supplies the last executed drag effect. -- Added virtual method GetNodeImageSize() which can be overridden if one needs different sized images. -- Added new public property LastDragEffect which supplies the last executed drag effect. -- Fixed issue #206: Column painting issue with coWrapCaption in Options -- Fixed issue #336 by ignoring PARENTDOUBLEBUFFEREDCHANGED message. -- Fixed issue #342 by adding a new implementation of the VCL's DoubleBuffered property. - The inherited DoubleBuffered property of TWinControl must not be set to True! -- A few minor improvements have been added. - -V5.1.3: (17 Apr 2013) -- Fixed #340: GetHitTestInfoAt on right border of fixed column. -- Fixed #337: Cannot "grab" item for dragging, odd behaviour of multi selecting with the selection - rectangle when toFullRowSelect is True but toSimpleDrawSelection is False. (thx to Stefan Glienke) -- Fixed #341: Error when unloading DLL due to missing UnRegisterStyleHook -- Improved fix for #323: The fix applied in V5.1.2 was a breaking change for some projects, especially - if not all the initialization was done in the OnInitNode event (reported as #338). vsInitialUserData - has been renamed to vsOnFreeNodeCallRequired and is now set when GetNodeData is called. This fixes - the possible memory leak reported in #323 and has better backward compatibility. -- Fixed #316: These fixes are to make the treeview behave more like the windows explorer regarding - selecting and dragging. Thanks to Stefan Glienke. -- Fixed #333: Possible Integer overflow in 64Bit builds. -- Compatibility with / packages for Delphi Xe$ / RAD Studio XE4 have been added. - -V5.1.2 (04 Apr 2013): - - Added function TVirtualTreeColumns.GetFirstColumn that returns the first column in display order. - - Fixed issue #322: CaptionAlignment is not being restored by Header.LoadFromStream(). - - TBaseVirtualTree.GetNodeData() now calls InitNode() if the node had not beend initialized. - This fixes issue #323 (Memory leak when the Node has children ) - - Fixed issue #326: Application hangs when aborting OLE Copy/Paste Operation - - Added new option poResizeToFitItem to TVTHeaderPopupOption: Adds an item which, if clicked, - resizes all columns to fit by calling TVTHeader.AutoFitColumns() - - Property RangeX is now public in the class TVirtualStringTree (#327) - - TVirtualTreeColumns.HandleClick(): No longer triggering auto sort if just the checkbox in the header was clicked - - TBaseVirtualTree.SetCheckType new resets PVirtualNode.CheckState only if the check state does not fit the new check type - - Fixed issue #321: Delphi2009: undeclared identifier: 'fState' in VirtualTrees.pas:DrawDisabledImage() - - Fixed issue #315: hoHeaderClickAutoSort was only working if toAutoSort is also set - -V5.1.1 (07 Feb 2013): - - Fixed issue #313: Translucent selection rectangle completely broken when PaintBackground is used - - Fixed issue #314: Only if toAutoSort is True non-expanded nodes will be excluded from sorting. - This restores the behavior of V5.0.X. - - Fixed issue #306: Drag image was broken except for CF_HDROP - - Fixed issue #305: Broken hint drawing with classic windows theme and toUseExplorerTheme - - Fixed issue #298: Bad canvas parameters in OnBeforeCellPaint method - - If NodeDataSize has its default value -1, now sizeof(Pointer) is used at runtime as actual value. - This makes it easier to store a simple Pointer with each node indepedent of the target platform (32/64Bit). - - Fixed issue #300: Made the hint text more centered in the hint window - - If TVirtualTreeColumn.CheckBox is set to True in Designer, then hoShowImages is now added to Header.Options - - Fixed issue #302: AV when painting sorted header column containing checkbox - - Now soring subnodes when they get expanded and the toAutoSort flag is set - - Added fix for ugly drawn disabled images (thx to S. Glienke). See also: - http://stackoverflow.com/questions/6003018/make-disabled-menu-and-toolbar-images-look-better - http://qc.embarcadero.com/wc/qcmain.aspx?d=86879 - - Fixed issue #299: Draw themed focus rectangle with toUseExplorerTheme - - Fixed issue #198: Wrong check images - - Removed file VTConfig.inc. The former $ifdef ReverseFullExpandHotKey is now a flag in the - TVTMiscOption enumeration. The $ifdef TntSupport can be defined at the beginning of the unit VirtualTrees. - - Added new optional parameter "Recursive" to TBaseVirtualTree.Sort() - -V5.1.0 (05 Nov 2012): - - Fixed issue #291: Empty hint strings are shown when using custom hint window classes - - Added support for VCl styles of RAD Studio XE2 and higher. (Thanks to Dietmar Rösler, issue #288) - - Fixed issue #285: access violation when mouse down over checkbox sometimes - - Fixed issue #293: OnAdvancedHeaderDraw is called with wrong PaintInfo.PaintRectangle - - Improved creation of IDragSourceHelper and added support for IDragSourceHelper2 - - Fixed problem with drawing selection rectangle after canceled rename - - Improved creation of IDragSourceHelper and added support for IDragSourceHelper2 - - Fixed issue regarding activating explorer theme - - Fixed issue #222: FDottedBrush is never released in the tree is never shown - - Fixed issue #52: Misalignement of CheckBox and TreeLine/Buttons - - Fixed issue #43: VT stop repaint after Windows visual style change - - Fixed issue #66: column auto-resize makes not aware of StaticText - - Fixed issue #53: Misalignment Images Columns > 0 - - Fixed issue #176: Multiline Aligment Problem - - Fixed issue #283: VTV no longer allows to drop above or below when using Full row selection - - Fixed issue #173: Two suggestions about class member visibilities - - Fixed issue #192: Fixed column painting bug when OffsetX > 0 - - Fixed Delphi 2007 Designer package - -V5.0.1 (06 Sep 2012): - - Added Support for RAD Studio XE3 - - Fixed definition of event OnAfterHeaderExport, it used the same member variable as OnBeforeHeaderExport. - - Fixed problem with Delphi 2007 package - - Delphi 2009 and 2010 packages are also implicit build packages now, like those for XE and XE2 (issue #279) - - Fixed #251: Added supoort for C++ Builder XE2 - - Fixed #274: Wrong stop condition in TBaseVirtualTree.GetLastVisible - - Fixed runtime package of Delphi 7 - - Fixed issue #273: Incremental search for international symbols not working in Delphi 2009-XE2 - - A few minor bug fixes have been incorporated - -July 03, 2012 - - Release of V5.0.0 final -June 11-30, 2012 - - Release of V5.0.0 RC2 - - Removed dependecy on file Compilers.inc - - Removed dependency on file MSAAIntf.pas - - Removed folder Common - - Fixed issue #252: Incorrect width of edit control rectangle when grid extensions are set - - Fixed issue #259: Hit position wrong when Indent is not default - - Fixed issue #253: Compatibility issues with XE2's VCL style checkboxes - - Fixed issue #265: Lib suffix not set for all configurations in Delphi XE2 package - - Bug fix: Functions GetLastVisible and GetLastVisibleNoInit return correct results even if some anchestor of the last visible node is not effectively visible - - Improvement: Added functions GetNextSiblingNoInit and GetPreviousSiblingNoInit - - "Res" folder of Advanced sample was not included in ZIP archive - - Added folder "Contributions" to release -June 01-10, 2012 - - Release of V5.0.0 RC1 - - Updated help file for V5.0 -April 2012 - - Added support for theming of hint window (thanks to Arno Garrels and Uwe Schuster) - - TBaseVirtualTree.CheckParentCheckState: Fixed duplicate recursion to parent nodes -March 2012 - - Fixed painting of Windows7/Vista style Explorer selection in case tsUseExplorerTheme is in TreeOptions - - Ctrl + A now selects all items -January 2012 - - Bug fix: Fixed a potential access violation in TBaseVirtualTree.FullCollapse in case of toChildrenAbove -December 2011 - - Fixed compiler warning in RAD Studio XE2 regarding deprecated ThemeServices -September 2011 - - The property EmptyListMessage may now contain linebreaks in Delphi 2009 and higher, the text in now printed in dark gray. - - Support for flat scroll bars has been removed. - - Global variables InWin2k and IsWinXP, enum member hsXPStyle, function DrawXPButton() and support for Windows 2000 has been removed. - - Global variable IsWinNT and support for Windows 9x has been removed. - - Improvement: Added support for Delphi XE2 and 64Bit compiler. - - Support for Delphi 5/6 and C++ Builder 5/6 has been dropped. - - Bug fix: Fixed a potential integer overflow in TBaseVirtualTree.ToggleNode in case of toChildrenAbove and NodeInView - - Bug fix: Fixed a potential Assertion in TBaseVirtualTree.ToggleNode by checking GetFirstVisible before calling GetDisplayRect - - Bug fix: TCustomVirtualTreeOptions.SetPaintOptions correctly changes the VisibleCount when toShowFilteredNodes is toggled - - Improvement: Added new functions TBaseVirtualTree.DetermineDropMode - - Improvement: Added usage of TBaseVirtualTree.DetermineDropMode in TBaseVirtualTree.DragOver - - Improvement: Made EffectiveOffsetX accessible via read-only protected property for easier subclassing - - Improvement: Moved TBaseVirtualTree.DetermineLineImageAndSelectLevel from private to protected for easier subclassing - - Improvement: Sorted TBaseVirtualTree.SetEmptyListMessage -August 2011 - - Improvement: Minor code improvements -April 2011 - - Bug fix: Reverted change of November 2010 (Creating the WorkerThread will no longer change System.IsMultiThread) - it caused sporadic AVs during app start which disappeared after revering the change. This code can lead to a wrong value - of System.IsMultiThread which causes the memory manager to assume a single threaded application. - - Bug fix: When advancing to the next item while in edit mode, we are now also calling CanEdit(). -February 2011 - - Bug fix: In case the LastStructureChangeNode is deleted before the StructureChange event is fired, - the reference to the LastStructureChangeNode is cleared to avoid providing an invalid node -January 2011 - - Improvement: RTF export now uses landscape paper format and smaller margins, so that more of the contents - fits on the page - - Improvement: New Option hoHeaderClickAutoSort for TVTHeader.Options: Clicks on the header will make the - clicked column the SortColumn or toggle sort direction if it already was the sort column - - Improvement: Pressing the tab key in edit mode advances to the next node in edit node, just like the - Windows 7 Explorer does it. - - Bug fix: No longer auto-scrolling horizontally when the focused node changes if toFullRowSelect is turned on. - - Bug fix: Fixed a clipping issue when drawing unbuffered -December 2010 - - Improvement: TBaseVirtualTree.HandleMouseUp now checks CanEdit just in case toEditOnClick - - Bug fix: TotalNodeHeights are now correctly adjusted when toggling toShowHiddenNodes - - Bug fix: Fixed BCB compiler error due to re-defining IDropTargetHelper - - Improvement: New TVTInternalPaintOption poUnbuffered to directly paint onto a given canvas (especially useful - when printing and/or scaling via world transformations) - - Improvement: Refactored header painting to be more flexible (e.g. for printing) - - Improvement: Made additional fields accessible via protected read-only properties for easier subclassing -November 2010 - - Improvement: All calls to SetWindowOrgEx now respect the canvas' transformation - - Improvement: TBaseVirtualTree.GetNodeHeight will no longer measure the node height, if the node is about - to be deleted - - Improvement: Made TBaseVirtualTree.FRangeX and FRangeY accessible via read-only protected property - - Improvement: Unified clipping handling - - Improvement: Added new color setting "SelectionTextColor" - - Improvement: Creating the WorkerThread will no longer change System.IsMultiThread - - Bug fix: Fixed a potential integer overflow in TBaseVirtualTree.ToggleNode - - Bug fix: TBaseVirtualTree.ToggleNode now measures the child node heights before summing them - - Improvement: Made some private field of TVTHeader and TVirtualTreeColumns protected to make writing - derived classes easier - - Improvement: Enclosed call to DoDragDrop in TBaseVirtualTree.CMDrag in a try..finally block - - Improvement: The default inplace editor now resizes itself even when the tree is in grid mode - - Bug fix: TBaseVirtualTree.PrepareBitmaps now checks the existance of the main column correctly - - Bug fix: TBaseVirtualTree.UpdateEditBounds now checks wether the focused node is assigned - - Improvement: TBaseVirtualTree.FHintData is now available to derived classes via the protected property HintData -October 2010 - - Bug fix: Now taking horizontal scroll position into account when drawing text of EmptyListMessage property - - Bug fix: Prevented potential "index out of bounds" exception in TVirtualTreeHintWindow.CalcHintRect - - Bug fix - Issue #187: Showing a dialog in OnChange or OnRemoveSelection event handlers can cause the VT to - enter mode for drawing selection rectangle. - - Improvement: Made inherited event OnCanResize published for TVirtualStringTree for Delphi 2010 and later - - Improvement: TBaseVirtualTree.ToggleNode now tries to keep the visual position of the toggled node, - even when toChildrenAbove is set -September 2010 - - Improvement: Added additional check regarding the tree reference to TVirtualTreeHintWindow.AnimationCallback - - Improvement: Made TBaseVirtualTree.AdjustImageBorder protected and virtual - - Improvement: TVirtualTreeColumns now observes if the focused column is removed - - Improvement: Made compatible with Delphi XE (Thanks to Roman Kassebaum) -August 2010 - - Improvement: TCustomVirtualStringTree.DoTextMeasuring now returns TSize - - Improvement: Renamed TVTMeasureTextWidthEvent to TVTMeasureTextEvent and introduced new - event TCustomVirtualStringTree.OnMeasureTextHeight - - Improvement: Made TBaseVirtualTree.GetMaxColumnWidth virtual - - Bug fix: TBaseVirtualTree.OnRemoveFromSelection is now triggered by TBaseVirtualTree.RemoveFromSelection - as intended -July 2010 - - Bug fix: Toggling toShowFilteredNodes will now update the node counts in the tree even if its handle has not - been allocated so far - - Bug fix: TBaseVirtualTree.FindNodeInSelection should now work correctly with nodes above the 2gb boundary - - Bug fix: Nodes that are about to be deleted are now removed from TBaseVirtualTree.FDragSelection - - Bug fix: Changed TBaseVirtualTree.WMKeyDown to correctly handle special keys in Unicode based Delphi versions - - Bug fix: Changed declaration of TBaseVirtualTree.EmptyListMessage to UnicodeString - - Improvement: Added new property TBaseVirtualTree.EmptyListMessage. If this property is not empty, the assigned - text will be displayed if there are no nodes to display, similar to the Windows XP file search. - - Improvement: Added tstChecked to TVSTTextSourceType enumeration and support for the new flag to - GetRenderStartValues(). So you can export only checked nodes. -June 2010 - - Bug fix: range select with no nodes will no longer result in an access violation - - Bug fix: TBaseVirtualTree.SetVisible now correctly decrements the visible node count - - Bug fix: TStringEditLink.BeginEdit now calls AutoAdjustSize to ensure a consistent size of the edit field - - Improvement: TVTHeader.AutoFitColumns is now declared virtual - - Bug fix: header captions were badly positioned text if Extra Large fonts have been activated in the Windows - display options -May 2010 - - Improvement: TBaseVirtualTree.PaintTree is now declared virtual - - Bug fix: corrected calculations regarding tree height and visible count when using filtered nodes -April 2010 - - Bug fix: Changed TBaseVirtualTree.SetChildCount and TBaseVirtualTree.InitNode to correctly handle filtered nodes - - Bug fix: Ctrl+Click on a node often cause a delayed update of the displayed selection due to a missing (or - misplaced) call to Invalidate() in HandleClickSelection(). - - Bug fix: Shift+PgUp and Shift+PgDown now behave like a usual List(View) and select the node of the previous/ - next page. The behaviourly that was formerly assigned to these shortcuts is now triggeres when using - Shift+Alt+PgUp / Shift+Alt+PgDown -March 2010 - - Bug fix: TBaseVirtualTree.CMMouseLeave now checks if the header is assigned before working with it - - Bug fix: TCustomVirtualTreeOptions.SetPaintOptions will now invalidate the node cache if toChildrenAbove is - changed - - Bug fix: TBaseVirtualTree.HandleMouseUp will no longer cause an AV if HitInfo.HitNode is not assigned and - tsToggleFocusedSelection is set - - Improvement: new properties TBaseVirtualTree.OnAddToSelection and TBaseVirtualTree.OnRemoveFromSelection - - Bug fix: fixed a whole bunch of painting issues regarding drag & drop - - Bug fix: fixed TBaseVirtualTree.DragFinished to generate a button up event in case of using OLE drag & drop - - Bug fix: TBaseVirtualTree.DeleteChildren no longer fails if the given node is nil -January 2010 - - Bug fix: Removed defaults from TVirtualTreeColumn.BiDiMode and TVirtualTreeColumn.Color - - Bug fix: Clearing the columns while editing no longer raises an exception - - Improvement: refactored handling of long running operations - - Bug fix: TBaseVirtualTree.OnGetHelpContext now delivers the currently focused column instead of always 0 - - Improvement: the sort operation can now be canceled - - Improvement: all BeginOperation/EndOperation pairs are now enclosed in try..finally blocks - - Bug fix: the combination of toUseExplorerTheme and toFullRowSelect now also works correct when no columns are - defined -December 2009 - - Bug fix: TVTHeader.HandleMessage now correctly handles double click autosizing when the index differs from - its position -November 2009 - - Bug fix: TBaseVirtualTree.AdjustTotalHeight didn't change the height of invisible nodes which caused some trouble - when making those nodes visible again - - Improvement: a column is no longer painted 'down' if its check box was clicked - - Bug fix: one can no longer toggle the check state of a column with the right mouse button - - Bug fix: one can no longer toggle the check state of a node with the right mouse button - - Bug fix: TCustomVirtualTreeOptions.SetPaintOptions no longer accidentally removed the the explorer theme - - Bug fix: Fixed a potential Integer overflow in TBaseVirtualTree.CalculateVerticalAlignments -October 2009 - - Bug fix: enabling checkbox support for a column is now possible without assigning a dummy imagelist - - Bug fix: checkboxes in the header are now correctly aligned - - Improvement: changed TBaseVirtualTree.PaintCheckImage to be usable by TVirtualTreeColumns.PaintHeader to be - able to paint themed header checkboxes - - Bug fix: TBaseVirtualTree.GetCheckImage now correctly handles cases when Node is nil and ImgCheckType is either - ctTriStateCheckBox or ctNone - - Bug fix: TBaseVirtualTree.HasImage now implicitly initializes the given node if needed to avoid requesting the - imageindex for nodes that are not initialized - - Bug fix: fixed possible AV when setting toExplorerTheme with no columns defined - - Improvement: new events TBaseVirtualTree.OnSaveTree and TBaseVirtualTree.OnLoadTree -September 2009 - - Bug fix: TBaseVirtualTree.OnColumnClick will no longer be triggered twice - - Improvement: new TVirtualNodeInitState ivsReInit to indicate that a node is about to be re-initialized - - Bug fix: TCustomVirtualStringTree.DoTextMeasuring now makes use of the parameter Width of the - OnMeasureTextWidth event - - Bug fix: TBaseVirtualTree.DetermineLineImageAndSelectLevel will no longer access LineImage[-1] - - Bug fix: clearing the columns now correctly reset TBaseVirtualTree.FFocusedColumn - - Improvement: explorer style painting is now more close to the real explorer - - Bug fix: TCustomVirtualStringTree.TContentToHTML.WriteStyle will no longer produce invalid CSS - - Bug fix: the parameter DragEffect of TBaseVirtualTree.DragAndDrop is now var as it should be -August 2009 - - Bug fix: TBaseVirtualTree.MoveTo now initializes the target node using the target tree - - Bug fix: TBaseVirtualTree.FVisibleCount is now calculated correctly when using filtered nodes - - Improvement: introduced new initial node state ivsFiltered -July 2009 - - Improvement: modified TVTHeader.HandleHeaderMouseMove to make resizing the autosize column with the - mouse possible - - Improvement: modified TBaseVirtualTree.DoCreateEditor so that applications can now return NIL in OnCreateEditor - to use the standard editor of the tree - - Bug fix: pressing CTRL + PgUp/PgDown no longer leads to an index-out-of-bounds exception if no columns are used - - Bug fix: avoided race condition between TBaseVirtualTree.DeleteNode and the worker thread - - Bug fix: TBaseVirtualTree.ToggleNode could produce an overflow if range checking was enabled - - Bug fix: TWorkerThread will no longer reference the tree after it has been destroyed (Mantis issue #384) - - Improvement: removed support for Delphi versions older than Delphi 7 - - Improvement: removed local memory manager -June 2009 - - Bug fix: TBaseVirtualTree.InternalConnectNode checked the expanded state of the wrong node if Mode was - amAddChildFirst or amAddChildLast - - Improvement: 'hidden nodes' are now called 'filtered nodes' - - Improvement: converted line endings back to CR/LF - - Improvement: new events TBaseVirtualTree.OnCanSplitterResizeNode and TBaseVirtualTree.OnCanSplitterResizeHeader - - Improvement: made TVirtualTreeColumns.DoCanSplitterResize virtual - - Improvement: made some methods of TVirtualTreeHintWindow protected to make subclassing easier - - Bug fix: fixed some issues concerning the vista theme handling - - Improvement: unified source code indentation -May 2009 - - Improvement: new TVTMiscOption toEditOnClick, toEditOnDblClick to control if editing can be started with a single - click or a double click - - Bug fix: the internal pointers of TBufferedAnsiString are now PAnsiChar to work correctly with Delphi 2009 -April 2009 - - Bug fix: TBaseVirtualTree.GetVisibleParent no longer returns the given node in case it is fully visible - - Improvement: fixed a potential issue in TVirtualTreeColumns.TotalWidth in case it is called before - FPositionToIndex is initialized - - Bug fix: TBaseVirtualTree.CollectSelectedNodesLTR and TBaseVirtualTree.CollectSelectedNodesRTL handle straight - vertical selection rectangles no longer as empty - - Bug fix: TCheckImageKind.ckSystemDefault now works as intended - - Improvement: made the following methods of TBaseVirtualTree virtual: PrepareCell, AddChild, BeginUpdate, - EndUpdate and SortTree - - Improvement: made TBaseVirtualTree.PrepareCell protected - - Improvement: moved some members of TVTEdit and TStringEditLink from private to protected - - Improvement: re-designed header click handling - - Improvement: new TVTPaintOption toShowHiddenNodes to globally ignore the hidden state of nodes - - Improvement: individual nodes can now be hidden without affecting their children - - Improvement: re-designed Explorer theme drawing - - Bug fix: corrected allocation problems in TBufferedAnsiString and TWideBufferedString -March 2009 - - Bug fix: fixed an issue in TVirtualTreeColumns.HandleClick that could lead to a case where no header click event - is triggered - - Bug fix: fixed an issue in TBaseVirtualTree.HandleHotTrack that could lead to an endless loop under certain - conditions - - Improvement: removed unused variables in TVirtualTreeColumn.ComputeHeaderLayout - - Bug fix: corrected TBaseVirtualTree.GetVisibleParent - - Improvement: extended hot node tracking to track the hot column too - - Improvement: new THitPosition hiOnItemButtonExact used to draw hot buttons when using Windows Vista's Explorer - theme - - Improvement: new TVTPaintOption toHideTreeLinesIfThemed to consider toShowTreeLines only if running unthemed - - Improvement: new TVTPaintOption toUseExplorerTheme to draw the tree like Windows Vista's Explorer treeview -February 2009 - - Bug fix: reverted the implementation of DrawTextW back to the one prior to 4.8.1 as the line end detection - lead to a compiler warning under Delphi 2009 - - Bug fix: corrected implementation of GetStringDrawRect to match its declaration (UnicodeString vs WideString) - - Bug fix: the node focus will no longer change if a TVTMiscOption.toGridExtensions is set and one clicks right of - (or left of, if right-to-left reading) the last column - - Bug fix: fixed an issue with TVTHeader.Assign that could lead to an access violation if the header is created at - runtime - - Bug fix: one can no longer change a node's height with the right mouse button even if toNodeHeightResize and - toRightClickSelect are set - - Improvement: TVTAutoOption.toDisableAutoScrollOnFocus now works for nodes too - - Improvement: new property TBaseVirtualTree.SelectionLocked to disable changing the selection - - Improvement: made the dual-scroll effect in TBaseVirtualTree.ToggleNode much smoother - - Bug fix: removed off-by-1 errors in TBaseVirtualTree.ToggleNode - - Bug fix: added a check for FUpdateCount to TBaseVirtualTree.SetUpdateState as otherwise every call to - TBaseVirtualTree.DoBeforeCellPaint to get the cell content margin within an Begin/EndUpdate-block would - re-enable painting - - Bug fix: TVTHeader.HandleMessage could provide a wrong column index to OnBeforeColumnWidthTracking in some cases - - Improvement: new properties TBaseVirtualTree.OnBeforeAutoFitColumn, TBaseVirtualTree.OnAfterAutoFitColumn - - Improvement: new procedures TBaseVirtualTree.CancelOperation, TBaseVirtualTree.BeginOperation, - TBaseVirtualTree.EndOperation and new property TBaseVirtualTree.OperationCanceled to enable the - application to stop (possibly) long-running operations - - Improvement: integrated changes from Andreas Hausladen - - Improvement: integrated changes from Dmitry Zegebart where applicable - - Bug fix: removed off-by-1 error in TBaseVirtualTree.GetDisplayRect - - Bug fix: changed the size of the buffer used in TBaseVirtualTree.PaintTree to paint the area below the last node - as the bitmap was not completely erased using previous size under certain conditions - - Bug fix: fixed TBaseVirtualTree.GetPreviousLevel -January 2009 - - Bug fix: removed off-by-1 error in TBaseVirtualTree.GetBottomNode - - Improvement: improved speed of TBaseVirtualTree.GetMaxColumnWidth when using UseSmartColumnWidth - - Version is now 4.8.0 -December 2008 - - Bug fix: modified TBaseVirtualTree.UpdateHorizontalScrollbar and TBaseVirtualTree.UpdateVerticalScrollbar to - recalculate the tree's dimensions even if an update is in progress - - Improvement: renamed TVTHeaderState hsTracking and hsTrackPending to hsColumnWidthTracking and - hsColumnWidthTrackPending - - Improvement: modified TBaseVirtualTree.GetFirstVisible and TBaseVirtualTree.GetFirstVisibleNoInit to optionally - take a node to specify where to start - - Improvement: modified TVTAfterGetMaxColumnWidthEvent to make the result of TBaseVirtualTree.GetMaxColumnWidth - changable - - Bug fix: corrected TBaseVirtualTree.GetMaxColumnWidth to consider toFixedIndent and no longer take nodes into - account that are just above or below the visible area - - Improvement: new property TVirtualTreeColumns.DefaultWidth - - Improvement: new property TVTHeader.FixedAreaConstraints (new class TVTFixedAreaConstraints) to limit the - fixed area (header, fixed columns) to a percentage of the client area -November 2008 - - Improvement: new cursor added: crVertSplit used for height tracking - - Improvement: changed type of TVTHeader.Height from Cardinal to Integer to make boundary checks easier - - Improvement: new properties TVTHeader.MinHeight and TVTHeader.MaxHeight - - Improvement: new VirtualTreeStates tsNodeHeightTracking and tsNodeHeightTrackPending - - Improvement: new HeaderStates hsHeightTracking and hsHeightTrackPending - - Improvement: new TVTMiscOption toNodeHeightResize to allow changing node heights via mouse - - Improvement: new TVTHeaderOption hoHeightResize to allow changing header height via mouse - - Improvement: new properties TBaseVirtualTree.OnHeaderHeightTracking, TBaseVirtualTree.OnHeaderDblClickResize, - TBaseVirtualTree.OnColumnWidthTracking, TBaseVirtualTree.OnColumnWidthDblClickResize, - TBaseVirtualTree.OnNodeHeightTracking, TBaseVirtualTree.OnNodeHeightDblClickResize - - Improvement: new function TVTHeader.ResizeColumns to resize multiple columns at once - - Improvement: TVTHeader.DetermineSplitterIndex is no longer influenced by non-resizable columns - - Bug fix: TBaseVirtualTree.ToggleNode now uses DoStateChange to modify FStates - - Bug fix: TBaseVirtualTree.DoBeforeCellPaint now saves the update rect if CellPaintMode is cpmGetContentMargin - and restores it afterwards - - Improvement: modified TBaseVirtualTree.CmMouseWheel to handle mice with wheel delta < 120 correctly - - Improvement: modified TVTHeader.LoadFromStream and WriteToStream to save ParentFont - - Improvement: TVTHeader.Font is now only stored by Delphi if ParentFont is False (Mantis issue #217) - - Bug fix: corrected TVTHeader.Create to set TVTHeader.FOptions correctly to the default value (Mantis issue #333) - - Improvement: new TVTAnimationOption toAdvancedAnimatedToggle to scroll the node to be toggled animatedly instead - of just scroll its child nodes animatedly - - Improvement: added VirtualTreeState tsToggling to eliminate artefacts caused by TBaseVirtualTree.DoSetOffsetXY - while toggling - - Bug fix: corrected button handling when toFixedIndent is set - - Improvement: redesigned TBaseVirtualTree.ToggleNode to harmonize the visual toggle behaviour independent of - toChildrenAbove - - Improvement: made TBaseVirtualTree.CanEdit public - - Improvement: added parameter ConsiderChildrenAbove to TGetNextNodeProc - - Improvement: modified all variants of TBaseVirtualTree.GetFirst and TBaseVirtualTree.GetLast to optionally - consider toChildrenAbove -October 2008 - - Bug fix: removed 'FVisibleCount := 0' from TBaseVirtualTree.Clear as this would lead to incorrect VisibleCount in - read-only mode - - Bug fix: fixed a condition in TBaseVirtualTree.ToggleCallback that could lead to artefacts - - Improvement: changed the implementation of TBaseVirtualTree.GetNext/GetPrevious so that no penalties occur if - toChildrenAbove is not set - - Improvement: TBaseVirtualTree.ToggleNode will no longer leave nodes with state vsToggeling if an exception - occurs - - Improvement: improved behaviour of TBaseVirtualTree.ToggleNode in case toChildrenAbove is set - - Bug fix: corrected TBaseVirtualTree.ScrollIntoView to behave as expected when no fixed columns exist - - Bug fix: extended TBaseVirtualTree.InitializeLineImageAndSelectLevel to eliminate artifacts while scrolling with - toChildrenAbove set - - Bug fix: corrected CompareNodePositions to consider toChildrenAbove - - Bug fix: corrected ToggleNode to scroll correctly if toChildrenAbove and toAnimatedToggle are set - - Improvement: new TVTPaintOption toFixedIndent to draw the tree with a fixed ident (instead of node level - dependent indents) - - Improvement: new TVTPaintOption toChildrenAbove to draw children nodes above their parent -August 2008 - - Improvement: redesigned and overloaded TBaseVirtualTree.ScrollIntoView in order to use vertical scrolling - separately - - Improvement: optimized TBaseVirtualTree.ScrollIntoView for horizontal scrolling - - Improvement: in TBaseVirtualTree.WMKeyDown column navigation for VK_PRIOR and VK_NEXT is now handled in same way - as row navigation - - Improvement: new TVTHeaderOption hoDisableAnimatedResize to disable animated resize for all columns - - Improvement: new TVTColumnOption coDisableAnimatedResize to disable animated resize for a specific column - - Improvement: in TBaseVirtualTree.UpdateHorizontalScrollBar and TBaseVirtualTree.UpdateVerticalScrollBar scrollbar - updates now avoided for tsUpdating in FStates -July 2008 - - Improvement: in TBaseVirtualTree.WMHScroll the horizontal page scrolling now considers fixed columns - - Improvement: in TBaseVirtualTree.ScrollIntoView the case of FFocusedColumn being invalid is considered - - Improvement: in TBaseVirtualTree.HandleMouseDown DoFocusNode is not called if node focus did not change - - Improvement: in TBaseVirtualTree.SetFocusedColumn the focused node will only be invalidate if it was actually - scrolled into view - - Improvement: new TVTColumnOption coAllowFocus to affect column focus behaviour - - Improvement: new function TVTHeader.AllowFocus to check wether a column can be focused - - Improvement: in TBaseVirtualTree.SetFocusedColumn the old colunm and the new column are both invalidated - - Improvement: merged latest changes from Jim into current code base. -June 2008 - - Improvement: new property TVirtualTreeColumns.Count - - Bug fix: in TVirtualTreeColumns.AnimatedResize the column is validated (to avoid "List index out of bounds") - - Improvement: the content retangle of the cell can be modified via the OnBeforeCellPaint event, the cell paint - mode indicates wether OnBeforeCellPaint is called for painting the cell or just for getting the - cell content margin - - Improvement: new functions added: TBaseVirtualTree.DoGetCellContentMargins, - TCustomVirtualDrawTree.DoGetCellContentMargin - - Improvement: new property: TCustomVirtualDrawTree.OnGetCellContentMargin - - Improvement: in TBaseVirtualTree.GetMaxColumnWidth the cell content margin is considered - - Improvement: in TBaseVirtualTree.CMHintShow the cell content margin is considered for singleline tooltips - - Improvement: new function added: TVTHeader.DoGetPopupMenu (to query the application via TreeView.FOnGetPopupMenu - for a column specific header popup menu) - - Improvement: new property added: TBaseVirtualTree.OnCanSplitterResizeColumn, - new function added: TVirtualTreeColumns.GetScrollWidth - - Improvement: horizontal page scrolling now uses the average column width (of all visible, non-fixed columns) as - scroll amount - - Improvement: procedure TBaseVirtualTree.CMMouseWheel redesigned - - Bug fix: TVTHeader.DetermineSplitterIndex works correctly even when using fixed columns - - Bug fix: on right-to-left BiDiMode TVirtualTreeColumns.PaintHeader respects (left) scroll bar correctly - - Bug fix: for multiline tooltips also the column width is checked to determine the tooltip is needed or - unnecessary - - Improvement: the result value of GetUseSmartColumnWidth is initialized correctly - - Improvement: added hoFullRepaintOnResize to TVTHeaderOption to enable full header repainting (instead of - repainting all subsequent columns only) on resizing a column - - Bug fix: horizontal page scrolling via mouse wheel now works correctly, i.e. in TBaseVirtualTree.CMMouseWheel - ScrollCount includes GetVisibleFixedWidth and FIndent - - Improvement: new TVTColumnOption coSmartResize to avoid contradicting the virtual paradigm - - Improvement: horizontal scrolling via mouse wheel can be forced by holding the shift key - - Improvement: new parameter for function TBaseVirtualTree.GetMaxColumnWidth added: UseSmartColumnWidth (to - avoid contradicting the virtual paradigm, i.e. leave nodes out of consideration which are not in - view) - - Improvement: new parameters for TVTHeader.AutoFitColumns added: SmartAutoFitType, RangeStartCol and - RangeEndCol - - Improvement: new parameters for events FOnAfterAutoFitColumns, FOnBeforeAutoFitColumns, FOnAfterGetMaxColumnWidth - and FOnBeforeGetMaxColumnWidth added - - Version is now 4.6.0 -May 2008 - - Improvement: new properties: FOnAfterAutoFitColumns, FOnBeforeAutoFitColumns, FOnAfterGetMaxColumnWidth and - FOnBeforeGetMaxColumnWidth - - Bug fix: FDropTargetNode is considered in TBaseVirtualTree.DoFreeNode -August 2007 - - for accessibility, added an OnGetImageText event that can be used to give accessible text to images used in nodes. - - Implemented an ImageText property used by the VTAccessibility unit to retrieve text for a given node and its column. - - Switched loading of accessibility libraries to dynamic from static to avoid problems in Win95 -June 2007 - - Bug fix: Fixed a problem with potentially large amount of nodes (larger than 2 billion) in - TBaseVirtualTree.SetChildCount. - - Bug fix: remove hint if any in case the tree loses the focus. - - Improvement: TVirtualTreeColumns.HandleClick is now virtual, introduced TVTHeader.DoSetSortColumn. - - Bug fix: compiler error due to old variable reference when enabling flat scrollbars. -May 2007 - - Improvement: new functions: GetPreviousSelected, GetPreviousChecked, GetCheckedCount, - GetPreviousCutCopy, GetCutCopyCount, GetFirstLeaf, GetNextLeaf, - GetPreviousLeaf, GetFirstLevel, GetNextLevel, GetPreviousLevel - - Improvement: new properties: CheckedCount, CutCopyCount - - Improvement: DoFocusChanging for finding a valid column (TBaseVirtualTree.WMKeyDown) -March 2007 - - Improvement: adjusted accessibility implementation to compile with pre-BDS IDEs. - - If a column is not visible, MultiColumnAccessibility now will not include it. -January 2007 - - Improvement: added code donation from Marco Zehe (with help from Sebastian Modersohn) which implements the - MS accessibility interface for Virtual Treeview. -December 2006 - - Improvement: bidi mode implementation finished (toAutoBidiColumnOrdering introduced) - - Change: right-to-left flag removed from shorten string methods/events (not necessary) - - Version is now 4.5.0 -November 2006 - - Bug fix: Total height is wrong on reading from stream -September 2006 - - Bug fix: Mantis issue #326 -July 2006 -- Change: value for crHeaderSplit cursor conflicts with other resource IDs, so I changed it. -- Published OnStartDrag in VirtualDrawTree. -April 2006 - - Bug fix: check for MMX availabiltiy is missing in some places before calling MMX code - - Bug fix: flag for VCL dragging was removed too late causing all kind of problems with mouse up code in VCL drag mode. - - Bug fix: If the past mode in ProcessOLEData is amInsertAfter then nodes where inserted in the wrong order. -March 2006 - - Bug fix: total count and total height is wrong after loading from stream - - Bug fix: variable node height computation - - Bug fix: FLastChangedNode was not reset in DoFreeNode -February 2006 - - Improvement: GetFirstChecked now also has a default value for its state parameter. - - Improvement: avoid potential reentrancy problems in paint code by checking for the paint state there. -January 2006 - - Bug fix: disabled images are now drawn like enabled ones (with respect to position, indices etc.). - - Improvement: New property BottomSpace, allows to specify an additional area below the last node in the tree. - - Bug fix: VT.EndUpdate did not invalidate the cache so the cache was never used again after that. - - Improvement: tree states for double clicks (left, middle, right). -December 2005 - - Bug fix: check for column index for auto setting main column if the current one is deleted. - -For full document history see help file. diff --git a/Delphinus.Install.json b/Delphinus.Install.json index c5d4fc524..a193c6c82 100644 --- a/Delphinus.Install.json +++ b/Delphinus.Install.json @@ -1,63 +1,56 @@ { - "search_pathes": - [ - { - "pathes": "Source", - "platforms": "Win32;Win64" - } - ], - - "browsing_pathes": - [ - { - "pathes": "Source", - "platforms": "Win32;Win64" - } - ], - - "source_folders": - [ - { - "folder": "source", - "base": "", - "recursive": true, - "filter": "*;*.*" - }, - { - "folder": "Packages", - "base": "", - "recursive": true, - "filter": "*;*.*" - }, - { - "folder": "Design", - "base": "", - "recursive": true, - "filter": "*;*.*" - } - ], - - "projects": - [ - { - "project": "Packages\\RAD Studio XE3\\VirtualTreeView.groupproj" - "compiler_max": 26 - }, - { - "project": "Packages\\RAD Studio XE6\\VirtualTreeView.groupproj" - "compiler": 27 - }, - { - "project": "Packages\\RAD Studio XE7\\VirtualTreeView.groupproj" - "compiler": 28 - }, - { - "project": "Packages\\RAD Studio XE8\\VirtualTreeView.groupproj" - "compiler": 29 - }, - { - "project": "Packages\\RAD Studio 10\\VirtualTreeView.groupproj" - "compiler_min": 30 - } - ] -} \ No newline at end of file + "search_pathes": [ + { + "pathes": "Source", + "platforms": "Win32;Win64" + } + ], + "browsing_pathes": [ + { + "pathes": "Source", + "platforms": "Win32;Win64" + } + ], + "source_folders": [ + { + "folder": "source", + "base": "", + "recursive": true, + "filter": "*;*.*" + }, + { + "folder": "Packages", + "base": "", + "recursive": true, + "filter": "*;*.*" + }, + { + "folder": "Design", + "base": "", + "recursive": true, + "filter": "*;*.*" + } + ], + "projects": [ + { + "project": "Packages\\RAD Studio XE3\\VirtualTreeView.groupproj", + "compiler_max": 26 + }, + { + "project": "Packages\\RAD Studio XE6\\VirtualTreeView.groupproj", + "compiler": 27 + }, + { + "project": "Packages\\RAD Studio XE7\\VirtualTreeView.groupproj", + "compiler": 28 + }, + { + "project": "Packages\\RAD Studio XE8\\VirtualTreeView.groupproj", + "compiler": 29 + }, + { + "project": "Packages\\RAD Studio 10\\VirtualTreeView.groupproj", + "compiler_min": 30 + } + ] +} diff --git a/Demos/Advanced/Advanced.dproj b/Demos/Advanced/Advanced.dproj index b29276705..2740d8da4 100644 --- a/Demos/Advanced/Advanced.dproj +++ b/Demos/Advanced/Advanced.dproj @@ -1,14 +1,15 @@  - {E5FD8257-AE07-4A8D-AB79-44170493F9A2} - Advanced.dpr True - Debug - 1 Application + Debug VCL - 18.5 + Advanced.dpr Win32 + {E5FD8257-AE07-4A8D-AB79-44170493F9A2} + 20.2 + 3 + Advanced true @@ -18,11 +19,22 @@ Base true + + true + Base + true + true Base true + + true + Cfg_1 + true + true + true Base @@ -34,47 +46,68 @@ true true + + true + Cfg_2 + true + true + Advanced - false - true - FileVersion=1.0.0.0 - 1031 - false - C:\windows\microsoft.net\framework\v1.1.4322\system.dll;C:\windows\microsoft.net\framework\v1.1.4322\system.data.dll;C:\windows\microsoft.net\framework\v1.1.4322\system.drawing.dll;C:\windows\microsoft.net\framework\v1.1.4322\system.windows.forms.dll;C:\windows\microsoft.net\framework\v1.1.4322\system.xml.dll;vcl;rtl;$(DCC_UsePackage) - 4096 - true 00400000 - true - false + true + 4096 Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) - false false + true ..\..\Source;..\..\Common;$(DCC_UnitSearchPath) + C:\windows\microsoft.net\framework\v1.1.4322\system.dll;C:\windows\microsoft.net\framework\v1.1.4322\system.data.dll;C:\windows\microsoft.net\framework\v1.1.4322\system.drawing.dll;C:\windows\microsoft.net\framework\v1.1.4322\system.windows.forms.dll;C:\windows\microsoft.net\framework\v1.1.4322\system.xml.dll;vcl;rtl;$(DCC_UsePackage) + FileVersion=1.0.0.0 + 1031 - 1033 - true + true System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + 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) + 1033 + + + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - 0 - false RELEASE;$(DCC_Define) + false + 0 + + + true + PerMonitorV2 - true DEBUG;$(DCC_Define) + true + true + PerMonitorV2 + true + Debug true - 1033 CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) + 1033 + 3 + + true PerMonitorV2 @@ -122,10 +155,6 @@
StateForm
 - - Cfg_2 - Base - Base @@ -133,6 +162,10 @@ Cfg_1 Base + + Cfg_2 + Base + Delphi.Personality.12 @@ -142,6 +175,10 @@ Advanced.dpr + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + False False @@ -160,19 +197,963 @@ 1.0.0.0 - - DBExpress Enterprise Data Explorer Integration - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - True - False + True + + + + Advanced.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 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\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 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 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 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 + + + + + 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 + + + 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 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 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\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 + + + + + + + + + + + + + + + 12 + diff --git a/Demos/Advanced/AlignDemo.pas b/Demos/Advanced/AlignDemo.pas index 0f16ca231..d5bd0c6d4 100644 --- a/Demos/Advanced/AlignDemo.pas +++ b/Demos/Advanced/AlignDemo.pas @@ -15,8 +15,11 @@ interface {$warn UNSAFE_CODE off} uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, Buttons, VirtualTrees, ComCtrls, ExtCtrls, ImgList, Menus, UITypes; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, + VirtualTrees, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.ImgList, Vcl.Menus, System.UITypes, + VirtualTrees.Types, System.ImageList, VirtualTrees.BaseAncestorVCL, + VirtualTrees.BaseTree, VirtualTrees.AncestorVCL; type TAlignForm = class(TForm) @@ -353,21 +356,21 @@ procedure TAlignForm.FormCreate(Sender: TObject); // Button layout LayoutCombo.ItemIndex := Ord(Columns[0].Layout); - if not (hoShowImages in Options) then + if not (TVTHeaderOption.hoShowImages in Options) then Height := 24 else - if Columns[0].Layout in [blGlyphTop, blGlyphBottom] then + if Columns[0].Layout in [TVTHeaderColumnLayout.blGlyphTop, TVTHeaderColumnLayout.blGlyphBottom] then Height := 64 else Height := 40; // Options - ShowGlyphsOptionBox.Checked := hoShowImages in Options; - HotTrackOptionBox.Checked := hoHotTrack in Options; + ShowGlyphsOptionBox.Checked := TVTHeaderOption.hoShowImages in Options; + HotTrackOptionBox.Checked := TVTHeaderOption.hoHotTrack in Options; ShowTextOptionBox.Checked := True; ChangeHeaderText; - VisibleOptionBox.Checked := hoVisible in Options; - EnabledOptionBox.Checked := coEnabled in Columns[0].Options; + VisibleOptionBox.Checked := TVTHeaderOption.hoVisible in Options; + EnabledOptionBox.Checked := TVTColumnOption.coEnabled in Columns[0].Options; end; end; @@ -528,35 +531,35 @@ procedure TAlignForm.OptionBoxClick(Sender: TObject); 0: if Checked then begin - Options := Options + [hoShowImages]; - if Columns[0].Layout in [blGlyphTop, blGlyphBottom] then + Options := Options + [TVTHeaderOption.hoShowImages]; + if Columns[0].Layout in [TVTHeaderColumnLayout.blGlyphTop, TVTHeaderColumnLayout.blGlyphBottom] then Height := 64 else Height := 40; end else begin - Options := Options - [hoShowImages]; + Options := Options - [TVTHeaderOption.hoShowImages]; Height := 24; end; 1: if Checked then - Options := Options + [hoHotTrack] + Options := Options + [TVTHeaderOption.hoHotTrack] else - Options := Options - [hoHotTrack]; + Options := Options - [TVTHeaderOption.hoHotTrack]; 2: ChangeHeaderText; 3: if Checked then - Options := Options + [hoVisible] + Options := Options + [TVTHeaderOption.hoVisible] else - Options := Options - [hoVisible]; + Options := Options - [TVTHeaderOption.hoVisible]; 4: for I := 0 to Columns.Count - 1 do if Checked then - Columns[I].Options := Columns[I].Options + [coEnabled] + Columns[I].Options := Columns[I].Options + [TVTColumnOption.coEnabled] else - Columns[I].Options := Columns[I].Options - [coEnabled]; + Columns[I].Options := Columns[I].Options - [TVTColumnOption.coEnabled]; end; end; @@ -573,10 +576,10 @@ procedure TAlignForm.LayoutComboChange(Sender: TObject); for I := 0 to Columns.Count - 1 do Columns[I].Layout := TVTHeaderColumnLayout(ItemIndex); - if not (hoShowImages in Options) then + if not (TVTHeaderOption.hoShowImages in Options) then Height := 24 else - if Columns[0].Layout in [blGlyphTop, blGlyphBottom] then + if Columns[0].Layout in [TVTHeaderColumnLayout.blGlyphTop, TVTHeaderColumnLayout.blGlyphBottom] then Height := 64 else Height := 40; diff --git a/Demos/Advanced/DrawTreeDemo.dfm b/Demos/Advanced/DrawTreeDemo.dfm index 07aee5fef..0e9185836 100644 --- a/Demos/Advanced/DrawTreeDemo.dfm +++ b/Demos/Advanced/DrawTreeDemo.dfm @@ -1,25 +1,24 @@ object DrawTreeForm: TDrawTreeForm Left = 544 Top = 320 - Width = 726 - Height = 513 + ClientHeight = 475 + ClientWidth = 714 Color = clBtnFace Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = 'Trebuchet MS' Font.Style = [] - OldCreateOrder = False OnCreate = FormCreate + OnDestroy = FormDestroy DesignSize = ( - 710 + 714 475) - PixelsPerInch = 96 TextHeight = 18 object Label7: TLabel Left = 0 Top = 0 - Width = 710 + Width = 714 Height = 61 Align = alTop AutoSize = False @@ -32,7 +31,7 @@ object DrawTreeForm: TDrawTreeForm end object Label1: TLabel Left = 4 - Top = 381 + Top = 390 Width = 247 Height = 18 Anchors = [akLeft, akBottom] @@ -40,7 +39,7 @@ object DrawTreeForm: TDrawTreeForm end object Label3: TLabel Left = 424 - Top = 381 + Top = 390 Width = 22 Height = 18 Anchors = [akLeft, akBottom] @@ -50,7 +49,7 @@ object DrawTreeForm: TDrawTreeForm Left = 10 Top = 84 Width = 684 - Height = 278 + Height = 287 Anchors = [akLeft, akTop, akRight, akBottom] AutoExpandDelay = 200 AutoScrollDelay = 200 @@ -67,21 +66,17 @@ object DrawTreeForm: TDrawTreeForm Header.Background = clBtnHighlight Header.Height = 22 Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoRestrictDrag, hoShowSortGlyphs, hoVisible] - Header.ParentFont = True Header.Style = hsPlates - HintAnimation = hatNone HintMode = hmHint Images = SystemImages IncrementalSearch = isAll Indent = 20 LineMode = lmBands ParentShowHint = False - RootNodeCount = 10 ScrollBarOptions.VerticalIncrement = 32 ShowHint = True TabOrder = 0 - TreeOptions.AnimationOptions = [toAnimatedToggle] - TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes] + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes, toAutoChangeScale] TreeOptions.PaintOptions = [toShowBackground, toShowButtons, toShowDropmark, toShowHorzGridLines, toShowRoot, toShowTreeLines, toShowVertGridLines, toThemeAware] TreeOptions.SelectionOptions = [toFullRowSelect] OnCompareNodes = VDT1CompareNodes @@ -95,28 +90,30 @@ object DrawTreeForm: TDrawTreeForm OnInitChildren = VDT1InitChildren OnInitNode = VDT1InitNode OnStateChange = VDT1StateChange + Touch.InteractiveGestures = [igPan, igPressAndTap] + Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough] Columns = < item BiDiMode = bdLeftToRight Options = [coAllowClick, coEnabled, coParentColor, coResizable, coShowDropMark, coVisible] Position = 0 + Text = 'Image file name' Width = 217 - WideText = 'Image file name' end item Position = 1 + Text = 'Thumbnail' Width = 200 - WideText = 'Thumbnail' end item Position = 2 + Text = 'Properties' Width = 160 - WideText = 'Properties' end> end object TrackBar1: TTrackBar Left = 264 - Top = 379 + Top = 388 Width = 157 Height = 21 Anchors = [akLeft, akBottom] diff --git a/Demos/Advanced/DrawTreeDemo.pas b/Demos/Advanced/DrawTreeDemo.pas index 878cdea30..dd1ad9643 100644 --- a/Demos/Advanced/DrawTreeDemo.pas +++ b/Demos/Advanced/DrawTreeDemo.pas @@ -24,9 +24,13 @@ interface uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - VirtualTrees, StdCtrls, {$ifdef GraphicEx} GraphicEx, {$else} JPEG, {$endif} - ImgList, ComCtrls, UITypes; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, + Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, + VirtualTrees, Vcl.StdCtrls, + {$ifdef GraphicEx} GraphicEx, {$else} Vcl.Imaging.JPEG, {$endif} + Vcl.ImgList, Vcl.ComCtrls, System.UITypes, VirtualTrees.DrawTree, + System.ImageList, VirtualTrees.Types, VirtualTrees.BaseAncestorVCL, + VirtualTrees.BaseTree, VirtualTrees.AncestorVCL; type TDrawTreeForm = class(TForm) @@ -46,13 +50,14 @@ TDrawTreeForm = class(TForm) procedure VDT1GetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var Index: TImageIndex); procedure VDT1GetNodeWidth(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - var NodeWidth: Integer); + var NodeWidth: TDimension); procedure VDT1HeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); procedure VDT1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); procedure VDT1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure TrackBar1Change(Sender: TObject); procedure VDT1StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates); + procedure FormDestroy(Sender: TObject); private FThumbSize: Integer; FExtensionsInitialized: Boolean; @@ -160,7 +165,8 @@ procedure TDrawTreeForm.FormCreate(Sender: TObject); var SFI: TSHFileInfo; I, - Count: Integer; + DriveCount: Integer; + Len: Integer; DriveMap, Mask: Cardinal; @@ -168,27 +174,32 @@ procedure TDrawTreeForm.FormCreate(Sender: TObject); VDT1.NodeDataSize := SizeOf(TShellObjectData); // Fill root level of image tree. Determine which drives are mapped. - Count := 0; + DriveCount := 0; DriveMap := GetLogicalDrives; Mask := 1; for I := 0 to 25 do begin if (DriveMap and Mask) <> 0 then - Inc(Count); + Inc(DriveCount); Mask := Mask shl 1; end; - VDT1.RootNodeCount := Count; // Determine drive strings which are used in the initialization process. - Count := GetLogicalDriveStrings(0, nil); - SetLength(FDriveStrings, Count); - GetLogicalDriveStrings(Count, PChar(FDriveStrings)); - + Len := GetLogicalDriveStrings(0, nil); + SetLength(FDriveStrings, Len); + GetLogicalDriveStrings(Len, PChar(FDriveStrings)); + VDT1.RootNodeCount := DriveCount; + SystemImages.Handle := SHGetFileInfo('', 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_SMALLICON); SystemImages.ShareImages := True; FThumbSize := 200; end; +procedure TDrawTreeForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FExtensionList); +end; + //---------------------------------------------------------------------------------------------------------------------- function TDrawTreeForm.CanDisplay(const Name: string): Boolean; @@ -334,58 +345,60 @@ procedure TDrawTreeForm.VDT1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: end else begin - Picture := TPicture.Create; Data.Display := ExtractFileName(ExcludeTrailingBackslash(Data.FullPath)); if (Data.Attributes and SFGAO_FOLDER) = 0 then - try + begin + Picture := TPicture.Create; try - Data.Image := TBitmap.Create; - Picture.LoadFromFile(Data.FullPath); - if not (Picture.Graphic is TBitmap) then - begin - // Some extra steps needed to keep non TBitmap descentants alive when - // scaling. This is needed because when accessing Picture.Bitmap all - // non-TBitmap content will simply be erased (definitly the wrong - // action, but we can't do anything to prevent this). Hence we - // must explicitly draw the graphic to a bitmap. - with Data.Image do + try + Data.Image := TBitmap.Create; + Picture.LoadFromFile(Data.FullPath); + if not (Picture.Graphic is TBitmap) then begin - Width := Picture.Width; - Height := Picture.Height; - Canvas.Draw(0, 0, Picture.Graphic); + // Some extra steps needed to keep non TBitmap descentants alive when + // scaling. This is needed because when accessing Picture.Bitmap all + // non-TBitmap content will simply be erased (definitly the wrong + // action, but we can't do anything to prevent this). Hence we + // must explicitly draw the graphic to a bitmap. + with Data.Image do + begin + Width := Picture.Width; + Height := Picture.Height; + Canvas.Draw(0, 0, Picture.Graphic); + end; + Picture.Bitmap.Assign(Data.Image); end; - Picture.Bitmap.Assign(Data.Image); - end; - RescaleImage(Picture.Bitmap, Data.Image); - - // Collect some additional image properties. - Data.Properties := Data.Properties + Format('%d x %d pixels', [Picture.Width, Picture.Height]); - case Picture.Bitmap.PixelFormat of - pf1bit: - Data.Properties := Data.Properties + ', 2 colors'; - pf4bit: - Data.Properties := Data.Properties + ', 16 colors'; - pf8bit: - Data.Properties := Data.Properties + ', 256 colors'; - pf15bit: - Data.Properties := Data.Properties + ', 32K colors'; - pf16bit: - Data.Properties := Data.Properties + ', 64K colors'; - pf24bit: - Data.Properties := Data.Properties + ', 16M colors'; - pf32bit: - Data.Properties := Data.Properties + ', 16M+ colors'; + RescaleImage(Picture.Bitmap, Data.Image); + + // Collect some additional image properties. + Data.Properties := Data.Properties + Format('%d x %d pixels', [Picture.Width, Picture.Height]); + case Picture.Bitmap.PixelFormat of + pf1bit: + Data.Properties := Data.Properties + ', 2 colors'; + pf4bit: + Data.Properties := Data.Properties + ', 16 colors'; + pf8bit: + Data.Properties := Data.Properties + ', 256 colors'; + pf15bit: + Data.Properties := Data.Properties + ', 32K colors'; + pf16bit: + Data.Properties := Data.Properties + ', 64K colors'; + pf24bit: + Data.Properties := Data.Properties + ', 16M colors'; + pf32bit: + Data.Properties := Data.Properties + ', 16M+ colors'; + end; + if Data.Image.Height + 4 > TVirtualDrawTree(Sender).DefaultNodeHeight then + Sender.NodeHeight[Node] := Data.Image.Height + 4; + except + Data.Image.Free; + Data.Image := nil; end; - if Cardinal(Data.Image.Height) + 4 > TVirtualDrawTree(Sender).DefaultNodeHeight then - Sender.NodeHeight[Node] := Data.Image.Height + 4; - except - Data.Image.Free; - Data.Image := nil; - end; - finally - Picture.Free; - end; - end; + finally + Picture.Free; + end;// try..finally + end;// if + end;// else Data.Attributes := ReadAttributes(Data.FullPath); if ((Data.Attributes and SFGAO_HASSUBFOLDER) <> 0) or (((Data.Attributes and SFGAO_FOLDER) <> 0) and HasChildren(Data.FullPath)) then @@ -475,7 +488,7 @@ procedure TDrawTreeForm.VDT1DrawNode(Sender: TBaseVirtualTree; const PaintInfo: //---------------------------------------------------------------------------------------------------------------------- procedure TDrawTreeForm.VDT1GetNodeWidth(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - var NodeWidth: Integer); + var NodeWidth: TDimension); // Since the draw tree does not know what is in a cell, we have to return the width of the content (not the entire // cell width, this could be determined by the column width). @@ -527,6 +540,7 @@ procedure TDrawTreeForm.VDT1InitChildren(Sender: TBaseVirtualTree; Node: PVirtua if FindFirst(IncludeTrailingBackslash(Data.FullPath) + '*.*', faAnyFile, SR) = 0 then begin Screen.Cursor := crHourGlass; + Sender.BeginUpdate; try repeat if (SR.Name <> '.') and (SR.Name <> '..') then @@ -543,15 +557,15 @@ procedure TDrawTreeForm.VDT1InitChildren(Sender: TBaseVirtualTree; Node: PVirtua GetOpenAndClosedIcons(ChildData.FullPath, ChildData.OpenIndex, ChildData.CloseIndex); Sender.ValidateNode(Node, False); + Inc(ChildCount); end; end; until FindNext(SR) <> 0; - ChildCount := Sender.ChildCount[Node]; // finally sort node - if ChildCount > 0 then - Sender.Sort(Node, 0, TVirtualStringTree(Sender).Header.SortDirection, False); + Sender.Sort(Node, 0, TVirtualStringTree(Sender).Header.SortDirection, False); finally + Sender.EndUpdate; FindClose(SR); Screen.Cursor := crDefault; end; @@ -604,7 +618,7 @@ procedure TDrawTreeForm.VDT1GetHintSize(Sender: TBaseVirtualTree; Node: PVirtual begin Data := Sender.GetNodeData(Node); - if Assigned(Data) and Assigned(Data.Image) and (Column = 1) then + if Assigned(Data) and Assigned(Data.Image) then R := Rect(0, 0, 2 * Data.Image.Width, 2 * Data.Image.Height) else R := Rect(0, 0, 0, 0); @@ -622,7 +636,7 @@ procedure TDrawTreeForm.VDT1DrawHint(Sender: TBaseVirtualTree; Canvas: TCanvas; begin Data := Sender.GetNodeData(Node); - if Assigned(Data) and Assigned(Data.Image) and (Column = 1) then + if Assigned(Data) and Assigned(Data.Image) then begin SetStretchBltMode(Canvas.Handle, HALFTONE); StretchBlt(Canvas.Handle, 0, 0, 2 * Data.Image.Width, 2 * Data.Image.Height, Data.Image.Canvas.Handle, 0, 0, @@ -689,7 +703,7 @@ procedure TDrawTreeForm.VDT1HeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHit SortDirection := sdDescending else SortDirection := sdAscending; - Treeview.SortTree(SortColumn, SortDirection, False); + TBaseVirtualTree(Treeview).SortTree(SortColumn, SortDirection, False); end; end; end; diff --git a/Demos/Advanced/Editors.pas b/Demos/Advanced/Editors.pas index d89ff33f5..1b06f2c8b 100644 --- a/Demos/Advanced/Editors.pas +++ b/Demos/Advanced/Editors.pas @@ -6,9 +6,10 @@ interface uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, VirtualTrees, ExtDlgs, ImgList, Buttons, ExtCtrls, ComCtrls, - Mask; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtDlgs, Vcl.ImgList, + Vcl.Buttons, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.Mask, VirtualTrees, + VirtualTrees.EditLink, VirtualTrees.Types; type // Describes the type of value a property tree node stores in its data property. @@ -34,25 +35,20 @@ TPropertyData = record end; // Our own edit link to implement several different node editors. - TPropertyEditLink = class(TInterfacedObject, IVTEditLink) - private - FEdit: TWinControl; // One of the property editor classes. - FTree: TVirtualStringTree; // A back reference to the tree calling. - FNode: PVirtualNode; // The node being edited. - FColumn: Integer; // The column of the node being edited. + + // Base class for TPropertyEditLink and TGridEditLink implementing key handling + TBasePropertyEditLink = class(TWinControlEditLink) protected procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure EditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); public - destructor Destroy; override; - - function BeginEdit: Boolean; stdcall; - function CancelEdit: Boolean; stdcall; - function EndEdit: Boolean; stdcall; - function GetBounds: TRect; stdcall; - function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall; - procedure ProcessMessage(var Message: TMessage); stdcall; - procedure SetBounds(R: TRect); stdcall; + procedure SetBounds(R: TRect); override; stdcall; + end; + + TPropertyEditLink = class(TBasePropertyEditLink) + public + procedure DoEndEdit(var Result: Boolean); override; + procedure DoPrepareEdit(var Result: Boolean); override; end; //---------------------------------------------------------------------------------------------------------------------- @@ -174,37 +170,19 @@ TGridData = class end; // Our own edit link to implement several different node editors. - TGridEditLink = class(TPropertyEditLink, IVTEditLink) + TGridEditLink = class(TBasePropertyEditLink, IVTEditLink) public - function EndEdit: Boolean; stdcall; - function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall; + procedure DoEndEdit(var Result: Boolean); override; + procedure DoPrepareEdit(var Result: Boolean); override; end; //---------------------------------------------------------------------------------------------------------------------- implementation -uses - PropertiesDemo, GridDemo; - -//----------------- TPropertyEditLink ---------------------------------------------------------------------------------- - -// This implementation is used in VST3 to make a connection beween the tree -// and the actual edit window which might be a simple edit, a combobox -// or a memo etc. - -destructor TPropertyEditLink.Destroy; - -begin - //FEdit.Free; casues issue #357. Fix: - if FEdit.HandleAllocated then - PostMessage(FEdit.Handle, CM_RELEASE, 0, 0); - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- +//----------------- TBasePropertyEditLink ---------------------------------------------------------------------------------- -procedure TPropertyEditLink.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +procedure TBasePropertyEditLink.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var CanAdvance: Boolean; @@ -244,7 +222,9 @@ procedure TPropertyEditLink.EditKeyDown(Sender: TObject; var Key: Word; Shift: T end; end; -procedure TPropertyEditLink.EditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBasePropertyEditLink.EditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin case Key of VK_ESCAPE: @@ -257,26 +237,21 @@ procedure TPropertyEditLink.EditKeyUp(Sender: TObject; var Key: Word; Shift: TSh //---------------------------------------------------------------------------------------------------------------------- -function TPropertyEditLink.BeginEdit: Boolean; - -begin - Result := True; - FEdit.Show; - FEdit.SetFocus; -end; - -//---------------------------------------------------------------------------------------------------------------------- +procedure TBasePropertyEditLink.SetBounds(R: TRect); -function TPropertyEditLink.CancelEdit: Boolean; +var + Dummy: Integer; begin - Result := True; - FEdit.Hide; + // Since we don't want to activate grid extensions in the tree (this would influence how the selection is drawn) + // we have to set the edit's width explicitly to the width of the column. + FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right); + FEdit.BoundsRect := R; end; -//---------------------------------------------------------------------------------------------------------------------- +//----------------- TPropertyEditLink ---------------------------------------------------------------------------------- -function TPropertyEditLink.EndEdit: Boolean; +procedure TPropertyEditLink.DoEndEdit(var Result: Boolean); var Data: PPropertyData; @@ -284,14 +259,14 @@ function TPropertyEditLink.EndEdit: Boolean; S: UnicodeString; begin - Result := True; + inherited; Data := FNode.GetData(); - if FEdit is TComboBox then - S := TComboBox(FEdit).Text + if Edit is TComboBox then + S := TComboBox(Edit).Text else begin - GetWindowText(FEdit.Handle, Buffer, 1024); + GetWindowText(Edit.Handle, Buffer, 1024); S := Buffer; end; @@ -301,34 +276,20 @@ function TPropertyEditLink.EndEdit: Boolean; Data.Changed := True; FTree.InvalidateNode(FNode); end; - FEdit.Hide; FTree.SetFocus; end; //---------------------------------------------------------------------------------------------------------------------- -function TPropertyEditLink.GetBounds: TRect; - -begin - Result := FEdit.BoundsRect; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TPropertyEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; +procedure TPropertyEditLink.DoPrepareEdit(var Result: Boolean); var Data: PPropertyData; begin - Result := True; - FTree := Tree as TVirtualStringTree; - FNode := Node; - FColumn := Column; + inherited; // determine what edit type actually is needed - FEdit.Free; - FEdit := nil; Data := Node.GetData(); case Data.ValueType of vtString: @@ -421,32 +382,9 @@ function TPropertyEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNod end; end; -//---------------------------------------------------------------------------------------------------------------------- - -procedure TPropertyEditLink.ProcessMessage(var Message: TMessage); - -begin - FEdit.WindowProc(Message); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TPropertyEditLink.SetBounds(R: TRect); - -var - Dummy: Integer; - -begin - // Since we don't want to activate grid extensions in the tree (this would influence how the selection is drawn) - // we have to set the edit's width explicitly to the width of the column. - FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right); - FEdit.BoundsRect := R; -end; - //---------------- TGridEditLink --------------------------------------------------------------------------------------- -function TGridEditLink.EndEdit: Boolean; - +procedure TGridEditLink.DoEndEdit(var Result: Boolean); var Data: TGridData; Buffer: array[0..1024] of Char; @@ -454,11 +392,11 @@ function TGridEditLink.EndEdit: Boolean; I: Integer; begin - Result := True; + inherited; Data := FNode.GetData(); - if FEdit is TComboBox then + if Edit is TComboBox then begin - S := TComboBox(FEdit).Text; + S := TComboBox(Edit).Text; if S <> Data.Value[FColumn - 1] then begin Data.Value[FColumn - 1] := S; @@ -466,9 +404,9 @@ function TGridEditLink.EndEdit: Boolean; end; end else - if FEdit is TMaskEdit then + if Edit is TMaskEdit then begin - I := StrToInt(Trim(TMaskEdit(FEdit).EditText)); + I := StrToInt(Trim(TMaskEdit(Edit).EditText)); if I <> Data.Value[FColumn - 1] then begin Data.Value[FColumn - 1] := I; @@ -477,7 +415,7 @@ function TGridEditLink.EndEdit: Boolean; end else begin - GetWindowText(FEdit.Handle, Buffer, 1024); + GetWindowText(Edit.Handle, Buffer, 1024); S := Buffer; if S <> Data.Value[FColumn - 1] then begin @@ -488,26 +426,20 @@ function TGridEditLink.EndEdit: Boolean; if Data.Changed then FTree.InvalidateNode(FNode); - FEdit.Hide; end; //---------------------------------------------------------------------------------------------------------------------- -function TGridEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; +procedure TGridEditLink.DoPrepareEdit(var Result: Boolean); var Data: TGridData; begin - Result := True; - FTree := Tree as TVirtualStringTree; - FNode := Node; - FColumn := Column; + inherited; // Determine what edit type actually is needed. - FEdit.Free; - FEdit := nil; - Data := FTree.GetNodeData(Node); - case Data.ValueType[FColumn - 1] of + Data := Tree.GetNodeData(Node); + case Data.ValueType[Column - 1] of vtString: begin FEdit := TEdit.Create(nil); @@ -515,7 +447,7 @@ function TGridEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; C begin Visible := False; Parent := Tree; - Text := Data.Value[FColumn - 1]; + Text := Data.Value[Column - 1]; OnKeyDown := EditKeyDown; OnKeyUp := EditKeyUp; end; @@ -527,10 +459,10 @@ function TGridEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; C begin Visible := False; Parent := Tree; - Text := Data.Value[FColumn - 1]; + Text := Data.Value[Column - 1]; // Here you would usually do a lookup somewhere to get // values for the combobox. We only add some dummy values. - case FColumn of + case Column of 2: begin Items.Add('John'); @@ -558,7 +490,7 @@ function TGridEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; C Visible := False; Parent := Tree; EditMask := '9999;0; '; - Text := Data.Value[FColumn - 1]; + Text := Data.Value[Column - 1]; OnKeyDown := EditKeyDown; OnKeyUp := EditKeyUp; end; @@ -570,7 +502,7 @@ function TGridEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; C begin Visible := False; Parent := Tree; - Text := Data.Value[FColumn - 1]; + Text := Data.Value[Column - 1]; OnKeyDown := EditKeyDown; OnKeyUp := EditKeyUp; end; @@ -584,8 +516,8 @@ function TGridEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; C begin Visible := False; Parent := Tree; - Text := Data.Value[FColumn - 1]; - Items.Add(Data.Value[FColumn - 1]); + Text := Data.Value[Column - 1]; + Items.Add(Data.Value[Column - 1]); OnKeyDown := EditKeyDown; OnKeyUp := EditKeyUp; end; @@ -602,7 +534,7 @@ function TGridEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; C CalColors.TitleBackColor := clBtnShadow; CalColors.TitleTextColor := clBlack; CalColors.TrailingTextColor := clBtnFace; - Date := StrToDate(Data.Value[FColumn - 1]); + Date := StrToDate(Data.Value[Column - 1]); OnKeyDown := EditKeyDown; OnKeyUp := EditKeyUp; end; diff --git a/Demos/Advanced/GeneralAbilitiesDemo.dfm b/Demos/Advanced/GeneralAbilitiesDemo.dfm index 29498e88d..70a44075d 100644 --- a/Demos/Advanced/GeneralAbilitiesDemo.dfm +++ b/Demos/Advanced/GeneralAbilitiesDemo.dfm @@ -34,7 +34,6 @@ object GeneralForm: TGeneralForm Colors.HotColor = clBlack Colors.UnfocusedSelectionBorderColor = clBtnShadow Ctl3D = True - CustomCheckImages = TreeImages DefaultNodeHeight = 20 DragCursor = crHelp DragMode = dmAutomatic @@ -59,15 +58,15 @@ object GeneralForm: TGeneralForm ScrollBarOptions.VerticalIncrement = 19 TabOrder = 0 TreeOptions.AnimationOptions = [toAnimatedToggle] - TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoSpanColumns, toAutoTristateTracking, toAutoHideButtons, toDisableAutoscrollOnFocus, toAutoChangeScale] + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoSpanColumns, toAutoTristateTracking, toAutoHideButtons, toAutoChangeScale] TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toEditable, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] TreeOptions.PaintOptions = [toHideSelection, toHotTrack, toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines, toUseBlendedSelection] - TreeOptions.SelectionOptions = [toExtendedFocus, toMiddleClickSelect, toMultiSelect, toRightClickSelect] + TreeOptions.SelectionOptions = [toExtendedFocus, toMiddleClickSelect, toMultiSelect, toRightClickSelect, toSelectNextNodeOnRemoval] TreeOptions.StringOptions = [toSaveCaptions, toShowStaticText, toAutoAcceptEditChange] OnDragOver = VST2DragOver OnFocusChanging = VST2FocusChanging OnFreeNode = VST2FreeNode - OnGetText = VST2GetText + OnGetCellText = VST2GetCellText OnPaintText = VST2PaintText OnGetImageIndexEx = VST2GetImageIndexEx OnGetNodeDataSize = VST2GetNodeDataSize @@ -273,7 +272,6 @@ object GeneralForm: TGeneralForm Margins.Bottom = 6 Align = alLeft Caption = 'Switch main column:' - ExplicitHeight = 13 end object MainColumnUpDown: TUpDown Left = 112 @@ -297,7 +295,7 @@ object GeneralForm: TGeneralForm Left = 22 Top = 148 Bitmap = { - 494C010112001300100010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010112001300040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000005000000001002000000000000050 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -1006,7 +1004,7 @@ object GeneralForm: TGeneralForm Left = 32 Top = 200 Bitmap = { - 494C010151005400100018001800FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010151005400040018001800FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000060000000F8010000010020000000000000F4 0200000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 diff --git a/Demos/Advanced/GeneralAbilitiesDemo.pas b/Demos/Advanced/GeneralAbilitiesDemo.pas index aa07b400d..a3e7ef0f8 100644 --- a/Demos/Advanced/GeneralAbilitiesDemo.pas +++ b/Demos/Advanced/GeneralAbilitiesDemo.pas @@ -1,4 +1,4 @@ -unit GeneralAbilitiesDemo; +unit GeneralAbilitiesDemo; // Virtual Treeview sample form demonstrating following features: // - General use and feel of TVirtualStringTree. @@ -25,9 +25,12 @@ interface {$ifend} uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, Buttons, VirtualTrees, ComCtrls, ExtCtrls, ImgList, Menus, - StdActns, ActnList, VirtualTrees.HeaderPopup, UITypes; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, VirtualTrees, + Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.ImgList, Vcl.Menus, Vcl.StdActns, Vcl.ActnList, + VirtualTrees.HeaderPopup, System.UITypes, System.ImageList, + VirtualTrees.BaseTree, VirtualTrees.Types, VirtualTrees.BaseAncestorVCL, + VirtualTrees.AncestorVCL; type TGeneralForm = class(TForm) @@ -57,8 +60,8 @@ TGeneralForm = class(TForm) var InitialStates: TVirtualNodeInitStates); procedure VST2InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); procedure VST2NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: string); - procedure VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: string); + procedure VST2GetCellText(Sender: TCustomVirtualStringTree; + var E: TVSTGetCellTextEventArgs); procedure VST2PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure VST2GetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); @@ -183,8 +186,7 @@ procedure TGeneralForm.VST2PaintText(Sender: TBaseVirtualTree; const TargetCanva //---------------------------------------------------------------------------------------------------------------------- -procedure TGeneralForm.VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - TextType: TVSTTextType; var CellText: string); +procedure TGeneralForm.VST2GetCellText(Sender: TCustomVirtualStringTree; var E: TVSTGetCellTextEventArgs); // Returns the text as it is stored in the nodes data record. @@ -192,21 +194,19 @@ procedure TGeneralForm.VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: PNodeData2; begin - Data := Sender.GetNodeData(Node); - CellText := ''; - case Column of + Data := Sender.GetNodeData(E.Node); + case E.Column of 0: // main column (has two different captions) - case TextType of - ttNormal: - CellText := Data.Caption; - ttStatic: - CellText := Data.StaticText; + begin + E.CellText := Data.Caption; + E.StaticText := Data.StaticText; + if Sender.GetNodeLevel(E.Node) > 0 then + E.StaticTextAlignment := TAlignment.taRightJustify; end; - 1: // no text in the image column - ; - 2: - if TextType = ttNormal then - CellText := Data.ForeignText; + 1,2: + E.CellText := Data.ForeignText; + else + E.CellText := ''; end; end; @@ -236,7 +236,7 @@ procedure TGeneralForm.VST2InitNode(Sender: TBaseVirtualTree; ParentNode, Node: end; Caption := Format('Level %d, Index %d', [Level, Node.Index]); - if Level in [0, 3] then + if Level in [0, 2, 3] then StaticText := '(static text)'; ForeignText := ''; @@ -261,7 +261,7 @@ procedure TGeneralForm.VST2InitNode(Sender: TBaseVirtualTree; ParentNode, Node: 4: begin ForeignText := WideChar($20AC); - ForeignText := 'nichts ist unmöglich ' + ForeignText; + ForeignText := 'nichts ist unmöglich ' + ForeignText; end; 5: begin @@ -370,15 +370,11 @@ procedure TGeneralForm.VST2GetPopupMenu(Sender: TBaseVirtualTree; Node: PVirtual const P: TPoint; var AskParent: Boolean; var PopupMenu: TPopupMenu); begin - case Column of - 0: - PopupMenu := PopupMenu1 - else - PopupMenu := nil; - end; + if Column <= 0 then + PopupMenu := PopupMenu1; end; -//---------------------------------------------------------------------------------------------------------------------- +//----------------------------------------------------------------------------------------------------------------------; procedure TGeneralForm.VST2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); @@ -409,12 +405,12 @@ procedure TGeneralForm.RadioGroup1Click(Sender: TObject); with Sender as TRadioGroup do if ItemIndex = 0 then begin - VST2.TreeOptions.PaintOptions := VST2.TreeOptions.PaintOptions + [toShowTreeLines]; + VST2.TreeOptions.PaintOptions := VST2.TreeOptions.PaintOptions + [TVTPaintOption.toShowTreeLines]; VST2.ButtonStyle := bsRectangle; end else begin - VST2.TreeOptions.PaintOptions := VST2.TreeOptions.PaintOptions - [toShowTreeLines]; + VST2.TreeOptions.PaintOptions := VST2.TreeOptions.PaintOptions - [TVTPaintOption.toShowTreeLines]; VST2.ButtonStyle := bsTriangle; end; end; @@ -452,11 +448,11 @@ procedure TGeneralForm.ThemeRadioGroupClick(Sender: TObject); with VST2.TreeOptions do if ThemeRadioGroup.ItemIndex = 0 then begin - PaintOptions := PaintOptions + [toThemeAware]; + PaintOptions := PaintOptions + [TVTPaintOption.toThemeAware]; VST2.CheckImageKind := ckSystemDefault; end else - PaintOptions := PaintOptions - [toThemeAware]; + PaintOptions := PaintOptions - [TVTPaintOption.toThemeAware]; RadioGroup1.Enabled := ThemeRadioGroup.ItemIndex = 1; RadioGroup2.Enabled := ThemeRadioGroup.ItemIndex = 1; diff --git a/Demos/Advanced/GridDemo.dfm b/Demos/Advanced/GridDemo.dfm index 34732e7a1..590bb0e27 100644 --- a/Demos/Advanced/GridDemo.dfm +++ b/Demos/Advanced/GridDemo.dfm @@ -4,16 +4,15 @@ object GridForm: TGridForm ClientHeight = 474 ClientWidth = 745 Color = clBtnFace + CustomTitleBar.CaptionAlignment = taCenter Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = 'Tahoma' Font.Style = [] - OldCreateOrder = False DesignSize = ( 745 474) - PixelsPerInch = 96 TextHeight = 16 object Label15: TLabel Left = 516 @@ -75,7 +74,7 @@ object GridForm: TGridForm 'Virtual Tree Data') Colors.BorderColor = clWindowText Colors.HotColor = clBlack - DefaultNodeHeight = 19 + DefaultNodeHeight = 17 DragMode = dmAutomatic EditDelay = 300 Font.Charset = ANSI_CHARSET @@ -85,15 +84,9 @@ object GridForm: TGridForm Font.Style = [] Header.AutoSizeIndex = 2 Header.Background = clBtnShadow - Header.Font.Charset = ANSI_CHARSET - Header.Font.Color = clWindowText - Header.Font.Height = -12 - Header.Font.Name = 'Microsoft Sans Serif' - Header.Font.Style = [] - Header.Height = 20 + Header.Height = 17 Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoShowImages, hoVisible] Header.Style = hsFlatButtons - HintAnimation = hatFade HintMode = hmTooltip ParentFont = False ParentShowHint = False @@ -102,10 +95,10 @@ object GridForm: TGridForm ScrollBarOptions.AlwaysVisible = True ShowHint = True TabOrder = 0 - TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoTristateTracking] + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoChangeScale] TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning] - TreeOptions.PaintOptions = [toHotTrack, toShowButtons, toShowDropmark, toShowHorzGridLines, toShowVertGridLines, toUseBlendedImages] - TreeOptions.SelectionOptions = [toDisableDrawSelection, toExtendedFocus, toMiddleClickSelect, toMultiSelect, toRightClickSelect, toCenterScrollIntoView] + TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowHorzGridLines, toShowVertGridLines, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toExtendedFocus, toMiddleClickSelect, toMultiSelect] WantTabs = True OnAfterCellPaint = VST5AfterCellPaint OnBeforeCellPaint = VST5BeforeCellPaint @@ -117,6 +110,9 @@ object GridForm: TGridForm OnPaintText = VST5PaintText OnInitNode = VST5InitNode OnStateChange = VST5StateChange + Touch.InteractiveGestures = [igPan, igPressAndTap] + Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough] + OnColumnHeaderSpanning = VST5ColumnHeaderSpanning Columns = < item Color = clWindow @@ -127,26 +123,26 @@ object GridForm: TGridForm item Margin = 0 Position = 1 + Text = 'Customer ID' Width = 100 - WideText = 'Customer ID' end item Margin = 0 Position = 2 + Text = 'First Name' Width = 120 - WideText = 'First Name' end item Margin = 0 Position = 3 + Text = 'Last Name' Width = 120 - WideText = 'Last Name' end item Margin = 0 Position = 4 + Text = 'Order date' Width = 100 - WideText = 'Order date' end> end object GridLineCheckBox: TCheckBox @@ -171,11 +167,20 @@ object GridForm: TGridForm TabOrder = 2 OnClick = AutoSpanCheckBoxClick end + object DisplayFullNameCheckBox: TCheckBox + Left = 518 + Top = 360 + Width = 153 + Height = 17 + Caption = 'Display Full Name' + TabOrder = 3 + OnClick = DisplayFullNameCheckBoxClick + end object TreeImages: TImageList Left = 22 Top = 36 Bitmap = { - 494C010112001300280010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010112001300040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000005000000001002000000000000050 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF diff --git a/Demos/Advanced/GridDemo.pas b/Demos/Advanced/GridDemo.pas index b07c94a44..2768d744f 100644 --- a/Demos/Advanced/GridDemo.pas +++ b/Demos/Advanced/GridDemo.pas @@ -10,8 +10,10 @@ interface uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, VirtualTrees, ImgList, Menus; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, VirtualTrees, + Vcl.ImgList, Vcl.Menus, System.ImageList, VirtualTrees.BaseTree, VirtualTrees.Types, + VirtualTrees.BaseAncestorVCL, VirtualTrees.AncestorVCL; type TGridForm = class(TForm) @@ -24,6 +26,7 @@ TGridForm = class(TForm) Edit1: TMenuItem; Label2: TLabel; AutoSpanCheckBox: TCheckBox; + DisplayFullNameCheckBox: TCheckBox; procedure VST5BeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); procedure VST5BeforeItemErase(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; @@ -44,6 +47,9 @@ TGridForm = class(TForm) procedure VST5FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure Edit1Click(Sender: TObject); procedure AutoSpanCheckBoxClick(Sender: TObject); + procedure DisplayFullNameCheckBoxClick(Sender: TObject); + procedure VST5ColumnHeaderSpanning(Sender: TVTHeader; Column: TColumnIndex; + var Count: Integer); end; var @@ -150,7 +156,7 @@ procedure TGridForm.VST5GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Co end else begin - VST5.Header.Columns[0].Options := VST5.Header.Columns[1].Options - [coVisible]; //test: + VST5.Header.Columns[0].Options := VST5.Header.Columns[1].Options - [TVTColumnOption.coVisible]; //test: //No text is shown for column 3 in addition to column 0 as in original code if (Column > 0) and (Column <> 3) then CellText := Sender.GetNodeData(Node).Value[Column - 1] @@ -185,6 +191,34 @@ procedure TGridForm.VST5BeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: //---------------------------------------------------------------------------------------------------------------------- +procedure TGridForm.VST5ColumnHeaderSpanning(Sender: TVTHeader; Column: TColumnIndex; var Count: Integer); +begin + case Column of + 2: + begin + if DisplayFullNameCheckBox.Checked then + begin + //display header column 2 and 3 as ONE, we can also change the title here + Count:= 2; + Sender.Columns[Column].Text := 'Full Name'; + end else + begin + Count:= 1; + Sender.Columns[Column].Text := 'First Name'; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TGridForm.DisplayFullNameCheckBoxClick(Sender: TObject); +begin + VST5.Refresh; +end; + +//---------------------------------------------------------------------------------------------------------------------- + procedure TGridForm.VST5CreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); @@ -203,9 +237,9 @@ procedure TGridForm.GridLineCheckBoxClick(Sender: TObject); begin if GridLineCheckBox.Checked then - VST5.TreeOptions.PaintOptions := VST5.TreeOptions.PaintOptions + [toShowHorzGridLines, toShowVertGridLines] + VST5.TreeOptions.PaintOptions := VST5.TreeOptions.PaintOptions + [TVTPaintOption.toShowHorzGridLines, TVTPaintOption.toShowVertGridLines] else - VST5.TreeOptions.PaintOptions := VST5.TreeOptions.PaintOptions - [toShowHorzGridLines, toShowVertGridLines]; + VST5.TreeOptions.PaintOptions := VST5.TreeOptions.PaintOptions - [TVTPaintOption.toShowHorzGridLines, TVTPaintOption.toShowVertGridLines]; end; //---------------------------------------------------------------------------------------------------------------------- @@ -218,9 +252,9 @@ procedure TGridForm.VST5AfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: T with TargetCanvas do begin // Decorate the fixed indicator column by filling it with an edge similar to that of TCustomGrid. - if toShowVertGridLines in VST5.TreeOptions.PaintOptions then + if TVTPaintOption.toShowVertGridLines in VST5.TreeOptions.PaintOptions then Inc(CellRect.Right); - if toShowHorzGridLines in VST5.TreeOptions.PaintOptions then + if TVTPaintOption.toShowHorzGridLines in VST5.TreeOptions.PaintOptions then Inc(CellRect.Bottom); DrawEdge(Handle, CellRect, BDR_RAISEDINNER, BF_RECT or BF_MIDDLE); if Node = Sender.FocusedNode then @@ -242,9 +276,9 @@ procedure TGridForm.VST5StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVir procedure TGridForm.AutoSpanCheckBoxClick(Sender: TObject); begin if AutoSpanCheckBox.Checked then - VST5.TreeOptions.AutoOptions := VST5.TreeOptions.AutoOptions + [toAutoSpanColumns] + VST5.TreeOptions.AutoOptions := VST5.TreeOptions.AutoOptions + [TVTAutoOption.toAutoSpanColumns] else - VST5.TreeOptions.AutoOptions := VST5.TreeOptions.AutoOptions - [toAutoSpanColumns]; + VST5.TreeOptions.AutoOptions := VST5.TreeOptions.AutoOptions - [TVTAutoOption.toAutoSpanColumns]; end; end. diff --git a/Demos/Advanced/HeaderCustomDrawDemo.pas b/Demos/Advanced/HeaderCustomDrawDemo.pas index 588dd6c65..9bb283f9d 100644 --- a/Demos/Advanced/HeaderCustomDrawDemo.pas +++ b/Demos/Advanced/HeaderCustomDrawDemo.pas @@ -1,306 +1,319 @@ -unit HeaderCustomDrawDemo; - -// Virtual Treeview sample form demonstrating following features: -// - Advanced header custom draw. -// Written by Mike Lischke. - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, ImgList, VirtualTrees, StdCtrls, ExtCtrls; - -type - THeaderOwnerDrawForm = class(TForm) - Label8: TLabel; - HeaderCustomDrawTree: TVirtualStringTree; - HeaderImages: TImageList; - AnimationTimer: TTimer; - procedure HeaderCustomDrawTreeHeaderDrawQueryElements(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; - var Elements: THeaderPaintElements); - procedure HeaderCustomDrawTreeAdvancedHeaderDraw(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; - const Elements: THeaderPaintElements); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure AnimationTimerTimer(Sender: TObject); - procedure HeaderCustomDrawTreeHeaderMouseUp(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); - procedure HeaderCustomDrawTreeHeaderMouseDown(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X, - Y: Integer); - procedure HeaderCustomDrawTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates); - procedure HeaderCustomDrawTreeGetText(Sender: TBaseVirtualTree; - Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: string); - private - FBackBitmap1, - FBackBitmap2, - FCheckerBackground: TBitmap; - FHeaderBitmap: TBitmap; - FLeftPos: Integer; - procedure CreateCheckerBackground; - procedure PaintSelection(Bitmap: TBitmap); - procedure FillBackground(R: TRect; Target: TCanvas); - end; - -var - HeaderOwnerDrawForm: THeaderOwnerDrawForm; - -//---------------------------------------------------------------------------------------------------------------------- - -implementation - -uses - States, Types,VirtualTrees.Utils; - -{$R *.dfm} - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderDrawQueryElements(Sender: TVTHeader; - var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); - -// This event tells the tree which part we want to draw ourselves. Don't forget to enable custom drawing in the header -// options and switch the Style property of every column, which we handle here to vsOwnerDraw. - -begin - with PaintInfo do - begin - // First check the column member. If it is NoColumn then it's about the header background. - if Column = nil then - Elements := [hpeBackground] // No other flag is recognized for the header background. - else - begin - // Using the index here ensures a column, regardless of its position, always has the same draw style. - // By using the Position member, we could make a certain column place stand out, regardless of the column order. - // Don't forget to change the AdvancedHeaderDraw event body accordingly after you changed the indicator here. - case Column.Index of - 0: // Default drawing. - ; - 1: // Background only customization. - Include(Elements, hpeBackground); - 2: // Full customization (well, quite). - Elements := [hpeBackground, hpeText{, hpeDropMark, hpeHeaderGlyph, hpeSortGlyph}]; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeAdvancedHeaderDraw(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; - const Elements: THeaderPaintElements); - -var - S: string; - Size: TSize; - SourceRect, - TargetRect: TRect; - -begin - with PaintInfo do - begin - // First check the column member. If it is NoColumn then it's about the header background. - if Column = nil then - begin - if hpeBackground in Elements then - begin - TargetCanvas.Brush.Color := clBackground; - TargetCanvas.FillRect(PaintRectangle); - end; - end - else - begin - case Column.Index of - 0: // Will never come here. - ; - 1: // Background only customization. - begin - FBackBitmap1.Width := PaintRectangle.Right - PaintRectangle.Left; - FBackBitmap1.Height := PaintRectangle.Bottom - PaintRectangle.Top; - FillBackground(PaintRectangle, FBackbitmap1.Canvas); - if IsHoverIndex then - PaintSelection(FBackBitmap1); - TargetCanvas.Draw(PaintRectangle.Left, Paintrectangle.Top, FBackbitmap1); - end; - 2: // Full customization. Check elements to learn what must be drawn in the various stages. - begin - if hpeBackground in Elements then - with FBackBitmap2 do - begin - Width := PaintRectangle.Right - PaintRectangle.Left; - Height := PaintRectangle.Bottom - PaintRectangle.Top; - TargetRect := Rect(0, 0, Width, Height); - Canvas.Brush.Color := clInfoBk; - Canvas.FillRect(TargetRect); - InflateRect(TargetRect, - 10, -10); - SourceRect := TargetRect; - OffsetRect(SourceRect, -SourceRect.Left + FLeftPos, -SourceRect.Top); - Canvas.CopyRect(TargetRect, FHeaderBitmap.Canvas, SourceRect); - - TargetCanvas.Draw(PaintRectangle.Left, Paintrectangle.Top, FBackbitmap2); - end; - if hpeText in Elements then - begin - TargetCanvas.Font.Name := 'Webdings'; - TargetCanvas.Font.Charset := SYMBOL_CHARSET; - TargetCanvas.Font.Size := 60; - if IsHoverIndex then - TargetCanvas.Font.Color := $80FF; - S := 'û'; - Size := TargetCanvas.TextExtent(S); - SetBkMode(TargetCanvas.Handle, TRANSPARENT); - TargetCanvas.TextOut(PaintRectangle.Left + 10, Paintrectangle.Bottom - Size.cy, S); - end; - // Other elements go here. - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.CreateCheckerBackground; - -begin - FCheckerBackground := TBitmap.Create; - with FCheckerBackground do - begin - Width := 16; - Height := 16; - Canvas.Brush.Color := clBtnShadow; - Canvas.FillRect(Rect(0, 0, Width, Height)); - Canvas.Brush.Color := clBtnHighlight; - Canvas.FillRect(Rect(0, 0, 8, 8)); - Canvas.FillRect(Rect(8, 8, 16, 16)); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.PaintSelection(Bitmap: TBitmap); - -const - Alpha = 75; - -var - R: TRect; - -begin - R := Rect(0, 0, Bitmap.Width, Bitmap.Height); - VirtualTrees.Utils.AlphaBlend(0, Bitmap.Canvas.Handle, R, Point(0, 0), bmConstantAlphaAndColor, Alpha, - ColorToRGB(clHighlight)); - with Bitmap do - begin - Canvas.Pen.Color := clHighlight; - Canvas.Brush.Style := bsClear; - Canvas.Rectangle(0, 0, Width, Height); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.FillBackground(R: TRect; Target: TCanvas); - -// Tiles the background image over the given target bitmap. - -var - X, Y: Integer; - dX, dY: Integer; - -begin - with Target do - begin - dX := FCheckerBackground.Width; - dY := FCheckerBackground.Height; - - Y := 0; - while Y < R.Bottom - R.Top do - begin - X := 0; - while X < R.Right - R.Left do - begin - Draw(X, Y, FCheckerBackground); - Inc(X, dX); - end; - Inc(Y, dY); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.FormCreate(Sender: TObject); - -begin - FBackBitmap1 := TBitmap.Create; - FBackBitmap1.PixelFormat := pf32Bit; - FBackBitmap2 := TBitmap.Create; - FBackBitmap2.PixelFormat := pf32Bit; - CreateCheckerBackground; - FHeaderBitmap := TBitmap.Create; - FHeaderBitmap.Handle := LoadImage(HInstance, 'Transcriptions', IMAGE_BITMAP, 0, 0, LR_DEFAULTCOLOR); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.FormDestroy(Sender: TObject); - -begin - FCheckerBackground.Free; - FBackBitmap1.Free; - FBackBitmap2.Free; - FHeaderBitmap.Free; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.AnimationTimerTimer(Sender: TObject); - -begin - FLeftPos := (FLeftPos + FHeaderBitmap.Width div 2000) mod FHeaderBitmap.Width; - with HeaderCustomDrawTree.Header do - Invalidate(Columns[2]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderMouseUp(Sender: TVTHeader; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - -begin - // Reenable animation after a drag operation. - AnimationTimer.Enabled := True; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderMouseDown(Sender: TVTHeader; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - -begin - // Stop animation when mouse button is down. - AnimationTimer.Enabled := False; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates); - -begin - if not (csDestroying in ComponentState) then - UpdateStateDisplay(Sender.TreeStates, Enter, Leave); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; - Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); - -begin - CellText := 'Some simple text.'; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -end. +unit HeaderCustomDrawDemo; + +// Virtual Treeview sample form demonstrating following features: +// - Advanced header custom draw. +// Written by Mike Lischke. + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, + System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, + Vcl.ImgList, VirtualTrees, Vcl.StdCtrls, Vcl.ExtCtrls, VirtualTrees.BaseTree, + System.ImageList, VirtualTrees.Types, VirtualTrees.BaseAncestorVCL, + VirtualTrees.AncestorVCL; + +type + THeaderOwnerDrawForm = class(TForm) + Label8: TLabel; + HeaderCustomDrawTree: TVirtualStringTree; + HeaderImages: TImageList; + AnimationTimer: TTimer; + procedure HeaderCustomDrawTreeHeaderDrawQueryElements(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; + var Elements: THeaderPaintElements); + procedure HeaderCustomDrawTreeAdvancedHeaderDraw(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; + const Elements: THeaderPaintElements); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure AnimationTimerTimer(Sender: TObject); + procedure HeaderCustomDrawTreeHeaderMouseUp(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X, + Y: TDimension); + procedure HeaderCustomDrawTreeHeaderMouseDown(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X, + Y: TDimension); + procedure HeaderCustomDrawTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates); + procedure HeaderCustomDrawTreeGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: string); + private + FBackBitmap1, + FBackBitmap2, + FCheckerBackground: TBitmap; + FHeaderBitmap: TBitmap; + FLeftPos: Integer; + procedure CreateCheckerBackground; + procedure PaintSelection(Bitmap: TBitmap); + procedure FillBackground(R: TRect; Target: TCanvas); + end; + +var + HeaderOwnerDrawForm: THeaderOwnerDrawForm; + +//---------------------------------------------------------------------------------------------------------------------- + +implementation + +uses + States, Types,VirtualTrees.Utils; + +{$R *.dfm} + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderDrawQueryElements(Sender: TVTHeader; + var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); + +// This event tells the tree which part we want to draw ourselves. Don't forget to enable custom drawing in the header +// options and switch the Style property of every column, which we handle here to vsOwnerDraw. + +begin + with PaintInfo do + begin + // First check the column member. If it is NoColumn then it's about the header background. + if Column = nil then + Elements := [hpeBackground] // No other flag is recognized for the header background. + else + begin + // Using the index here ensures a column, regardless of its position, always has the same draw style. + // By using the Position member, we could make a certain column place stand out, regardless of the column order. + // Don't forget to change the AdvancedHeaderDraw event body accordingly after you changed the indicator here. + case Column.Index of + 0: // Default drawing. + ; + 1: // Background only customization. + Include(Elements, hpeBackground); + 2: // Full customization (well, quite). + Elements := [hpeBackground, hpeText{, hpeDropMark, hpeHeaderGlyph, hpeSortGlyph}]; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeAdvancedHeaderDraw(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; + const Elements: THeaderPaintElements); + +var + S: string; + Size: TSize; + SourceRect, + TargetRect: TRect; + OldFont: TFont; +begin + with PaintInfo do + begin + // First check the column member. If it is NoColumn then it's about the header background. + if Column = nil then + begin + if hpeBackground in Elements then + begin + TargetCanvas.Brush.Color := clBackground; + TargetCanvas.FillRect(PaintRectangle); + end; + end + else + begin + case Column.Index of + 0: // Will never come here. + ; + 1: // Background only customization. + begin + FBackBitmap1.Width := PaintRectangle.Right - PaintRectangle.Left; + FBackBitmap1.Height := PaintRectangle.Bottom - PaintRectangle.Top; + FillBackground(PaintRectangle, FBackbitmap1.Canvas); + if IsHoverIndex then + PaintSelection(FBackBitmap1); + TargetCanvas.Draw(PaintRectangle.Left, Paintrectangle.Top, FBackbitmap1); + end; + 2: // Full customization. Check elements to learn what must be drawn in the various stages. + begin + if hpeBackground in Elements then + with FBackBitmap2 do + begin + Width := PaintRectangle.Right - PaintRectangle.Left; + Height := PaintRectangle.Bottom - PaintRectangle.Top; + TargetRect := Rect(0, 0, Width, Height); + Canvas.Brush.Color := clInfoBk; + Canvas.FillRect(TargetRect); + InflateRect(TargetRect, - 10, -10); + SourceRect := TargetRect; + OffsetRect(SourceRect, -SourceRect.Left + FLeftPos, -SourceRect.Top); + Canvas.CopyRect(TargetRect, FHeaderBitmap.Canvas, SourceRect); + + TargetCanvas.Draw(PaintRectangle.Left, Paintrectangle.Top, FBackbitmap2); + end; + if hpeText in Elements then + begin + // store current font + OldFont := TFont.Create(); + try + OldFont.Assign(TargetCanvas.Font); + // draw world map + TargetCanvas.Font.Name := 'Webdings'; + TargetCanvas.Font.Charset := SYMBOL_CHARSET; + TargetCanvas.Font.Size := 60; + if IsHoverIndex then + TargetCanvas.Font.Color := $80FF; + S := 'û'; + Size := TargetCanvas.TextExtent(S); + SetBkMode(TargetCanvas.Handle, TRANSPARENT); + TargetCanvas.TextOut(PaintRectangle.Left + 10, Paintrectangle.Bottom - Size.cy, S); + // restore previous font + TargetCanvas.Font.Assign(OldFont); + finally + OldFont.Free(); + end; + end; + // Other elements go here. + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.CreateCheckerBackground; + +begin + FCheckerBackground := TBitmap.Create; + with FCheckerBackground do + begin + Width := 16; + Height := 16; + Canvas.Brush.Color := clBtnShadow; + Canvas.FillRect(Rect(0, 0, Width, Height)); + Canvas.Brush.Color := clBtnHighlight; + Canvas.FillRect(Rect(0, 0, 8, 8)); + Canvas.FillRect(Rect(8, 8, 16, 16)); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.PaintSelection(Bitmap: TBitmap); + +const + Alpha = 75; + +var + R: TRect; + +begin + R := Rect(0, 0, Bitmap.Width, Bitmap.Height); + VirtualTrees.Utils.AlphaBlend(0, Bitmap.Canvas.Handle, R, Point(0, 0), bmConstantAlphaAndColor, Alpha, + ColorToRGB(clHighlight)); + with Bitmap do + begin + Canvas.Pen.Color := clHighlight; + Canvas.Brush.Style := bsClear; + Canvas.Rectangle(0, 0, Width, Height); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.FillBackground(R: TRect; Target: TCanvas); + +// Tiles the background image over the given target bitmap. + +var + X, Y: Integer; + dX, dY: Integer; + +begin + with Target do + begin + dX := FCheckerBackground.Width; + dY := FCheckerBackground.Height; + + Y := 0; + while Y < R.Bottom - R.Top do + begin + X := 0; + while X < R.Right - R.Left do + begin + Draw(X, Y, FCheckerBackground); + Inc(X, dX); + end; + Inc(Y, dY); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.FormCreate(Sender: TObject); + +begin + FBackBitmap1 := TBitmap.Create; + FBackBitmap1.PixelFormat := pf32Bit; + FBackBitmap2 := TBitmap.Create; + FBackBitmap2.PixelFormat := pf32Bit; + CreateCheckerBackground; + FHeaderBitmap := TBitmap.Create; + FHeaderBitmap.Handle := LoadImage(HInstance, 'Transcriptions', IMAGE_BITMAP, 0, 0, LR_DEFAULTCOLOR); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.FormDestroy(Sender: TObject); + +begin + FCheckerBackground.Free; + FBackBitmap1.Free; + FBackBitmap2.Free; + FHeaderBitmap.Free; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.AnimationTimerTimer(Sender: TObject); + +begin + FLeftPos := (FLeftPos + FHeaderBitmap.Width div 2000) mod FHeaderBitmap.Width; + with HeaderCustomDrawTree.Header do + Invalidate(Columns[2]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderMouseUp(Sender: TVTHeader; Button: TMouseButton; + Shift: TShiftState; X, Y: TDimension); + +begin + // Reenable animation after a drag operation. + AnimationTimer.Enabled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderMouseDown(Sender: TVTHeader; Button: TMouseButton; + Shift: TShiftState; X, Y: TDimension); + +begin + // Stop animation when mouse button is down. + AnimationTimer.Enabled := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates); + +begin + if not (csDestroying in ComponentState) then + UpdateStateDisplay(Sender.TreeStates, Enter, Leave); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + +begin + CellText := 'Some simple text.'; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +end. diff --git a/Demos/Advanced/Main.dfm b/Demos/Advanced/Main.dfm index c4bd0bc39..ade5f4d5a 100644 --- a/Demos/Advanced/Main.dfm +++ b/Demos/Advanced/Main.dfm @@ -1,9 +1,9 @@ object MainForm: TMainForm Left = 220 Top = 206 - Width = 856 - Height = 605 Caption = 'Virtual Treeview features demo' + ClientHeight = 566 + ClientWidth = 840 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -11,7 +11,6 @@ object MainForm: TMainForm Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False - Position = poScreenCenter OnCreate = FormCreate OnShow = FormShow PixelsPerInch = 96 @@ -996,7 +995,7 @@ object MainForm: TMainForm object Label1: TLabel Left = 14 Top = 28 - Width = 72 + Width = 71 Height = 13 Caption = 'Demo picker' Font.Charset = DEFAULT_CHARSET @@ -1009,7 +1008,7 @@ object MainForm: TMainForm object Label2: TLabel Left = 22 Top = 44 - Width = 196 + Width = 190 Height = 16 Caption = 'Which demo do you want to see?' end @@ -1952,7 +1951,7 @@ object MainForm: TMainForm end object StatusBar: TStatusBar Left = 0 - Top = 547 + Top = 546 Width = 840 Height = 20 AutoHint = True @@ -1963,7 +1962,7 @@ object MainForm: TMainForm Left = 0 Top = 79 Width = 840 - Height = 468 + Height = 467 Align = alClient BevelOuter = bvNone TabOrder = 2 diff --git a/Demos/Advanced/Main.pas b/Demos/Advanced/Main.pas index 04be4fd0a..0e25c824c 100644 --- a/Demos/Advanced/Main.pas +++ b/Demos/Advanced/Main.pas @@ -12,9 +12,10 @@ interface {$warn UNSAFE_CODE off} uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ComCtrls, ToolWin, Buttons, ExtCtrls, StdCtrls, ImgList, ActnList, - StdActns, VirtualTrees; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ToolWin, Vcl.Buttons, + Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ImgList, Vcl.ActnList, + Vcl.StdActns, VirtualTrees; type TMainForm = class(TForm) @@ -56,7 +57,7 @@ procedure SetStatusbarText(const S: string); implementation uses - CommCtrl, + CommCtrl, VirtualTrees.Accessibility, SpeedDemo, GeneralAbilitiesDemo, DrawTreeDemo, PropertiesDemo, GridDemo, VisibilityDemo, AlignDemo, WindowsXPStyleDemo, MultilineDemo, HeaderCustomDrawDemo, States; @@ -138,6 +139,7 @@ procedure TMainForm.FormCreate(Sender: TObject); begin // Show hints 10 seconds. Application.HintHidePause := 10000; + System.ReportMemoryLeaksOnShutdown:= true; end; //---------------------------------------------------------------------------------------------------------------------- @@ -184,11 +186,13 @@ procedure TMainForm.DemoButtonClick(Sender: TObject); if Assigned(NewDemoClass) then begin NewDemo := NewDemoClass.Create(Self); - NewDemo.Hide; NewDemo.BorderStyle := bsNone; - NewDemo.Parent := ContainerPanel; NewDemo.Align := alClient; + NewDemo.Parent := ContainerPanel; NewDemo.Show; + {$if CompilerVersion >= 33} + NewDemo.ScaleForPPI(FCurrentPPI); // See issue #990 + {$endif} end; end; end; diff --git a/Demos/Advanced/MultilineDemo.pas b/Demos/Advanced/MultilineDemo.pas index 529edd1d4..d20ecdf64 100644 --- a/Demos/Advanced/MultilineDemo.pas +++ b/Demos/Advanced/MultilineDemo.pas @@ -8,7 +8,8 @@ interface uses Windows, SysUtils, Classes, Forms, Controls, Graphics, VirtualTrees, - ExtCtrls, StdCtrls, ImgList; + ExtCtrls, StdCtrls, ImgList, VirtualTrees.Types, VirtualTrees.BaseAncestorVCL, + VirtualTrees.BaseTree, VirtualTrees.AncestorVCL; type TNodeForm = class(TForm) @@ -26,7 +27,7 @@ TNodeForm = class(TForm) procedure MLTreeEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); procedure MLTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates); procedure MLTreeMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - var NodeHeight: Integer); + var NodeHeight: TDimension); procedure AutoAdjustCheckBoxClick(Sender: TObject); end; @@ -128,8 +129,8 @@ procedure TNodeForm.MLTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TV //---------------------------------------------------------------------------------------------------------------------- -procedure TNodeForm.MLTreeMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - var NodeHeight: Integer); +procedure TNodeForm.MLTreeMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: + TCanvas; Node: PVirtualNode; var NodeHeight: TDimension); begin if Sender.MultiLine[Node] then @@ -146,9 +147,9 @@ procedure TNodeForm.AutoAdjustCheckBoxClick(Sender: TObject); begin if AutoAdjustCheckBox.Checked then - MLTree.TreeOptions.MiscOptions := MLTree.TreeOptions.MiscOptions + [toVariablenodeHeight] + MLTree.TreeOptions.MiscOptions := MLTree.TreeOptions.MiscOptions + [TVTMiscOption.toVariablenodeHeight] else - MLTree.TreeOptions.MiscOptions := MLTree.TreeOptions.MiscOptions - [toVariablenodeHeight]; + MLTree.TreeOptions.MiscOptions := MLTree.TreeOptions.MiscOptions - [TVTMiscOption.toVariablenodeHeight]; end; //---------------------------------------------------------------------------------------------------------------------- diff --git a/Demos/Advanced/PropertiesDemo.dfm b/Demos/Advanced/PropertiesDemo.dfm index 7a40264de..1f1739d3d 100644 --- a/Demos/Advanced/PropertiesDemo.dfm +++ b/Demos/Advanced/PropertiesDemo.dfm @@ -50,14 +50,8 @@ object PropertiesForm: TPropertiesForm Colors.HotColor = clBlack DefaultNodeHeight = 20 Header.AutoSizeIndex = 1 - Header.Font.Charset = DEFAULT_CHARSET - Header.Font.Color = clWindowText - Header.Font.Height = -11 - Header.Font.Name = 'Tahoma' - Header.Font.Style = [] Header.Height = 18 Header.Options = [hoAutoResize, hoColumnResize, hoVisible, hoAutoSpring] - HintAnimation = hatFade HintMode = hmHint Images = TreeImages IncrementalSearch = isAll @@ -68,7 +62,6 @@ object PropertiesForm: TPropertiesForm ShowHint = True TabOrder = 0 TreeOptions.AnimationOptions = [toAnimatedToggle] - TreeOptions.AutoOptions = [toAutoDropExpand, toAutoTristateTracking, toAutoDeleteMovedNodes] TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning] TreeOptions.SelectionOptions = [toExtendedFocus, toFullRowSelect, toCenterScrollIntoView] TreeOptions.StringOptions = [toAutoAcceptEditChange] @@ -88,14 +81,14 @@ object PropertiesForm: TPropertiesForm item Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAutoSpring] Position = 0 + Text = 'Properties' Width = 203 - WideText = 'Properties' end item Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAutoSpring] Position = 1 + Text = 'Values' Width = 192 - WideText = 'Values' end> end object RadioGroup1: TRadioGroup diff --git a/Demos/Advanced/PropertiesDemo.pas b/Demos/Advanced/PropertiesDemo.pas index d4df8b728..a71c7185f 100644 --- a/Demos/Advanced/PropertiesDemo.pas +++ b/Demos/Advanced/PropertiesDemo.pas @@ -9,8 +9,11 @@ interface uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, VirtualTrees, ImgList, ExtCtrls, UITypes; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, VirtualTrees, + Vcl.ImgList, Vcl.ExtCtrls, System.UITypes, VirtualTrees.BaseTree, + System.ImageList, VirtualTrees.Types, VirtualTrees.BaseAncestorVCL, + VirtualTrees.AncestorVCL; const // Helper message to decouple node change handling from edit handling. diff --git a/Demos/Advanced/SpeedDemo.dfm b/Demos/Advanced/SpeedDemo.dfm index 2a545939f..419af70ac 100644 --- a/Demos/Advanced/SpeedDemo.dfm +++ b/Demos/Advanced/SpeedDemo.dfm @@ -1556,20 +1556,15 @@ object SpeedForm: TSpeedForm Colors.BorderColor = clWindowText Colors.HotColor = clBlack Header.AutoSizeIndex = -1 - Header.Font.Charset = DEFAULT_CHARSET - Header.Font.Color = clWindowText - Header.Font.Height = -11 - Header.Font.Name = 'Tahoma' - Header.Font.Style = [] Header.MainColumn = -1 Header.Options = [hoColumnResize, hoDrag, hoHotTrack] - HintAnimation = hatNone IncrementalSearch = isAll ParentBiDiMode = False ParentShowHint = False ScrollBarOptions.VerticalIncrement = 18 ShowHint = True TabOrder = 0 + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes, toAutoChangeScale] TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] TreeOptions.SelectionOptions = [toMultiSelect] OnChange = VST1Change diff --git a/Demos/Advanced/SpeedDemo.pas b/Demos/Advanced/SpeedDemo.pas index e9900c890..d150230ae 100644 --- a/Demos/Advanced/SpeedDemo.pas +++ b/Demos/Advanced/SpeedDemo.pas @@ -8,8 +8,10 @@ interface uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, VirtualTrees, ExtDlgs, ComCtrls, jpeg, Menus; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, VirtualTrees, + VirtualTrees.Types, Vcl.ExtDlgs, Vcl.ComCtrls, Vcl.Imaging.jpeg, Vcl.Menus, + VirtualTrees.BaseAncestorVCL, VirtualTrees.BaseTree, VirtualTrees.AncestorVCL; type TSpeedForm = class(TForm) @@ -133,9 +135,9 @@ procedure TSpeedForm.SBCheckBoxClick(Sender: TObject); begin if SBCheckBox.Checked then - VST1.TreeOptions.PaintOptions := VST1.TreeOptions.PaintOptions + [toShowBackground] + VST1.TreeOptions.PaintOptions := VST1.TreeOptions.PaintOptions + [TVTPaintOption.toShowBackground] else - VST1.TreeOptions.PaintOptions := VST1.TreeOptions.PaintOptions - [toShowBackground]; + VST1.TreeOptions.PaintOptions := VST1.TreeOptions.PaintOptions - [TVTPaintOption.toShowBackground]; end; //---------------------------------------------------------------------------------------------------------------------- diff --git a/Demos/Advanced/States.dfm b/Demos/Advanced/States.dfm index 5fa972c14..47cc35cca 100644 --- a/Demos/Advanced/States.dfm +++ b/Demos/Advanced/States.dfm @@ -11,9 +11,6 @@ object StateForm: TStateForm Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] - OldCreateOrder = False - Scaled = False - PixelsPerInch = 96 TextHeight = 13 object EnableCheckBox: TCheckBox Left = 10 @@ -129,15 +126,6 @@ object StateForm: TStateForm Enabled = False TabOrder = 5 end - object CheckBox44: TCheckBox - Left = 10 - Top = 84 - Width = 190 - Height = 17 - Caption = 'Mouse wheel scrolling' - Enabled = False - TabOrder = 6 - end end object GroupBox3: TGroupBox Left = 223 diff --git a/Demos/Advanced/States.pas b/Demos/Advanced/States.pas index 70e64552d..480d71a08 100644 --- a/Demos/Advanced/States.pas +++ b/Demos/Advanced/States.pas @@ -3,8 +3,9 @@ interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, VirtualTrees; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, + Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, + VirtualTrees, VirtualTrees.BaseTree; type TStateForm = class(TForm) @@ -21,7 +22,6 @@ TStateForm = class(TForm) CheckBox21: TCheckBox; CheckBox27: TCheckBox; CheckBox43: TCheckBox; - CheckBox44: TCheckBox; GroupBox3: TGroupBox; CheckBox10: TCheckBox; CheckBox11: TCheckBox; @@ -76,6 +76,9 @@ implementation {$R *.dfm} +uses + VirtualTrees.Types; + //---------------------------------------------------------------------------------------------------------------------- procedure UpdateStateDisplay(CurrentStates, Enter, Leave: TVirtualTreeStates); @@ -120,7 +123,6 @@ procedure UpdateStateDisplay(CurrentStates, Enter, Leave: TVirtualTreeStates); SetActiveState(CheckBox32, tsStructureChangePending in NewStates); SetActiveState(CheckBox33, tsSynchMode in NewStates); SetActiveState(CheckBox34, tsThumbTracking in NewStates); - SetActiveState(CheckBox35, tsUpdating in NewStates); SetActiveState(CheckBox36, tsUseCache in NewStates); SetActiveState(CheckBox37, tsUserDragObject in NewStates); SetActiveState(CheckBox38, tsUseThemes in NewStates); @@ -128,8 +130,7 @@ procedure UpdateStateDisplay(CurrentStates, Enter, Leave: TVirtualTreeStates); SetActiveState(CheckBox40, tsValidationNeeded in NewStates); SetActiveState(CheckBox41, tsVCLDragging in NewStates); SetActiveState(CheckBox42, tsVCLDragPending in NewStates); - SetActiveState(CheckBox43, tsWheelPanning in NewStates); - SetActiveState(CheckBox44, tsWheelScrolling in NewStates); + SetActiveState(CheckBox43, tsPanning in NewStates); SetActiveState(CheckBox45, tsWindowCreating in NewStates); SetActiveState(CheckBox46, tsPopupMenuShown in NewStates); @@ -182,7 +183,6 @@ procedure TStateForm.EnableCheckBoxClick(Sender: TObject); CheckBox41.Enabled := EnableCheckBox.Checked; CheckBox42.Enabled := EnableCheckBox.Checked; CheckBox43.Enabled := EnableCheckBox.Checked; - CheckBox44.Enabled := EnableCheckBox.Checked; CheckBox45.Enabled := EnableCheckBox.Checked; CheckBox46.Enabled := EnableCheckBox.Checked; end; diff --git a/Demos/Advanced/VisibilityDemo.dfm b/Demos/Advanced/VisibilityDemo.dfm index 96a9f9f9c..5e831b8b7 100644 --- a/Demos/Advanced/VisibilityDemo.dfm +++ b/Demos/Advanced/VisibilityDemo.dfm @@ -8202,7 +8202,7 @@ object VisibilityForm: TVisibilityForm TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toInitOnSave, toToggleOnDblClick, toWheelPanning] TreeOptions.PaintOptions = [toHideFocusRect, toShowBackground, toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toThemeAware, toUseBlendedImages, toUseBlendedSelection] TreeOptions.SelectionOptions = [toExtendedFocus, toFullRowSelect] - OnChange = VST2Change + OnChange = VST3Change OnCollapsed = VSTCollapsedExpanded OnExpanded = VSTCollapsedExpanded OnFreeNode = VST3FreeNode @@ -8260,6 +8260,7 @@ object VisibilityForm: TVisibilityForm TabOrder = 0 TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoHideButtons, toAutoChangeScale] TreeOptions.SelectionOptions = [toMultiSelect] + OnChange = VST1Change OnFreeNode = VST1FreeNode OnGetText = VST1GetText OnInitChildren = VST1InitChildren diff --git a/Demos/Advanced/VisibilityDemo.pas b/Demos/Advanced/VisibilityDemo.pas index 121abac94..e67f770a6 100644 --- a/Demos/Advanced/VisibilityDemo.pas +++ b/Demos/Advanced/VisibilityDemo.pas @@ -10,8 +10,10 @@ interface uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, VirtualTrees, ComCtrls, ExtCtrls, ImgList; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, VirtualTrees, Vcl.ComCtrls, + Vcl.ExtCtrls, Vcl.ImgList, VirtualTrees.Types, VirtualTrees.BaseAncestorVCL, + VirtualTrees.BaseTree, VirtualTrees.AncestorVCL; type TVisibilityForm = class(TForm) @@ -33,11 +35,12 @@ TVisibilityForm = class(TForm) procedure RadioGroup1Click(Sender: TObject); procedure VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); - procedure VST3Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); + procedure VST3Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: TDimension); procedure VST2InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); - procedure VST2Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); + procedure VST2Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: TDimension); procedure VSTCollapsedExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VST2Change(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure VST3Change(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure Splitter2CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure Splitter2Paint(Sender: TObject); @@ -45,11 +48,15 @@ TVisibilityForm = class(TForm) var CellText: string); procedure FormShow(Sender: TObject); procedure FormHide(Sender: TObject); + procedure VST1Change(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VST3FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VST2FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VST1FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure VSTChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + private FChanging: Boolean; + procedure ShowNode(const Source: string; Node: PVirtualNode); procedure HideNodes(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean); end; @@ -184,7 +191,7 @@ procedure TVisibilityForm.VST2GetText(Sender: TBaseVirtualTree; Node: PVirtualNo //---------------------------------------------------------------------------------------------------------------------- -procedure TVisibilityForm.VST3Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); +procedure TVisibilityForm.VST3Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: TDimension); // Synchronizes scroll offsets of VST2 and VST3. @@ -204,7 +211,7 @@ procedure TVisibilityForm.VST3Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: I //---------------------------------------------------------------------------------------------------------------------- -procedure TVisibilityForm.VST2Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); +procedure TVisibilityForm.VST2Scroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: TDimension); // Synchronizes scroll offsets of VST2 and VST3. @@ -261,7 +268,14 @@ procedure TVisibilityForm.VSTCollapsedExpanded(Sender: TBaseVirtualTree; Node: P //---------------------------------------------------------------------------------------------------------------------- -procedure TVisibilityForm.VST2Change(Sender: TBaseVirtualTree; Node: PVirtualNode); +procedure TVisibilityForm.ShowNode(const Source: string; Node: PVirtualNode); +begin + OutputDebugString(PChar(Format('%s %s Node: %p', [FormatDateTime('hh:nn:ss', Now), Source, Pointer(Node)]))); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVisibilityForm.VSTChange(Sender: TBaseVirtualTree; Node: PVirtualNode); // Keep selected nodes in sync. @@ -290,6 +304,22 @@ procedure TVisibilityForm.VST2Change(Sender: TBaseVirtualTree; Node: PVirtualNod //---------------------------------------------------------------------------------------------------------------------- +procedure TVisibilityForm.VST2Change(Sender: TBaseVirtualTree; Node: PVirtualNode); +begin + ShowNode('VST2', Node); + VSTChange(Sender, Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVisibilityForm.VST3Change(Sender: TBaseVirtualTree; Node: PVirtualNode); +begin + ShowNode('VST3', Node); + VSTChange(Sender, Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + procedure TVisibilityForm.Splitter2CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); // This method is called just before resizing is done. This is a good opportunity to adjust the background image @@ -338,6 +368,12 @@ procedure TVisibilityForm.FormHide(Sender: TObject); StateForm.Show; end; +procedure TVisibilityForm.VST1Change(Sender: TBaseVirtualTree; Node: + PVirtualNode); +begin + ShowNode('VST1', Node); +end; + //---------------------------------------------------------------------------------------------------------------------- procedure TVisibilityForm.VST1FreeNode(Sender: TBaseVirtualTree; diff --git a/Demos/Advanced/WindowsXPStyleDemo.dfm b/Demos/Advanced/WindowsXPStyleDemo.dfm index 99bddea06..54dec20d0 100644 --- a/Demos/Advanced/WindowsXPStyleDemo.dfm +++ b/Demos/Advanced/WindowsXPStyleDemo.dfm @@ -9,100 +9,97 @@ object WindowsXPForm: TWindowsXPForm Font.Height = -13 Font.Name = 'Microsoft Sans Serif' Font.Style = [] - OldCreateOrder = False OnCreate = FormCreate - DesignSize = ( - 796 - 487) - PixelsPerInch = 96 TextHeight = 16 - object Label1: TLabel - Left = 512 - Top = 68 - Width = 244 - Height = 105 - Anchors = [akTop, akRight] - AutoSize = False - Caption = - 'This demo shows a tree with properties which make it look as in ' + - 'the Windows Vista+ style. Under Windows Vista+ native theme APIs' + - ' are used to paint the tree. On other system legacy code is used' + - ' which simulates the look.' - Transparent = True - WordWrap = True - end - object XPTree: TVirtualStringTree + object Panel1: TPanel Left = 0 Top = 40 - Width = 493 + Width = 796 Height = 447 - Align = alLeft - Anchors = [akLeft, akTop, akRight, akBottom] - AutoScrollDelay = 500 - BevelInner = bvNone - ButtonFillMode = fmShaded - ClipboardFormats.Strings = ( - 'CSV' - 'HTML Format') - Colors.DropTargetColor = 7063465 - Colors.DropTargetBorderColor = 4958089 - Colors.FocusedSelectionColor = clActiveCaption - Colors.FocusedSelectionBorderColor = clActiveCaption - Colors.GridLineColor = clBtnShadow - Colors.UnfocusedSelectionBorderColor = clBtnShadow - DefaultNodeHeight = 34 - DragMode = dmAutomatic - DrawSelectionMode = smBlendedRectangle - Header.AutoSizeIndex = -1 - Header.Font.Charset = ANSI_CHARSET - Header.Font.Color = clWindowText - Header.Font.Height = -12 - Header.Font.Name = 'Microsoft Sans Serif' - Header.Font.Style = [] - Header.Height = 24 - Header.Options = [hoColumnResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible] - HintAnimation = hatFade - HintMode = hmHint - Images = LargeImages - ParentShowHint = False - RootNodeCount = 18 - ShowHint = True - StateImages = SmallImages - TabOrder = 0 - TreeOptions.AnimationOptions = [toAnimatedToggle] - TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking] - TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toInitOnSave, toReportMode, toToggleOnDblClick, toWheelPanning] - TreeOptions.PaintOptions = [toHideFocusRect, toHotTrack, toShowButtons, toShowDropmark, toShowRoot, toThemeAware, toUseExplorerTheme] - TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect, toSimpleDrawSelection] - OnCompareNodes = XPTreeCompareNodes - OnFreeNode = XPTreeFreeNode - OnGetText = XPTreeGetText - OnGetImageIndex = XPTreeGetImageIndex - OnGetHint = XPTreeGetHint - OnHeaderClick = XPTreeHeaderClick - OnInitChildren = XPTreeInitChildren - OnInitNode = XPTreeInitNode - OnStateChange = XPTreeStateChange - ExplicitTop = 36 - ExplicitHeight = 451 - Columns = < - item - Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible] - Position = 0 - Width = 200 - WideText = 'Name' - end - item - Alignment = taRightJustify - Position = 1 - Width = 100 - WideText = 'Size' - end - item - Position = 2 - Width = 100 - WideText = 'Type' - end> + Align = alClient + Caption = 'Panel1' + TabOrder = 1 + object Label1: TLabel + Left = 551 + Top = 1 + Width = 244 + Height = 445 + Align = alRight + AutoSize = False + Caption = + 'This demo shows a tree with properties which make it look as in ' + + 'the Windows Vista+ style. Under Windows Vista+ native theme APIs' + + ' are used to paint the tree. On other system legacy code is used' + + ' which simulates the look.' + Transparent = True + WordWrap = True + end + object XPTree: TVirtualStringTree + Left = 1 + Top = 1 + Width = 550 + Height = 445 + Align = alClient + AutoScrollDelay = 500 + BevelInner = bvNone + ButtonFillMode = fmShaded + ClipboardFormats.Strings = ( + 'CSV' + 'HTML Format') + Colors.DropTargetColor = 7063465 + Colors.DropTargetBorderColor = 4958089 + Colors.FocusedSelectionColor = clActiveCaption + Colors.FocusedSelectionBorderColor = clActiveCaption + Colors.GridLineColor = clBtnShadow + Colors.UnfocusedSelectionBorderColor = clBtnShadow + DefaultNodeHeight = 34 + DragMode = dmAutomatic + DrawSelectionMode = smBlendedRectangle + Header.AutoSizeIndex = -1 + Header.Height = 24 + Header.Options = [hoColumnResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible, hoAutoColumnPopupMenu] + HintMode = hmTooltip + Images = LargeImages + ParentShowHint = False + RootNodeCount = 18 + ShowHint = True + StateImages = SmallImages + TabOrder = 0 + TreeOptions.AnimationOptions = [toAnimatedToggle] + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking] + TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toInitOnSave, toReportMode, toToggleOnDblClick, toWheelPanning] + TreeOptions.PaintOptions = [toHideFocusRect, toHotTrack, toShowButtons, toShowDropmark, toShowRoot, toThemeAware, toUseExplorerTheme] + TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect, toSimpleDrawSelection] + OnCompareNodes = XPTreeCompareNodes + OnFreeNode = XPTreeFreeNode + OnGetText = XPTreeGetText + OnGetImageIndex = XPTreeGetImageIndex + OnGetHint = XPTreeGetHint + OnHeaderClick = XPTreeHeaderClick + OnInitChildren = XPTreeInitChildren + OnInitNode = XPTreeInitNode + OnStateChange = XPTreeStateChange + Touch.InteractiveGestures = [igPan, igPressAndTap] + Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough] + Columns = < + item + Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible] + Position = 0 + Text = 'Name' + Width = 200 + end + item + Alignment = taRightJustify + Position = 1 + Text = 'Size' + Width = 100 + end + item + Position = 2 + Text = 'Type' + Width = 100 + end> + end end object CoolBar1: TCoolBar Left = 0 @@ -142,39 +139,39 @@ object WindowsXPForm: TWindowsXPForm Style = tbsDropDown end object ToolButton2: TToolButton - Left = 63 + Left = 67 Top = 0 AutoSize = True ImageIndex = 10 Style = tbsDropDown end object ToolButton3: TToolButton - Left = 126 + Left = 134 Top = 0 AutoSize = True ImageIndex = 18 end object ToolButton4: TToolButton - Left = 168 + Left = 176 Top = 0 AutoSize = True ImageIndex = 14 end object ToolButton5: TToolButton - Left = 210 + Left = 218 Top = 0 AutoSize = True ImageIndex = 21 end object ToolButton6: TToolButton - Left = 252 + Left = 260 Top = 0 AutoSize = True ImageIndex = 8 Style = tbsDropDown end object ToolButton8: TToolButton - Left = 315 + Left = 327 Top = 0 Width = 8 Caption = 'ToolButton8' @@ -182,7 +179,7 @@ object WindowsXPForm: TWindowsXPForm Style = tbsSeparator end object ToolButton9: TToolButton - Left = 323 + Left = 335 Top = 0 AutoSize = True Caption = 'Click here to print the treeview.' @@ -197,7 +194,7 @@ object WindowsXPForm: TWindowsXPForm Left = 368 Top = 304 Bitmap = { - 494C0101120013000C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010112001300040020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000080000000A000000001002000000000000040 0100000000000000000000000000000000000000000000000000000000000000 000000000000FBFFFF00000000000000000000000000FFFBFF00D3D6D600A7A7 @@ -2850,7 +2847,7 @@ object WindowsXPForm: TWindowsXPForm Left = 368 Top = 336 Bitmap = { - 494C01011B001D000C0018001800FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C01011B001D00040018001800FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000060000000A8000000010020000000000000FC 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000C4C4C4009996970099969700D1D1 diff --git a/Demos/Advanced/WindowsXPStyleDemo.pas b/Demos/Advanced/WindowsXPStyleDemo.pas index 71d318edc..96f0c611e 100644 --- a/Demos/Advanced/WindowsXPStyleDemo.pas +++ b/Demos/Advanced/WindowsXPStyleDemo.pas @@ -11,8 +11,11 @@ interface {$warn UNSAFE_CODE off} uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, - Dialogs, VirtualTrees, ImgList, ComCtrls, ToolWin, Menus, StdCtrls, UITypes; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.ImgList, Vcl.ComCtrls, + Vcl.ToolWin, Vcl.Menus, Vcl.StdCtrls, System.UITypes, System.ImageList, + VirtualTrees.Types, Vcl.ExtCtrls, VirtualTrees.BaseAncestorVCL, + VirtualTrees.BaseTree, VirtualTrees.AncestorVCL; type TWindowsXPForm = class(TForm) @@ -31,6 +34,7 @@ TWindowsXPForm = class(TForm) ToolButton8: TToolButton; ToolButton9: TToolButton; PrintDialog: TPrintDialog; + Panel1: TPanel; procedure XPTreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var Index: TImageIndex); procedure FormCreate(Sender: TObject); @@ -121,7 +125,7 @@ procedure TWindowsXPForm.FormCreate(Sender: TObject); begin XPTree.NodeDataSize := SizeOf(TEntry); - + XPTree.HintMode := hmTooltip; ConvertToHighColor(LargeImages); ConvertToHighColor(SmallImages); end; @@ -188,10 +192,10 @@ procedure TWindowsXPForm.XPTreeHeaderClick(Sender: TVTHeader; HitInfo: TVTHeader begin if HitInfo.Button = mbLeft then begin - with Sender, Treeview do + with Sender do begin if SortColumn > NoColumn then - Columns[SortColumn].Options := Columns[SortColumn].Options + [coParentColor]; + Columns[SortColumn].Options := Columns[SortColumn].Options + [TVTColumnOption.coParentColor]; // Do not sort the last column, it contains nothing to sort. if HitInfo.Column = 2 then @@ -212,7 +216,7 @@ procedure TWindowsXPForm.XPTreeHeaderClick(Sender: TVTHeader; HitInfo: TVTHeader if SortColumn <> NoColumn then begin Columns[SortColumn].Color := GetShadowColor(ColorToRGB(XPTree.Colors.BackGroundColor), -32); end; - SortTree(SortColumn, SortDirection, True); + TBaseVirtualTree(Sender.Treeview).SortTree(SortColumn, SortDirection, True); end; end; @@ -248,6 +252,7 @@ procedure TWindowsXPForm.XPTreeGetHint(Sender: TBaseVirtualTree; Node: PVirtualN HintText := 'Size larger than 536 MB' + #13 + 'Folders: addins, AppPatch, Config, Connection Wizard, ...' + #13 + 'Files: 1280.bmp, 1280x1024.bmp, 2001 94 mars.bmp, ac3api.ini, ...'; + LineBreakStyle := TVTTooltipLineBreakStyle.hlbForceMultiLine; end; //---------------------------------------------------------------------------------------------------------------------- diff --git a/Demos/Interfaces/charityevents.dpr b/Demos/Interfaces/charityevents.dpr index 6013031ff..4e2a9eb7e 100644 --- a/Demos/Interfaces/charityevents.dpr +++ b/Demos/Interfaces/charityevents.dpr @@ -1,17 +1,18 @@ -program charityevents; - -uses - Vcl.Forms, - modelviewform in 'modelviewform.pas' {FormModelView}, - myeventdata in 'myeventdata.pas', - myevents in 'myevents.pas'; - -{$R *.res} - -begin - ReportMemoryLeaksOnShutdown := True; - Application.Initialize; - Application.MainFormOnTaskbar := True; - Application.CreateForm(TFormModelView, FormModelView); - Application.Run; -end. +program charityevents; + +uses + Vcl.Forms, + modelviewform in 'modelviewform.pas' {FormModelView} , + myeventdata in 'myeventdata.pas', + myevents in 'myevents.pas'; + +{$R *.res} + +begin + ReportMemoryLeaksOnShutdown := True; + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TFormModelView, FormModelView); + Application.Run; + +end. diff --git a/Demos/Interfaces/charityevents.dproj b/Demos/Interfaces/charityevents.dproj index 98d75a8c5..12c050aa9 100644 --- a/Demos/Interfaces/charityevents.dproj +++ b/Demos/Interfaces/charityevents.dproj @@ -1,171 +1,178 @@ - - - {527B0DE7-5A48-4EA5-9810-F0952ADD7A9C} - 14.6 - VCL - charityevents.dpr - True - Debug - Win32 - 1 - Application - - - true - ..\..\Source;$(DCC_UnitSearchPath) - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - ..\..\Source;$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - $(BDS)\bin\delphi_PROJECTICON.ico - .\$(Platform)\$(Config) - .\$(Platform)\$(Config) - false - false - false - false - false - - - true - dxBarRS18;dxPSCoreRS18;dxSkinOffice2007GreenRS18;dxPScxPCProdRS18;dxSkinBlueRS18;cxTreeListRS18;frxDB18;dxDockingRS18;dxThemeRS18;dxPSdxOCLnkRS18;dxSkinsdxRibbonPainterRS18;dxSkinOffice2007BlueRS18;DBXInterBaseDriver;DataSnapCommon;cxTreeListdxBarPopupMenuRS18;dxSkinsdxBarPainterRS18;dxGaugeControlRS18;DbxCommonDriver;vclimg;dxPSdxGaugeControlLnkRS18;dbxcds;dxSkinscxPCPainterRS18;vcldb;dxSkinDarkRoomRS18;cxExportRS18;dxSkinVisualStudio2013BlueRS18;CustomIPTransport;dxSkinBlueprintRS18;dsnap;IndyIPServer;dxSkinOffice2010BlueRS18;IndyCore;cxVerticalGridRS18;CloudService;dxPSdxDBOCLnkRS18;FmxTeeUI;dxADOServerModeRS18;dxSkinDarkSideRS18;dxPScxExtCommonRS18;cxSchedulerRibbonStyleEventEditorRS18;cxEditorsRS18;cxSchedulerRS18;dxSpellCheckerRS18;dxPScxVGridLnkRS18;dxSkinSharpPlusRS18;dxSkinValentineRS18;dxRibbonRS18;dxSkinGlassOceansRS18;bindcompfmx;FMXfrxDB18;vcldbx;dxRibbonCustomizationFormRS18;cxPageControlRS18;dxSkinSharpRS18;dbrtl;dxSkinDevExpressDarkStyleRS18;bindcomp;dxMapControlRS18;dxSkinVisualStudio2013LightRS18;dxSkinXmas2008BlueRS18;dxPSdxSpreadSheetLnkRS18;xmlrtl;ibxpress;dxBarExtItemsRS18;frxe18;dxSkinLiquidSkyRS18;dxSkinPumpkinRS18;dxSkinOffice2013WhiteRS18;vclactnband;bindengine;soaprtl;FMXTee;dxSkinMetropolisRS18;bindcompvcl;dxPsPrVwAdvRS18;cxPivotGridRS18;vclie;dxmdsRS18;dxBarDBNavRS18;dxTileControlRS18;dxComnRS18;dxWizardControlRS18;dxBarExtDBItemsRS18;dxPScxSchedulerLnkRS18;dxNavBarRS18;dsnapcon;dxPSTeeChartRS18;inet;dxSkinOffice2016DarkRS18;dxSkinscxSchedulerPainterRS18;dxPScxCommonRS18;dxSkinWhiteprintRS18;vclx;dxorgcRS18;dbexpress;dxSkinOffice2007BlackRS18;dxSkinSummer2008RS18;IndyIPClient;dxSkinBlackRS18;dxGDIPlusRS18;dxSkinCoffeeRS18;dxLayoutControlRS18;dxSkinMoneyTwinsRS18;dxSkinVS2010RS18;DBXSqliteDriver;dxPSdxMapControlLnkRS18;FMXfrx18;fmx;IndySystem;TeeDB;frx18;inetdbbde;vclib;dxPScxTLLnkRS18;dxSkinOffice2013DarkGrayRS18;cxSchedulerGridRS18;dxtrmdRS18;dxSkinSilverRS18;dxHttpIndyRequestRS18;dxTabbedMDIRS18;MetropolisUILiveTile;dxPSLnksRS18;vcldsnap;dxPScxPivotGridLnkRS18;dxSkinVisualStudio2013DarkRS18;dxSkinOffice2010SilverRS18;dxServerModeRS18;vclribbon;dxdborRS18;dxRichEditControlRS18;dxSkinsdxDLPainterRS18;fmxase;vcl;IndyIPCommon;cxPivotGridChartRS18;inetdbxpress;webdsnap;dxPScxGridLnkRS18;dxSkinsCoreRS18;dxSkinLondonLiquidSkyRS18;cxLibraryRS18;dxSpreadSheetConditionalFormattingDialogsRS18;adortl;dxSkinOffice2013LightGrayRS18;dxSkinDevExpressStyleRS18;dxSkinTheAsphaltWorldRS18;dxSkinSpringTimeRS18;dxSkinHighContrastRS18;dxPSdxDBTVLnkRS18;dxSpreadSheetRS18;dxSkinCaramelRS18;dxSkinOffice2007SilverRS18;rtl;DbxClientDriver;dxSkinMetropolisDarkRS18;Tee;dxSkinStardustRS18;svnui;dxDBXServerModeRS18;IndyProtocols;DBXMySQLDriver;dxSkiniMaginaryRS18;dxSkinOffice2016ColorfulRS18;dxFlowChartRS18;dxPSRichEditControlLnkRS18;bindcompdbx;TeeUI;dxSkinMcSkinRS18;vcltouch;dxPSPrVwRibbonRS18;dxSkinOffice2007PinkRS18;dxPSdxFCLnkRS18;VclSmp;cxGridRS18;dxSkinSevenRS18;dxSkinOffice2010BlackRS18;cxSchedulerTreeBrowserRS18;dxPSDBTeeChartRS18;dxdbtrRS18;dxCoreRS18;fmxobj;dxSkinFoggyRS18;dxSkinSevenClassicRS18;dxSkinsdxNavBarPainterRS18;svn;dxSkinLilianRS18;dxPSdxLCLnkRS18;fmxdae;cxPivotGridOLAPRS18;cxDataRS18;bdertl;frxTee18;VirtualTreesR;$(DCC_UsePackage) - 1033 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - $(BDS)\bin\default_app.manifest - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - dxBarRS18;dxPSCoreRS18;dxSkinOffice2007GreenRS18;dxPScxPCProdRS18;dxSkinBlueRS18;cxTreeListRS18;dxDockingRS18;dxThemeRS18;dxPSdxOCLnkRS18;dxSkinsdxRibbonPainterRS18;dxSkinOffice2007BlueRS18;DBXInterBaseDriver;DataSnapCommon;cxTreeListdxBarPopupMenuRS18;dxSkinsdxBarPainterRS18;dxGaugeControlRS18;DbxCommonDriver;vclimg;dxPSdxGaugeControlLnkRS18;dbxcds;dxSkinscxPCPainterRS18;vcldb;dxSkinDarkRoomRS18;cxExportRS18;dxSkinVisualStudio2013BlueRS18;CustomIPTransport;dxSkinBlueprintRS18;dsnap;IndyIPServer;dxSkinOffice2010BlueRS18;IndyCore;cxVerticalGridRS18;CloudService;dxPSdxDBOCLnkRS18;FmxTeeUI;dxADOServerModeRS18;dxSkinDarkSideRS18;dxPScxExtCommonRS18;cxSchedulerRibbonStyleEventEditorRS18;cxEditorsRS18;cxSchedulerRS18;dxSpellCheckerRS18;dxPScxVGridLnkRS18;dxSkinSharpPlusRS18;dxSkinValentineRS18;dxRibbonRS18;dxSkinGlassOceansRS18;bindcompfmx;dxRibbonCustomizationFormRS18;cxPageControlRS18;dxSkinSharpRS18;dbrtl;dxSkinDevExpressDarkStyleRS18;bindcomp;dxMapControlRS18;dxSkinVisualStudio2013LightRS18;dxSkinXmas2008BlueRS18;dxPSdxSpreadSheetLnkRS18;xmlrtl;ibxpress;dxBarExtItemsRS18;dxSkinLiquidSkyRS18;dxSkinPumpkinRS18;dxSkinOffice2013WhiteRS18;vclactnband;bindengine;soaprtl;FMXTee;dxSkinMetropolisRS18;bindcompvcl;dxPsPrVwAdvRS18;cxPivotGridRS18;vclie;dxmdsRS18;dxBarDBNavRS18;dxTileControlRS18;dxComnRS18;dxWizardControlRS18;dxBarExtDBItemsRS18;dxPScxSchedulerLnkRS18;dxNavBarRS18;dsnapcon;dxPSTeeChartRS18;inet;dxSkinOffice2016DarkRS18;dxSkinscxSchedulerPainterRS18;dxPScxCommonRS18;dxSkinWhiteprintRS18;vclx;dxorgcRS18;dbexpress;dxSkinOffice2007BlackRS18;dxSkinSummer2008RS18;IndyIPClient;dxSkinBlackRS18;dxGDIPlusRS18;dxSkinCoffeeRS18;dxLayoutControlRS18;dxSkinMoneyTwinsRS18;dxSkinVS2010RS18;DBXSqliteDriver;dxPSdxMapControlLnkRS18;fmx;IndySystem;TeeDB;vclib;dxPScxTLLnkRS18;dxSkinOffice2013DarkGrayRS18;cxSchedulerGridRS18;dxtrmdRS18;dxSkinSilverRS18;dxHttpIndyRequestRS18;dxTabbedMDIRS18;MetropolisUILiveTile;dxPSLnksRS18;vcldsnap;dxPScxPivotGridLnkRS18;dxSkinVisualStudio2013DarkRS18;dxSkinOffice2010SilverRS18;dxServerModeRS18;vclribbon;dxdborRS18;dxRichEditControlRS18;dxSkinsdxDLPainterRS18;fmxase;vcl;IndyIPCommon;cxPivotGridChartRS18;inetdbxpress;webdsnap;dxPScxGridLnkRS18;dxSkinsCoreRS18;dxSkinLondonLiquidSkyRS18;cxLibraryRS18;dxSpreadSheetConditionalFormattingDialogsRS18;adortl;dxSkinOffice2013LightGrayRS18;dxSkinDevExpressStyleRS18;dxSkinTheAsphaltWorldRS18;dxSkinSpringTimeRS18;dxSkinHighContrastRS18;dxPSdxDBTVLnkRS18;dxSpreadSheetRS18;dxSkinCaramelRS18;dxSkinOffice2007SilverRS18;rtl;DbxClientDriver;dxSkinMetropolisDarkRS18;Tee;dxSkinStardustRS18;dxDBXServerModeRS18;IndyProtocols;DBXMySQLDriver;dxSkiniMaginaryRS18;dxSkinOffice2016ColorfulRS18;dxFlowChartRS18;dxPSRichEditControlLnkRS18;bindcompdbx;TeeUI;dxSkinMcSkinRS18;vcltouch;dxPSPrVwRibbonRS18;dxSkinOffice2007PinkRS18;dxPSdxFCLnkRS18;VclSmp;cxGridRS18;dxSkinSevenRS18;dxSkinOffice2010BlackRS18;cxSchedulerTreeBrowserRS18;dxPSDBTeeChartRS18;dxdbtrRS18;dxCoreRS18;fmxobj;dxSkinFoggyRS18;dxSkinSevenClassicRS18;dxSkinsdxNavBarPainterRS18;dxSkinLilianRS18;dxPSdxLCLnkRS18;fmxdae;cxPivotGridOLAPRS18;cxDataRS18;VirtualTreesR;$(DCC_UsePackage) - - - DEBUG;$(DCC_Define) - true - false - true - true - true - - - true - 1033 - false - - - false - RELEASE;$(DCC_Define) - 0 - false - - - - MainSource - - -
FormModelView
- dfm - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - - - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1033 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - - - - - - - - - - - - - - charityevents.dpr - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - - - - - True - False - - - 12 - - - - + + + {527B0DE7-5A48-4EA5-9810-F0952ADD7A9C} + 20.2 + VCL + charityevents.dpr + True + Debug + Win32 + 1 + Application + charityevents + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + ..\..\Source;$(DCC_UnitSearchPath) + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + charityevents + + + true + dxBarRS18;dxPSCoreRS18;dxSkinOffice2007GreenRS18;dxPScxPCProdRS18;dxSkinBlueRS18;cxTreeListRS18;frxDB18;dxDockingRS18;dxThemeRS18;dxPSdxOCLnkRS18;dxSkinsdxRibbonPainterRS18;dxSkinOffice2007BlueRS18;DBXInterBaseDriver;DataSnapCommon;cxTreeListdxBarPopupMenuRS18;dxSkinsdxBarPainterRS18;dxGaugeControlRS18;DbxCommonDriver;vclimg;dxPSdxGaugeControlLnkRS18;dbxcds;dxSkinscxPCPainterRS18;vcldb;dxSkinDarkRoomRS18;cxExportRS18;dxSkinVisualStudio2013BlueRS18;CustomIPTransport;dxSkinBlueprintRS18;dsnap;IndyIPServer;dxSkinOffice2010BlueRS18;IndyCore;cxVerticalGridRS18;CloudService;dxPSdxDBOCLnkRS18;FmxTeeUI;dxADOServerModeRS18;dxSkinDarkSideRS18;dxPScxExtCommonRS18;cxSchedulerRibbonStyleEventEditorRS18;cxEditorsRS18;cxSchedulerRS18;dxSpellCheckerRS18;dxPScxVGridLnkRS18;dxSkinSharpPlusRS18;dxSkinValentineRS18;dxRibbonRS18;dxSkinGlassOceansRS18;bindcompfmx;FMXfrxDB18;vcldbx;dxRibbonCustomizationFormRS18;cxPageControlRS18;dxSkinSharpRS18;dbrtl;dxSkinDevExpressDarkStyleRS18;bindcomp;dxMapControlRS18;dxSkinVisualStudio2013LightRS18;dxSkinXmas2008BlueRS18;dxPSdxSpreadSheetLnkRS18;xmlrtl;ibxpress;dxBarExtItemsRS18;frxe18;dxSkinLiquidSkyRS18;dxSkinPumpkinRS18;dxSkinOffice2013WhiteRS18;vclactnband;bindengine;soaprtl;FMXTee;dxSkinMetropolisRS18;bindcompvcl;dxPsPrVwAdvRS18;cxPivotGridRS18;vclie;dxmdsRS18;dxBarDBNavRS18;dxTileControlRS18;dxComnRS18;dxWizardControlRS18;dxBarExtDBItemsRS18;dxPScxSchedulerLnkRS18;dxNavBarRS18;dsnapcon;dxPSTeeChartRS18;inet;dxSkinOffice2016DarkRS18;dxSkinscxSchedulerPainterRS18;dxPScxCommonRS18;dxSkinWhiteprintRS18;vclx;dxorgcRS18;dbexpress;dxSkinOffice2007BlackRS18;dxSkinSummer2008RS18;IndyIPClient;dxSkinBlackRS18;dxGDIPlusRS18;dxSkinCoffeeRS18;dxLayoutControlRS18;dxSkinMoneyTwinsRS18;dxSkinVS2010RS18;DBXSqliteDriver;dxPSdxMapControlLnkRS18;FMXfrx18;fmx;IndySystem;TeeDB;frx18;inetdbbde;vclib;dxPScxTLLnkRS18;dxSkinOffice2013DarkGrayRS18;cxSchedulerGridRS18;dxtrmdRS18;dxSkinSilverRS18;dxHttpIndyRequestRS18;dxTabbedMDIRS18;MetropolisUILiveTile;dxPSLnksRS18;vcldsnap;dxPScxPivotGridLnkRS18;dxSkinVisualStudio2013DarkRS18;dxSkinOffice2010SilverRS18;dxServerModeRS18;vclribbon;dxdborRS18;dxRichEditControlRS18;dxSkinsdxDLPainterRS18;fmxase;vcl;IndyIPCommon;cxPivotGridChartRS18;inetdbxpress;webdsnap;dxPScxGridLnkRS18;dxSkinsCoreRS18;dxSkinLondonLiquidSkyRS18;cxLibraryRS18;dxSpreadSheetConditionalFormattingDialogsRS18;adortl;dxSkinOffice2013LightGrayRS18;dxSkinDevExpressStyleRS18;dxSkinTheAsphaltWorldRS18;dxSkinSpringTimeRS18;dxSkinHighContrastRS18;dxPSdxDBTVLnkRS18;dxSpreadSheetRS18;dxSkinCaramelRS18;dxSkinOffice2007SilverRS18;rtl;DbxClientDriver;dxSkinMetropolisDarkRS18;Tee;dxSkinStardustRS18;svnui;dxDBXServerModeRS18;IndyProtocols;DBXMySQLDriver;dxSkiniMaginaryRS18;dxSkinOffice2016ColorfulRS18;dxFlowChartRS18;dxPSRichEditControlLnkRS18;bindcompdbx;TeeUI;dxSkinMcSkinRS18;vcltouch;dxPSPrVwRibbonRS18;dxSkinOffice2007PinkRS18;dxPSdxFCLnkRS18;VclSmp;cxGridRS18;dxSkinSevenRS18;dxSkinOffice2010BlackRS18;cxSchedulerTreeBrowserRS18;dxPSDBTeeChartRS18;dxdbtrRS18;dxCoreRS18;fmxobj;dxSkinFoggyRS18;dxSkinSevenClassicRS18;dxSkinsdxNavBarPainterRS18;svn;dxSkinLilianRS18;dxPSdxLCLnkRS18;fmxdae;cxPivotGridOLAPRS18;cxDataRS18;bdertl;frxTee18;VirtualTreesR;$(DCC_UsePackage) + 1033 + 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\default_app.manifest + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + dxBarRS18;dxPSCoreRS18;dxSkinOffice2007GreenRS18;dxPScxPCProdRS18;dxSkinBlueRS18;cxTreeListRS18;dxDockingRS18;dxThemeRS18;dxPSdxOCLnkRS18;dxSkinsdxRibbonPainterRS18;dxSkinOffice2007BlueRS18;DBXInterBaseDriver;DataSnapCommon;cxTreeListdxBarPopupMenuRS18;dxSkinsdxBarPainterRS18;dxGaugeControlRS18;DbxCommonDriver;vclimg;dxPSdxGaugeControlLnkRS18;dbxcds;dxSkinscxPCPainterRS18;vcldb;dxSkinDarkRoomRS18;cxExportRS18;dxSkinVisualStudio2013BlueRS18;CustomIPTransport;dxSkinBlueprintRS18;dsnap;IndyIPServer;dxSkinOffice2010BlueRS18;IndyCore;cxVerticalGridRS18;CloudService;dxPSdxDBOCLnkRS18;FmxTeeUI;dxADOServerModeRS18;dxSkinDarkSideRS18;dxPScxExtCommonRS18;cxSchedulerRibbonStyleEventEditorRS18;cxEditorsRS18;cxSchedulerRS18;dxSpellCheckerRS18;dxPScxVGridLnkRS18;dxSkinSharpPlusRS18;dxSkinValentineRS18;dxRibbonRS18;dxSkinGlassOceansRS18;bindcompfmx;dxRibbonCustomizationFormRS18;cxPageControlRS18;dxSkinSharpRS18;dbrtl;dxSkinDevExpressDarkStyleRS18;bindcomp;dxMapControlRS18;dxSkinVisualStudio2013LightRS18;dxSkinXmas2008BlueRS18;dxPSdxSpreadSheetLnkRS18;xmlrtl;ibxpress;dxBarExtItemsRS18;dxSkinLiquidSkyRS18;dxSkinPumpkinRS18;dxSkinOffice2013WhiteRS18;vclactnband;bindengine;soaprtl;FMXTee;dxSkinMetropolisRS18;bindcompvcl;dxPsPrVwAdvRS18;cxPivotGridRS18;vclie;dxmdsRS18;dxBarDBNavRS18;dxTileControlRS18;dxComnRS18;dxWizardControlRS18;dxBarExtDBItemsRS18;dxPScxSchedulerLnkRS18;dxNavBarRS18;dsnapcon;dxPSTeeChartRS18;inet;dxSkinOffice2016DarkRS18;dxSkinscxSchedulerPainterRS18;dxPScxCommonRS18;dxSkinWhiteprintRS18;vclx;dxorgcRS18;dbexpress;dxSkinOffice2007BlackRS18;dxSkinSummer2008RS18;IndyIPClient;dxSkinBlackRS18;dxGDIPlusRS18;dxSkinCoffeeRS18;dxLayoutControlRS18;dxSkinMoneyTwinsRS18;dxSkinVS2010RS18;DBXSqliteDriver;dxPSdxMapControlLnkRS18;fmx;IndySystem;TeeDB;vclib;dxPScxTLLnkRS18;dxSkinOffice2013DarkGrayRS18;cxSchedulerGridRS18;dxtrmdRS18;dxSkinSilverRS18;dxHttpIndyRequestRS18;dxTabbedMDIRS18;MetropolisUILiveTile;dxPSLnksRS18;vcldsnap;dxPScxPivotGridLnkRS18;dxSkinVisualStudio2013DarkRS18;dxSkinOffice2010SilverRS18;dxServerModeRS18;vclribbon;dxdborRS18;dxRichEditControlRS18;dxSkinsdxDLPainterRS18;fmxase;vcl;IndyIPCommon;cxPivotGridChartRS18;inetdbxpress;webdsnap;dxPScxGridLnkRS18;dxSkinsCoreRS18;dxSkinLondonLiquidSkyRS18;cxLibraryRS18;dxSpreadSheetConditionalFormattingDialogsRS18;adortl;dxSkinOffice2013LightGrayRS18;dxSkinDevExpressStyleRS18;dxSkinTheAsphaltWorldRS18;dxSkinSpringTimeRS18;dxSkinHighContrastRS18;dxPSdxDBTVLnkRS18;dxSpreadSheetRS18;dxSkinCaramelRS18;dxSkinOffice2007SilverRS18;rtl;DbxClientDriver;dxSkinMetropolisDarkRS18;Tee;dxSkinStardustRS18;dxDBXServerModeRS18;IndyProtocols;DBXMySQLDriver;dxSkiniMaginaryRS18;dxSkinOffice2016ColorfulRS18;dxFlowChartRS18;dxPSRichEditControlLnkRS18;bindcompdbx;TeeUI;dxSkinMcSkinRS18;vcltouch;dxPSPrVwRibbonRS18;dxSkinOffice2007PinkRS18;dxPSdxFCLnkRS18;VclSmp;cxGridRS18;dxSkinSevenRS18;dxSkinOffice2010BlackRS18;cxSchedulerTreeBrowserRS18;dxPSDBTeeChartRS18;dxdbtrRS18;dxCoreRS18;fmxobj;dxSkinFoggyRS18;dxSkinSevenClassicRS18;dxSkinsdxNavBarPainterRS18;dxSkinLilianRS18;dxPSdxLCLnkRS18;fmxdae;cxPivotGridOLAPRS18;cxDataRS18;VirtualTreesR;$(DCC_UsePackage) + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + true + 1033 + false + Debug + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + +
FormModelView
+ dfm + + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1033 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + charityevents.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + True + False + + + 12 + + + + + diff --git a/Demos/Interfaces/modelviewform.dfm b/Demos/Interfaces/modelviewform.dfm index fbdf7fdff..94d489570 100644 --- a/Demos/Interfaces/modelviewform.dfm +++ b/Demos/Interfaces/modelviewform.dfm @@ -1,2169 +1,2169 @@ -object FormModelView: TFormModelView - Left = 0 - Top = 0 - Caption = 'Charity Events' - ClientHeight = 532 - ClientWidth = 872 - Color = clBtnFace - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Segoe UI' - Font.Style = [] - OldCreateOrder = False - Position = poScreenCenter - OnCreate = FormCreate - PixelsPerInch = 96 - TextHeight = 13 - object Label1: TLabel - Left = 520 - Top = 456 - Width = 313 - Height = 57 - AutoSize = False - Caption = - 'Click on a column header to sort. See design notes at the top of' + - ' source files.' - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -13 - Font.Name = 'Segoe UI' - Font.Style = [] - ParentFont = False - WordWrap = True - end - object btDisplayStars: TButton - Left = 48 - Top = 480 - Width = 201 - Height = 25 - Caption = 'Display Star Events Only' - TabOrder = 0 - OnClick = btDisplayStarsClick - end - object btDisplayAll: TButton - Left = 288 - Top = 480 - Width = 201 - Height = 25 - Caption = 'Display All' - TabOrder = 1 - OnClick = btDisplayAllClick - end - object VST: TVirtualStringTree - Left = 0 - Top = 0 - Width = 872 - Height = 441 - Align = alTop - DefaultNodeHeight = 21 - Font.Charset = ANSI_CHARSET - Font.Color = clWindowText - Font.Height = -16 - Font.Name = 'Segoe UI' - Font.Style = [] - Header.AutoSizeIndex = 0 - Header.Font.Charset = DEFAULT_CHARSET - Header.Font.Color = clWindowText - Header.Font.Height = -11 - Header.Font.Name = 'Tahoma' - Header.Font.Style = [] - Header.MainColumn = -1 - Images = ImageList1 - ParentFont = False - TabOrder = 2 - Columns = <> - end - object ImageList1: TImageList - Height = 24 - Width = 24 - Left = 16 - Top = 376 - Bitmap = { - 494C01011B003000480018001800FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 - 000000000000360000002800000060000000A8000000010020000000000000FC - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000C4C4C4009996970099969700D1D1 - D100F9F6F500FBFBFC00DBC9C600B5B3B300CFCFCF00DAD9D900000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000CCCACA00B9B9B900DAD9D900DFDFDF00AFAFAF00B5B3 - B30099969700BA8E8500A18C8200AFAFAF00DAD9D900C7C7C700BFBFBF00D1D1 - D10000000000000000000000000000000000000000000000000000000000A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 74008C5D5C00000000000000000000000000000000000000000000000000A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 74008C5D5C000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000ECEAEA00B9B9B900CFCFCF00EFEFEF00EFEFEF00DAD9D900AFAFAF00B5B3 - B3008F8F8F004F4C4C0060606000606060008C89880099969700D1D1D100D1D1 - D100B9B9B900CCCACA000000000000000000000000000000000000000000A478 - 7400FED6C900FED6C900FED6C900FED6C900FED6C900FED6C900FED6C900FED6 - C900FECFC200FECFC200FECFC200FED0B700FED0B700FED0B700FED0B700FED0 - B7008C5D5C000000000000000000000000000000000000000000B5B3B300897D - 8B00CC9A9900CABCB700FEE4CA00FEE4CA00FEE4CA00FED6C900FEE4CA00FED6 - C900FEDDBB00FEDDBB00FEDDBB00FED0B700FED0B700FED0B700FED0B700FED0 - B7008C5D5C000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000BFBF - BF00C0C0C000ECEAEA00F3F3F300EFEFEF00ECEAEA00D1D1D100A8A8A800AFAF - AF008F8F8F004F4C4C00434242006060600060606000868585008F8F8F00AFAF - AF00C7C7C700DAD9D900BFBFBF00DAD9D900000000000000000000000000A478 - 7400F3E3D100FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDD - BB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00FECC9A00FED0 - B7008C5D5C000000000000000000000000000000000000000000458EB6005D71 - AB00AB8FA300C8ABAB00FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4 - CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FECC9A00FED0 - B7008C5D5C000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000B9B9B900DFDF - DF00FAFAFA00F9F6F500EFEFEF00ECEAEA00E1E0E000D1D1D100A8A8A800A8A8 - A800AFAFAF00AFAFAF00A8A8A8008C8988007070700060606000868585008F8F - 8F00B5B3B3009F9F9F00CFCFCF00F3F3F300000000000000000000000000A478 - 7400EFE4D800FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDD - BB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00FED0 - B7008C5D5C00000000000000000000000000000000000000000061C6FE003A80 - E0005D71AB00AB8FA300D5B3AF00FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4 - CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED0 - B7008C5D5C000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000B9B9B900FEFEFE00FBFB - FC00F9F6F500EFEFEF00ECEAEA00DAD9D900B5B3B3008F8F8F00808080008F8F - 8F00A8A8A800AFAFAF00AFAFAF00B5B3B300B9B9B900AFAFAF009F9F9F006060 - 600051515100CCCACA00E1E0E00000000000000000000000000000000000A478 - 7400F5EADF00FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4 - CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED0 - B7008C5D5C000000000000000000000000000000000000000000000000005DB2 - FC003A80E0005D71AB00AB8FA300D5B3AF00FEEBD700FEEBD700FEE4CA00FEE4 - CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED0 - B7008C5D5C000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000AFAFAF00FBFBFC00F9F6 - F500EFEFEF00DAD9D9009F9F9F009F9F9F00B9B9B900C7C7C7009F9F9F008F8E - 8D0080808000808080008F8F8F009F9F9F00B5B3B300B9B9B900BFBFBF00C3C2 - C200B9B9B900C4C4C400E1E0E00000000000000000000000000000000000B481 - 7600F5EADF00FEF0E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4 - CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED0 - B7008C5D5C000000000000000000000000000000000000000000000000008F8F - 8F005DB2FC003A80E0005D71AB00AB8FA300E2BDB300FEEBD700FEEBD700FEE4 - CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED0 - B7008C5D5C000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000A8A8A800F3F3F300CFCF - CF00999697009F9F9F00D1D1D100DAD9D900D1D1D100D1D1D100CCCACA00BFBF - BF00A8A8A800A8A8A8009F9F9F008F8F8F00868585008C8988009F9F9F00B9B9 - B9008DBC8B008DBC8B00E1E0E00000000000000000000000000000000000B481 - 7600F6EFE700FEF0E200FEF0E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4 - CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED0 - B7008C5D5C00000000000000000000000000000000000000000000000000B481 - 7600CABCB7005DB2FC003A80E0005D71AB00B9AAA600F3E3D100E2BDB300BF98 - 9500CDA6A000C8ABAB00E2BDB300FEDDBB00FEDDBB00FEDDBB00FED7AB00FECF - C2008C5D5C000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000009F9F9F008C8988009996 - 9700DAD9D900DFDFDF00DAD9D900D1D1D100CCCACA00ECEAEA00E6E5E400E6E5 - E400ECEAEA00DAD9D900CCCACA00B9B9B900AFAFAF00AFAFAF00999697008685 - 85008080800099969700DFDFDF0000000000000000000000000000000000B481 - 7600F6EFE700FEF4E900FEF0E200FEF0E200FEEBD700FEEBD700FEEBD700FEE4 - CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FECF - C2008C5D5C00000000000000000000000000000000000000000000000000B481 - 7600F8F3EC00FEF4E9005DB2FC0085AFCB008F8F8F00BF989500DAB4A000FDE8 - B700FEFED300FDF6C600D8C5B500CC9A9900E5CDBE00FEDDBB00FEDDBB00FED0 - B7008C5D5C000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000008F8F8F00ECEAEA00E1E0 - E000DFDFDF00DAD9D900D1D1D100CFCFCF00E1E0E000DAD9D900B5B3B300B9B9 - B900B9B9B900BFBFBF00CFCFCF00E6E5E400E6E5E400D1D1D100C7C7C700BFBF - BF00B9B9B900A8A8A800DAD9D90000000000000000000000000000000000BA8E - 8500F6EFE700FEF4E900FEF4E900FEF0E200FEF0E200FEEBD700FEEBD700FEEB - D700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FECF - C200986B6600000000000000000000000000000000000000000000000000B481 - 7600F6EFE700FEF4E900F8F3EC00DED7D300BF989500FED7AB00FDF6C600FEFE - D300FEFFE100FEFFE100FFFDF800F6EFE700BF989500EDD9B700FEDDBB00FECF - C200986B66000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000008C898800E1E0E000DFDF - DF00DAD9D900D1D1D100CFCFCF00DAD9D900E6E5E400C0C0C000EFEFEF00EFEF - EF00ECEAEA00CFCFCF00BFBFBF00B9B9B900B9B9B900BFBFBF00D1D1D100E1E0 - E000DFDFDF00D1D1D100E6E5E40000000000000000000000000000000000BA8E - 8500F8F3EC00FFF8EE00FEF4E900FEF4E900FEF0E200FEF0E200FEEBD700FEEB - D700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FECF - C200986B6600000000000000000000000000000000000000000000000000BA8E - 8500F8F3EC00FFF8EE00FFF8EE00D5B3AF00EAC8A100FDF6C600FDE8B700FEFE - D300FEFFE100FEF9F300FEFFFC00FFFFFF00DED2CA00CDA6A000FEDDBB00FED6 - C900986B66000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000D1D1D100DAD9 - D900D1D1D100CFCFCF00DFDFDF00CFCFCF00C3C2C200F3F3F300F3F3F300EFEF - EF00EFEFEF00EFEFEF00ECEAEA00ECEAEA00DAD9D900C7C7C700B9B9B900B9B9 - B900B9B9B900CCCACA000000000000000000000000000000000000000000BA8E - 8500F8F3EC00FEF9F300FFF8EE00FEF4E900FEF4E900FEF0E200FEF0E200FEEB - D700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FECF - C200986B6600000000000000000000000000000000000000000000000000BA8E - 8500FAF3F200FFF8EE00FEF9F300C8ABAB00FDE8B700FDE8B700FDF6C600FEFE - D300FEFFE100FFFDF800FEFFFC00FFF8EE00FDF6C600BF989500FEDDBB00FED6 - C900986B66000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000E6E5 - E400AFAFAF00BFBFBF00C3C2C200D1D1D100C4C4C400CCCACA00E6E5E400F3F3 - F300EFEFEF00EFEFEF00EFEFEF00ECEAEA00ECEAEA00E6E5E400E6E5E400D1D1 - D100AFAFAF00E6E5E4000000000000000000000000000000000000000000CB9A - 8200F9F6F500FEFAF700FFF8EE00FFF8EE00FEF4E900FEF4E900FEF0E200FEF0 - E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FED6 - C900986B6600000000000000000000000000000000000000000000000000CB9A - 8200F9F6F500FEF9F300FFFDF800CDA6A000FDF6C600FED7AB00FDE8B700FEFE - D300FEFED300FEFFE100FEFFE100FEFFE100FEFED300BF989500FEE4CA00FED6 - C900986B66000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000A8A8A800E6E5E400E6E5E400AFAFAF00B5B3B300B9B9B900B9B9 - B900C3C2C200CCCACA00DAD9D900E6E5E400E6E5E400ECEAEA00CCCACA00B5B3 - B300DFDFDF00000000000000000000000000000000000000000000000000CB9A - 8200F8F8F800FFFDF800FEF9F300FFF8EE00FFF8EE00FEF4E900FEF4E900FEF0 - E200FEF0E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FED6 - C900A4787400000000000000000000000000000000000000000000000000CB9A - 8200F8F8F800FFFCFB00FEFFFC00CDA6A000FDF6C600FDE8B700FDE8B700FEFE - D300FEFED300FEFED300FEFFE100FEFED300FDF6C600BF989500FEE4CA00FED6 - C900A47874000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000A8A8A800FEF9F300FEF0E200ECDACC00D1D1D100C4C4C400C4C4 - C400B9B9B900C0C0C000BFBFBF00B9AAA600B9AAA600B5B3B300DAD9D9000000 - 000000000000000000000000000000000000000000000000000000000000CB9A - 8200FBFBFC00FFFEFE00FFFDF800FEF9F300FFF8EE00FFF8EE00FEF4E900FEF4 - E900FEF0E200FEF0E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FED6 - C900A4787400000000000000000000000000000000000000000000000000CB9A - 8200FCFEFB00FFFEFE00FFFFFF00D5B3AF00EDD9B700FEF0E200FDE8B700FED7 - AB00FDF6C600FDF6C600FDF6C600FDF6C600EDD9B700BF989500FEE4CA00FED6 - C900A47874000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000CB9A8200FED7AB00FED7AB00FED7AB00FEDDBB00FEDD - BB00FEEBD700F3E3D100EFE4D800C8ABAB00DAD9D90000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000DCA8 - 8700F8FBFB00FFFFFF00FFFEFE00FFFCFB00FEFAF700FFF8EE00FFF8EE00FEF4 - E900FEF4E900FEF0E200FEF0E200FEEBD700FEEBD700FEEBD700FEE4CA00FECF - C200A4787400000000000000000000000000000000000000000000000000DCA8 - 8700FBFBFC00FFFEFF00FFFEFF00DED7D300E2BDB300F9F6F500F9FFFE00FDE8 - B700FDE8B700FED7AB00FDE8B700FDE8B700D6A89400D8C5B500FEE4CA00FED0 - B700A47874000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000D6A89400FEDDBB00FED7AB00FEDDBB00FED7AB00FEDD - BB00FED7AB00FEDDBB00F3D1A300BF9895000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000DCA8 - 8700F8FBFB00FFFFFF00FFFFFE00FFFEFF00FEFAF700FEFAF700FEF9F300FFF8 - EE00FEF4E900FEF4E900FEF0E200FEF0E200FEEBD700FED6C900FECFC200F3B9 - B500A4787400000000000000000000000000000000000000000000000000DCA8 - 8700FBFBFC00FFFFFF00FFFFFF00FFFEFF00D5B3AF00D8C5B500EFE4D800F5EA - DF00FDE8B700FDE8B700EDD9B700D6A89400CDA6A000FED6C900FECFC200F3B9 - B500A47874000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000E6E5E400FED0B700FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDD - BB00FEDDBB00FEDDBB00D5B3AF00BF9895000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000DCA8 - 8700FFFDF800FFFFFF00FFFFFE00FFFFFE00FFFEFE00FEFAF700FEFAF700FFF8 - EE00FFF8EE00FEF4E900FEF4E900FEF0E200FED6C900F3B9B500FCA3A200FCA3 - A200B4817600000000000000000000000000000000000000000000000000DCA8 - 8700FCFEFB00FFFFFE00FEFFFC00FFFEFF00FFFFFF00D6BCBB00CDA6A000DAB4 - A000C8ABAB00DAB4A000CDA6A000E2BDB300FED6C900F3B9B500FCA3A200FCA3 - A200B48176000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000D8C5B500FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEE4 - CA00FEE4CA00FEE4CA00BF989500EADBD4000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000E3B1 - 8E00FCFEFE00FFFFFF00FFFEFF00FFFFFF00FFFFFF00FEFFFC00FEFAF700FEFA - F700FFF8EE00FFF8EE00FEF4E900B4817600B4817600B4817600A4787400B481 - 7600B4817600000000000000000000000000000000000000000000000000E3B1 - 8E00FCFEFE00FFFFFF00FCFEFE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00EADB - D400EFE4D800F1E3E200FFF8EE00B4817600B4817600B4817600A4787400B481 - 7600B48176000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000BF989500FEEBD700FEEBD700FEEBD700FEEBD700FEEBD700FEEB - D700FEEBD700ECDACC00BF989500000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000E3B1 - 8E00FCFEFE00FFFEFE00FCFEFE00FFFFFF00FFFFFE00FEFEFE00FFFFFF00FDFA - FA00FEFAF700FFF8EE00FFF8EE00B4817600E3B18E00FCB04C00FB9B0F00D393 - 6400D6A89400000000000000000000000000000000000000000000000000E3B1 - 8E00FCFEFE00FFFFFF00FFFEFF00FFFFFF00FFFFFE00FFFFFF00FFFFFE00FFFE - FF00FFFEFE00FEFAF700FEF9F300B4817600E3B18E00FCB04C00FB9B0F00D393 - 6400D6A894000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000ECEAEA00DBC9C600FEF0E200FEF0E200FEF0E200FEF0E200FEF0E200FEF0 - E200FEF0E200D5B3AF00BF989500000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200FFFEFE00FFFEFF00FEFEFE00FFFFFF00FFFFFE00FFFEFF00FCFEFE00FFFF - FF00FEFAF700FEFAF700FFF8EE00B4817600EAC8A100FCC47C00DCA88700D6A8 - 940000000000000000000000000000000000000000000000000000000000EDBD - 9200FEFEFE00FFFFFF00FFFFFE00FFFFFF00FFFFFF00FFFFFF00FFFEFF00FCFE - FE00FEFAF700FEF9F300FEF9F300B4817600EAC8A100FCC47C00DCA88700D6A8 - 9400000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000D6BCBB00FEF4E900FFF8EE00FFF8EE00FFF8EE00FFF8EE00FFF8EE00FFF8 - EE00FEF4E900BF989500E4D1CD00000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200FCFEFE00FFFFFE00FFFFFE00FFFFFF00FFFEFF00FCFEFE00FFFFFF00FFFF - FF00FEFEFE00FEFAF700FEFAF700B4817600EAC8A100E3B18E00D6A894000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200FFFFFF00FFFFFF00FFFFFE00FFFEFE00FFFEFF00FFFFFF00FFFFFE00FFFF - FF00FEFFFC00FFFDF800FEFAF700B4817600EAC8A100E3B18E00D6A894000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000F8F0 - F000DED7D300FEFEFE00FBFBFC00FCFEFB00FCFEFB00FBFBFC00FCFEFB00FCFE - FB00ECEAEA00BF98950000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200FEF0E200FEF0E200F5EADF00F5EADF00EFE4D800EFE4D800EADBD400EADB - D400DED7D300DED2CA00DED2CA00B4817600DCA88700E3B18E00000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200FEF0E200FEF0E200F5EADF00F5EADF00EFE4D800EFE4D800EADBD400EADB - D400EADBD400DED2CA00DED2CA00B4817600DCA88700E3B18E00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000CABC - B700BF989500BF989500BF989500BF989500BF989500BF989500BF989500BF98 - 9500BF989500F8F0F00000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 - 8700DCA88700DCA88700DCA88700B4817600DCA8870000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 - 8700DCA88700DCA88700DCA88700B4817600DCA8870000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000D1EF - F900F0FEFE000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000059ACD00059A - CD00BEE6F500F0F6FD0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000A3453F00A345 - 3F00994C4D00A3453F00994C4D00B5B3B300B5B3B300B5B3B300B5B3B300B5B3 - B300B5B3B300B5B3B300B5B3B300B5B3B300994C4D00994C4D00994C4D00994C - 4D00994C4D00DAD9D900000000000000000000000000000000000000000041B3 - DA0064C1E10037B4E00064C1E1009EDEEE00DFEFF90000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000059ACD00059ACD00059ACD004BBDE00090D1F100D1EFF9000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000059ACD00C7EF - F10037B4E0001DA6D500059ACD007ECBE600ACDBF400E4FDFE00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000B4817600994C4D00CB66 - 6600CB666600CB666600994C4D00A8A8A800C4C4C400DAD9D900F8F8F800FAFA - FA00F3F3F300E6E5E400DFDFDF00DAD9D900993434009934340099343400BB57 - 5700CB666600994C4D000000000000000000000000000000000000000000059A - CD00F9FFFE0070D2FD0056C6F0004BBDE0002EACD8002EACD80064C1E1009EDE - EE00D1EFF9000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000059ACD00D1EFF90060D4F0004BBDE0002EACD800059ACD00059A - CD0041B3DA007ECBE600BEE6F500F0FEFE000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000059ACD0090D1 - F1009AE3FF007BDDFE0070D2FD0056C6F00037B4E0001DA6D500059ACD004BBD - E0009EDEEE00DFEFF90000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000B4817600CB666600CB66 - 6600CB666600CB666600994C4D00A4968E00B4817600CC9A9900DBC9C600FAFA - FA00F8F8F800EFEFEF00E6E5E400DFDFDF00993434009934340099343400BB57 - 5700CB666600994C4D00000000000000000000000000A4787400A4787400A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A478740037B4 - E00037B4E0002EACD8004BBDE00090D1F100D1EFF90000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000059ACD0090D1F1009AE3FF007BDDFE007BDDFE007BDDFE0070D2 - FD0056C6F00037B4E0001DA6D500059ACD002EACD8007ECBE600ACDBF400DFEF - F900000000000000000000000000000000000000000000000000059ACD004BBD - E000D1EFF9007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE0060D4 - F0004BBDE0002EACD800059ACD001DA6D5009EDEEE0000000000000000000000 - 00000000000000000000000000000000000000000000B4817600CB666600CB66 - 6600CB666600CB666600994C4D00B1A09700BB575700BB575700CC9A9900DFDF - DF00FAFAFA00F8FBFB00EFEFEF00E6E5E400993434009934340099343400BB57 - 5700CB666600994C4D00000000000000000000000000A4787400F3E3D100FEE4 - CA00FED6C900FED6C900FED0B700FED0B700FED0B700FED7AB00A478740084E9 - FE0084E9FE007BDDFE007BDDFE0060D4F0004BBDE0001DA6D50041B3DA00ACDB - F4000000000000000000000000000000000000000000059ACD00059ACD007ECB - E600BEE6F500059ACD004BBDE000D1EFF90084E9FE0084E9FE0084E9FE0084E9 - FE0084E9FE0084E9FE0084E9FE007BDDFE0060D4F0004BBDE0001DA6D50041B3 - DA00000000000000000000000000000000000000000000000000059ACD0037B4 - E000D1EFF90084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0084E9 - FE0084E9FE0084E9FE0084E9FE0060D4F00037B4E00000000000000000000000 - 00000000000000000000000000000000000000000000B4817600CB666600CB66 - 6600CB666600CB666600994C4D00D5B3AF00BB575700BB575700B4817600C4C4 - C400DFDFDF00FEFAF700FBFBFC00EFEFEF00993434009934340099343400BB57 - 5700CB666600994C4D00000000000000000000000000B4817600FEEBD700FEE4 - CA00FEE4CA00FEDDBB00C7D19500448A3E0005710A0005710A000F8319000571 - 0A002A8C430060D4F00084E9FE0084E9FE007BDDFE0084E9FE007BDDFE0041B3 - DA00DFEFF90000000000000000000000000000000000059ACD009EDEEE004BBD - E0001DA6D500059ACD0037B4E000DFEFF90084E9FE0084E9FE0084E9FE0084E9 - FE0084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0070D2FD004BBD - E000D1EFF9000000000000000000000000000000000000000000059ACD0056C6 - F00090D1F100ADFBFE0084E9FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3 - FE008DF3FE008DF3FE008DF3FE007BDDFE007BDDFE00059ACD00000000000000 - 00000000000000000000000000000000000000000000B4817600CB666600CB66 - 6600CB666600CB666600994C4D00DBC9C600A3453F00A3453F00A4787400A8A8 - A800C4C4C400DFDFDF00FAFAFA00FAFAFA00993434009934340099343400BB57 - 5700CB666600994C4D00000000000000000000000000BA8E8500FEEBD700FEEB - D700FEE4CA00FEE4CA00448A3E007DA972007DA97200448A3E000F8319001899 - 2E0025A63D000F83190069CCC0008DF3FE008DF3FE008DF3FE0084E9FE0060D4 - F00064C1E10000000000000000000000000000000000059ACD0064C1E100BEE6 - F5007BDDFE00059ACD004BBDE00090D1F100ADFBFE008DF3FE008DF3FE008DF3 - FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE0070D2FD008DF3 - FE0064C1E10000000000000000000000000000000000000000001DA6D50061C6 - FE0064C1E100C2FDFF0099FDFE0099FDFE008DF3FE0099FDFE008DF3FE0099FD - FE008DF3FE0099FDFE008DF3FE007BDDFE0084E9FE004BBDE000000000000000 - 00000000000000000000000000000000000000000000B4817600CB666600CB66 - 6600CB666600CB666600994C4D00DBC9C60099343400A3453F00B48176009F9F - 9F00A8A8A800C3C2C200DFDFDF00FAFAFA00993434009934340099343400BB57 - 5700CB666600994C4D00000000000000000000000000CB9A8200FEF4E900FEEB - D700FEEBD700FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00B4817600255E - 280025BB4F0030C369000F8319007ECBE6008DF3FE008DF3FE0084E9FE0084E9 - FE0041B3DA0000000000000000000000000000000000059ACD0037B4E000D1EF - F90060D4F000059ACD0070D2FD004BBDE000D4FDFF0099FDFE0099FDFE0099FD - FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0070D2FD008DF3 - FE004BBDE000DFEFF900000000000000000000000000000000001DA6D50070D2 - FD002EACD800E4FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD - FE0099FDFE0099FDFE0099FDFE0084E9FE009AE3FF00ADFBFE00059ACD000000 - 00000000000000000000000000000000000000000000B4817600CB666600CB66 - 6600CB666600CB666600994C4D00DBC9C600E4D1CD00DBC9C600E4D1CD00CCCA - CA00B9B9B900CABCB700C7C7C700DED7D300993434009934340099343400BB57 - 5700CB666600994C4D00000000000000000000000000CB9A8200FEF4E900FEF0 - E200FEF0E200FEEBD700FEE4CA00FEE4CA00FEDDBB00FEDDBB00B481760084E9 - FE000F83190047CE710025BB4F002A8C430099FDFE0099FDFE0084E9FE00ADFB - FE0064C1E10090D1F100000000000000000000000000059ACD0056C6F00090D1 - F1009EDEEE00059ACD0070D2FD0037B4E000E4FDFE0099FDFE0099FDFE0099FD - FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE007BDDFE00BEE6 - F500ADFBFE007ECBE600000000000000000000000000000000001DA6D50070D2 - FD002EACD8009EDEEE00D4FDFF00ADFBFE00ADFBFE00ADFBFE00ADFBFE00ADFB - FE00ADFBFE00ADFBFE00ADFBFE0084E9FE009AE3FF00D4FDFF004BBDE0000000 - 00000000000000000000000000000000000000000000B4817600CB666600CB66 - 6600CB666600CB666600CB666600B4817600B4817600B4817600B4817600CB66 - 6600CB666600986B6600CB666600B4817600BB575700BB575700A3453F00CB66 - 6600CB666600994C4D00000000000000000000000000DCA88700FEF9F300FEF4 - E900FEF0E200FEEBD700FEEBD700FEE4CA00FEE4CA00FEDDBB00B481760084E9 - FE000F83190047CE710058E087000F83190099FDFE0099FDFE008DF3FE00ADFB - FE009AE3FF004BBDE000000000000000000000000000059ACD0061C6FE002EAC - D800BEE6F5001DA6D50070D2FD0056C6F00064C1E100DFEFF900E4FDFE00E4FD - FE00D4FDFF00C2FDFF00ADFBFE00C2FDFF00ADFBFE00ADFBFE0070D2FD00C2FD - FF00D4FDFF004BBDE000F0F6FD000000000000000000000000001DA6D5007BDD - FE007BDDFE0037B4E0004BBDE0007ECBE600ACDBF400D1EFF900E4FDFE00C2FD - FF00C2FDFF00C2FDFF00C2FDFF009AE3FF009AE3FF00E4FDFE00ACDBF400059A - CD000000000000000000000000000000000000000000B4817600CB666600CB66 - 6600CB666600CB666600CB666600CB666600CB666600CB666600CB666600CB66 - 6600CB666600CB666600CB666600CB666600CB666600CB666600CB666600CB66 - 6600CB666600994C4D00000000000000000000000000E3B18E00FFFDF800FFF8 - EE00FEF4E900FEF0E200FEEBD700FEEBD700FEE4CA000F8319000F8319000F83 - 19000F83190058E0870058E087000F8319000F8319000F8319000F831900ADFB - FE00D4FDFF004BBDE000BEE6F5000000000000000000059ACD0070D2FD0037B4 - E0007ECBE6001DA6D5007BDDFE007BDDFE0060D4F0004BBDE0002EACD8002EAC - D8002EACD800D1EFF900E4FDFE00C2FDFF00C2FDFF00D4FDFF007BDDFE00D1EF - F900E4FDFE00BEE6F5009EDEEE000000000000000000000000002EACD80084E9 - FE0084E9FE007BDDFE0084E9FE004BBDE00037B4E00037B4E00041B3DA00F2FA - F500D4FDFF00D4FDFF00D4FDFF009AE3FF009EDEEE000F8319008DBC8B0064C1 - E1000000000000000000000000000000000000000000B4817600CB666600A345 - 3F00BA8E8500BF989500CC9A9900BF989500CC9A9900CC9A9900CC9A9900CC9A - 9900CC9A9900CC9A9900CC9A9900CC9A9900CC9A9900CC9A9900A4787400CB66 - 6600CB666600994C4D00000000000000000000000000EDBD9200FFFFFF00FEFA - F700FEF9F300FEF4E900FEF0E200FEEBD700FEEBD700F0E4C700267D270025A6 - 3D0047CE710058E0870058E0870058E0870025A63D00267D27009EDEEE00C2FD - FF00D4FDFF009EDEEE0041B3DA0000000000000000001DA6D5007BDDFE0061C6 - FE002EACD8001DA6D50084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0084E9 - FE0084E9FE004BBDE000BEE6F500F0FEFE00F0FEFE00F0FEFE009AE3FF00E4FD - FE00F9FFFE00F0FEFE0064C1E1000000000000000000000000002EACD8008DF3 - FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE0071EBF9001DA6 - D50041B3DA004BBDE0004BBDE0004BBDE0002A8C430047CE71000F83190051B4 - 9400F0F6FD0000000000000000000000000000000000B4817600CB666600A345 - 3F00F3F3F300F3F3F300F3F3F300F3F3F300FAF3F200F3F3F300F3F3F300F3F3 - F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 - 5700CB666600994C4D00000000000000000000000000EDBD9200FFFFFF00FFFF - FE00FDFAFA00FEF9F300FEF4E900FEF0E200FEEBD700F3B9B500B48176000571 - 0A0047CE710058E0870058E0870058E087000F831900C7EFF100ADFBFE00D1EF - F900F0FEFE00D4FDFF0041B3DA00F0F6FD00000000001DA6D5007BDDFE0061C6 - FE0037B4E0001DA6D50099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD - FE0099FDFE0099FDFE0060D4F0004BBDE0004BBDE0004BBDE0004BBDE0004BBD - E0004BBDE0004BBDE0004BBDE0000000000000000000000000002EACD80099FD - FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD - FE0099FDFE0071EBF90060D4F000097B450025BB4F0058E0870058E087001899 - 2E00DDEADD0000000000000000000000000000000000B4817600CB666600A345 - 3F00FAF3F200F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 - F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 - 5700CB666600994C4D00000000000000000000000000EDBD9200FFFFFF00FFFE - FF00FEFEFE00FFFDF800FEF9F300FEF4E900B4817600B4817600B4817600B1A0 - 97000F83190058E0870058E08700267D2700F0FEFE00F0FEFE00D1EFF900E4FD - FE00FCFEFE00FCFEFE007ECBE60041B3DA00000000001DA6D5007BDDFE007BDD - FE0037B4E0001DA6D50099FDFE0099FDFE0099FDFE0099FDFE0099FDFE00ADFB - FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE002EACD8000000 - 000000000000000000000000000000000000000000000000000037B4E000ADFB - FE0099FDFE0099FDFE0099FDFE0099FDFE00D4FDFF00C2FDFF00C2FDFF00ADFB - FE0099FDFE0099FDFE0049AA490018992E0058E0870058E0870058E0870058E0 - 8700267D270000000000000000000000000000000000B4817600CB666600A345 - 3F00F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 - F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 - 5700CB666600994C4D00000000000000000000000000EDBD9200FCFEFB00FCFE - FE00FEFFFC00FCFEFE00FEFAF700FFF8EE00B4817600FCC47C00DCA88700FED6 - C9008DBC8B00267D27000F83190041B3DA0041B3DA0041B3DA0041B3DA0041B3 - DA0041B3DA0041B3DA0041B3DA0041B3DA00000000001DA6D5009AE3FF0084E9 - FE007BDDFE001DA6D500C2FDFF0099FDFE0099FDFE0099FDFE00C2FDFF009EDE - EE009EDEEE00ACDBF400C2FDFF00D4FDFF00C2FDFF00ADFBFE002EACD8000000 - 000000000000000000000000000000000000000000000000000037B4E000E4FD - FE00ADFBFE00ADFBFE0099FDFE00D4FDFF007ECBE60037B4E00037B4E00037B4 - E00037B4E0008DBC8B000F83190047CE710058E0870058E0870058E0870058E0 - 870058E0870068A76200000000000000000000000000B4817600CB666600A345 - 3F00F8F0F000F3F3F300CCCACA00C0C0C000C3C2C200C3C2C200C4C4C400C4C4 - C400C4C4C400C7C7C700C7C7C700C7C7C700D1D1D100F3F3F300D6BCBB00BB57 - 5700CB666600994C4D00000000000000000000000000DCA88700FFFEFE00FDFA - FA00F8F8F800F3F3F300F3F3F300ECEAEA00B4817600D6A89400F3E3D100FEF0 - E200FEF0E2007DA972008DBC8B00FECFC200B481760099FDFE0041B3DA000000 - 000000000000000000000000000000000000000000002EACD8008DF3FE008DF3 - FE008DF3FE001DA6D500DFEFF900E4FDFE00D4FDFF00D4FDFF00C7EFF1004BBD - E00060D4F00060D4F00037B4E0002EACD8002EACD8002EACD8002EACD8000000 - 000000000000000000000000000000000000000000000000000037B4E00064C1 - E10090D1F1009EDEEE00BEE6F50090D1F10037B4E00000000000000000000000 - 0000000000008DBC8B007DA97200448A3E0025BB4F0058E0870058E087000F83 - 190068A762007DA97200F3F3F3000000000000000000B4817600CB666600A345 - 3F00F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 - F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 - 5700CB666600994C4D00000000000000000000000000DCA88700DCA88700DCA8 - 8700DCA88700DCA88700DCA88700DCA88700DCA88700F5EADF00FFF8EE00FEF4 - E900FEF0E200FEEBD700FECFC200F3B9B500B481760099FDFE0041B3DA000000 - 000000000000000000000000000000000000000000001DA6D500ADFBFE0099FD - FE0099FDFE008DF3FE0041B3DA0037B4E00037B4E00037B4E00037B4E00099FD - FE0099FDFE0099FDFE0071EBF9002EACD8000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000000000000037B4 - E00037B4E00037B4E00037B4E00037B4E0000000000000000000000000000000 - 00000000000000000000000000000000000025A63D0047CE710058E087000F83 - 19000000000000000000000000000000000000000000B4817600CB666600A345 - 3F00F3F3F300F3F3F300CCCACA00C0C0C000C0C0C000C0C0C000C3C2C200C3C2 - C200C4C4C400C4C4C400C4C4C400C7C7C700D1D1D100F3F3F300D6BCBB00BB57 - 5700CB666600994C4D00000000000000000000000000000000000000000041B3 - DA00D4FDFF00D4FDFF00EDBD9200FEFAF700FEFAF700FDFAFA00FEFAF700FEF9 - F300FEF4E900B4817600B4817600B4817600B481760041B3DA0041B3DA000000 - 000000000000000000000000000000000000000000002EACD800C2FDFF0099FD - FE0099FDFE0099FDFE0099FDFE00C2FDFF00C2FDFF00C2FDFF00ADFBFE0099FD - FE0099FDFE0099FDFE0071EBF9002EACD8000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000D0E2CE0025A63D0047CE710030C369008DBC - 8B000000000000000000000000000000000000000000B4817600CB666600A345 - 3F00F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 - F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 - 5700CB666600994C4D000000000000000000000000000000000000000000ACDB - F40041B3DA0037B4E000EDBD9200FFFEFF00FFFEFF00FFFFFE00FFFFFF00FEF9 - F300FEF9F300B4817600FCB04C00D3936400D8C5B50000000000000000000000 - 000000000000000000000000000000000000000000001DA6D500E4FDFE00ADFB - FE0099FDFE0099FDFE00C2FDFF009EDEEE002EACD8002EACD8002EACD8002EAC - D8002EACD8002EACD8002EACD8002EACD8000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000448A3E0025BB4F0047CE71000F831900EFF9 - F0000000000000000000000000000000000000000000B4817600CB666600A345 - 3F00F8F0F000F3F3F300C7C7C700BFBFBF00C0C0C000BFBFBF00C0C0C000C0C0 - C000C3C2C200C4C4C400C3C2C200C4C4C400CFCFCF00F3F3F300D6BCBB00BB57 - 5700CB666600994C4D0000000000000000000000000000000000000000000000 - 00000000000000000000EDBD9200FFFFFF00FCFEFB00F8FBFB00FAFAFA00F8F8 - F800F8F0F000B4817600EDBD9200D8C5B5000000000000000000000000000000 - 000000000000000000000000000000000000000000002EACD8007ECBE6007ECB - E6009EDEEE00BEE6F500ACDBF40037B4E0000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000E1F1E10068A7620018992E0030C369000F831900DDEADD000000 - 00000000000000000000000000000000000000000000B4817600CB666600A345 - 3F00F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 - F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 - 5700CB666600994C4D0000000000000000000000000000000000000000000000 - 00000000000000000000DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 - 8700DCA88700DCA88700DCA88700000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000037B4E00037B4 - E00037B4E00037B4E00041B3DA00F0FEFE000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000AFD0B00005710A00448A - 3E0005710A000F8319000EA31B0018992E00267D2700DDEADD00000000000000 - 00000000000000000000000000000000000000000000B4817600CB666600A345 - 3F00F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 - F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 - 5700CB666600994C4D0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000F2FAF500AFD0 - B00068A762007DA972007DA97200D0E2CE000000000000000000000000000000 - 00000000000000000000000000000000000000000000B4817600994C4D009934 - 3400C4C4C400C4C4C400C3C2C200C3C2C200C4C4C400C4C4C400C4C4C400C4C4 - C400C4C4C400C3C2C200C4C4C400C4C4C400C4C4C400C3C2C200BF989500994C - 4D00994C4D00DAD9D90000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000EFEFEF00C0C0C0009F9F - 9F009F9F9F00A8A8A8008F8F8F00B9B9B900E6E5E40000000000000000000000 - 0000000000000000000000000000000000000000000000000000CC9A9900CC9A - 9900CC9A9900D5B3AF00EADBD400F8F0F0000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000059ACD00059ACD0090D1F100BEE6F5000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000059ACD0064C1 - E1009EDEEE00DFEFF90000000000000000000000000000000000000000000000 - 0000000000000000000000000000AFD0B0000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000EFEFEF009F9F9F008C8988009F9F9F00B9AA - A600C8ABAB00CABCB700D6BCBB00D5B3AF00B1A0970086858500D1D1D1000000 - 0000000000000000000000000000000000000000000000000000CC9A9900CC9A - 9900D6A89400D6A89400D6A89400CC9A9900CC9A9900CDA6A000E4D1CD00F6EF - E700000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000059ACD00C7EFF10037B4E000059ACD00059ACD0041B3DA007ECBE600ACDB - F400F0F6FD000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000059ACD00DFEF - F90056C6F0002EACD8002EACD80064C1E10090D1F100D1EFF900000000000000 - 000000000000000000000000000005710A0068A7620000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000D1D1D1008C89880099969700999697008F8E8D008F8E - 8D00A4968E00A18C8200A4968E008C898800C8ABAB00FECFC200BF989500A8A8 - A800000000000000000000000000000000000000000000000000CC9A9900CC9A - 9900CC9A9900FECC9A00FECC9A00FECC9A00EDBD9200E3B18E00D6A89400CC9A - 9900CC9A9900CC9A9900DBC9C600F1E3E2000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000059ACD007ECBE6009AE3FF007BDDFE0070D2FD0056C6F00037B4E0001DA6 - D500059ACD002EACD8007ECBE6009EDEEE00DFEFF90000000000000000000000 - 0000000000000000000000000000000000000000000000000000059ACD0090D1 - F1009AE3FF007BDDFE0070D2FD0060D4F00056C6F00037B4E0001DA6D5004BBD - E00090D1F100C7EFF100D1EFF9000F8319000F831900448A3E00EFF9F0000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000A1C79E00879185009F9F9F008C898800B1A09700EDD9B700FDE8 - B700CFCFCF006682F100FDF6C600FDE8B700D8C5B50086858500E2BDB300E2BD - B3008C8988000000000000000000000000000000000000000000CC9A9900EDBD - 9200D6A89400D6A89400FED7AB00FED7AB00F3D1A300FECC9A00FECC9A00FECC - 9A00EDBD9200EDBD9200D6A89400CC9A9900CC9A9900CC9A9900D6BCBB00F1E3 - E200000000000000000000000000000000000000000000000000000000000000 - 0000059ACD0037B4E000D1EFF9007BDDFE007BDDFE007BDDFE007BDDFE007BDD - FE0051B4940056C6F00037B4E0001DA6D500059ACD001DA6D500BEE6F5000000 - 0000000000000000000000000000000000000000000000000000059ACD0064C1 - E100D1EFF9007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE0070D2 - FD0060D4F00037B4E00037B4E0000F8319000EA31B000F831900267D2700D0E2 - CE00000000000000000000000000000000000000000000000000000000000000 - 0000AFD0B0000F831900267D270087918500E3D3AA00FDE8B700FDF6C600FEF9 - F300BEC6DC004571FA00FFFDF800FEFFFC00FFF8EE00FDF6C600A4968E00D5B3 - AF00E2BDB300A8A8A80000000000000000000000000000000000CC9A9900EAC8 - A100F3D1A300CC9A9900DAB4A000FDE8B700FDE8B700FED7AB00FED7AB00FED7 - AB00F3D1A300FECC9A00FECC9A00FECC9A00FECC9A00EDBD9200D6A89400D6A8 - 9400CC9A9900CC9A990000000000000000000000000000000000000000000000 - 0000059ACD004BBDE000D1EFF90084E9FE0084E9FE0084E9FE0084E9FE0084E9 - FE002A8C430005710A0069CCC00084E9FE0084E9FE0060D4F000059ACD000000 - 0000000000000000000000000000000000000000000000000000059ACD004BBD - E000F0F6FD007BDDFE0084E9FE007BDDFE002A8C43000F8319000F8319000F83 - 19000F8319000F8319000F8319000F83190016B432000EA31B000EA31B000571 - 0A00A1C79E00000000000000000000000000000000000000000000000000D0E2 - CE00267D270058E0870030C36900448A3E00FDE8B700FDF6C600FDE8B700FED7 - AB00FED7AB00FED7AB00FDE8B700FEEBD700FFFDF800FEFFFC00FDF6C6008F8E - 8D00E2BDB300AB8FA300DAD9D900000000000000000000000000CC9A9900F3D1 - A300FDE8B700EAC8A100CC9A9900EDD9B700FDF6C600FDF6C600FDE8B700FDE8 - B700FDE8B700FDE8B700FED7AB00FED7AB00FECC9A00F3D1A300FECC9A00FECC - 9A00D6A89400CC9A990000000000000000000000000000000000000000000000 - 0000059ACD0061C6FE0090D1F100ADFBFE008DF3FE008DF3FE008DF3FE008DF3 - FE0051B4940025A63D0018992E0051B494008DF3FE0084E9FE00059ACD00D1EF - F900000000000000000000000000000000000000000000000000059ACD0056C6 - F0009EDEEE00ADFBFE0084E9FE0084E9FE002A8C430058E0870047CE710047CE - 710047CE710030C3690030C3690025BB4F0016B4320016B432000EA31B000EA3 - 1B0005710A007DA9720000000000000000000000000000000000F2FAF5001899 - 2E0030C3690058E0870058E0870025A63D007DA97200FDE8B700FDE8B700FDE8 - B700FDE8B700FED7AB00FED7AB00FED7AB00FEDDBB00FFFDF800FFFDF800FDF6 - C6008F8E8D00FECFC20099969700000000000000000000000000CC9A9900EDD9 - B700FDF6C600FDE8B700EAC8A100CC9A9900FEE4CA00FEFED300FDF6C600FDF6 - C600FDF6C600FDE8B700FDE8B700FDE8B700FDE8B700FED7AB00FED7AB00DAB4 - A000CC9A9900CC9A990000000000000000000000000000000000000000000000 - 0000059ACD0070D2FD0041B3DA00D4FDFF0099FDFE0099FDFE0099FDFE0099FD - FE0099FDFE0018992E0058E0870025A63D0051B4940084E9FE00ADFBFE0064C1 - E100000000000000000000000000000000000000000000000000059ACD0056C6 - F0002EACD800D4FDFF0084E9FE008DF3FE002A8C430058E0870058E0870058E0 - 870047CE710030C3690047CE710025BB4F0025BB4F0016B4320016B432000EA3 - 1B000EA31B0005710A0068A76200000000000000000000000000448A3E0025A6 - 3D0047CE710058E0870058E0870058E087000EA31B00A1C79E00FDE8B700FDE8 - B700FDE8B700FDE8B700FDE8B700FED7AB00FED7AB00FDE8B700FCFEFB00FFF8 - EE00B9AAA600D5B3AF00A4968E00ECEAEA000000000000000000CC9A9900FDE8 - B700FEFED300FEFED300FDF6C600C8ABAB00DAB4A000FEFFE100FEFED300FEFE - D300FEFED300FEFED300FDF6C600FDF6C600FDF6C600FDF6C600EAC8A100CC9A - 9900DAB4A000CDA6A00000000000000000000000000000000000000000000000 - 00001DA6D50070D2FD0037B4E000D1EFF90099FDFE0099FDFE0099FDFE0099FD - FE0099FDFE0051B4940025A63D0058E0870018992E007ECBE600C2FDFF00059A - CD00DFEFF9000000000000000000000000000000000000000000059ACD0061C6 - FE0037B4E000F0F6FD0099FDFE008DF3FE002A8C430058E0870058E0870058E0 - 870047CE710047CE710030C3690047CE710025BB4F0025BB4F0016B4320016B4 - 32000EA31B0005710A008DBC8B0000000000000000007DA972000F83190030C3 - 690047CE710058E0870058E0870058E0870058E087000F831900C7D19500FDF6 - C600FDF6C600FDE8B700FDE8B700FDE8B700FED7AB00FED7AB00FEF0E200FCFE - FE00FDE8B700A4968E00C8ABAB00C7C7C7000000000000000000CC9A9900F0E4 - C700FEFED300FEFED300FEFED300FDE8B700CDA6A000D8C5B500FEFFE100FEFF - E100FEFFE100FEFED300FEFED300FEFED300FEFED300EDD9B700CC9A9900EAC8 - A100FECC9A00D6A8940000000000000000000000000000000000000000000000 - 00001DA6D5007BDDFE0056C6F0007ECBE600E4FDFE00D4FDFF00C2FDFF00C2FD - FF00ADFBFE00ADFBFE0025A63D0058E0870030C3690051B49400D4FDFF00C2FD - FF00059ACD000000000000000000000000000000000000000000059ACD0070D2 - FD0061C6FE009EDEEE00C2FDFF0099FDFE002A8C430049AA490025A63D0025A6 - 3D0025A63D0025A63D0018992E0025BB4F0030C3690030C3690025BB4F0016B4 - 320005710A00AFD0B0000000000000000000A1C79E0005710A0025BB4F0025BB - 4F0030C3690030C3690047CE710058E0870058E0870047CE7100267D2700FDF6 - C600E3D3AA00CB9A8200EDBD9200FDE8B700FDE8B700FED7AB00FDE8B700FFFF - FE00FDF6C60080808000D6BCBB00B5B3B3000000000000000000CC9A9900F0E4 - C700FEFED300FEFED300FEFED300FEFED300E5CDBE00CC9A9900F3E3D100FFF8 - EE00FEFFE100FEFFE100FEFFE100FEFFE100EDD9B700CC9A9900DAB4A000FDE8 - B700FDE8B700D6A8940000000000000000000000000000000000000000000000 - 00001DA6D50084E9FE007BDDFE0056C6F00037B4E00037B4E00037B4E00037B4 - E000E4FDFE00ADFBFE0025A63D0058E0870058E08700267D2700E4FDFE00E4FD - FE00059ACD000000000000000000000000000000000000000000059ACD0070D2 - FD0061C6FE009BC3D800D4FDFF0099FDFE0099FDFE0099FDFE0099FDFE0099FD - FE0099FDFE0099FDFE0099FDFE0025A63D0030C3690030C3690018992E002A8C - 430069CCC000D1EFF900000000000000000068A76200448A3E00448A3E000F83 - 190025BB4F0047CE710047CE710025BB4F00267D2700448A3E00448A3E008DBC - 8B0060606000707070004E4940006F5B4D006F5B4D00826A5B00FED7AB00D0E3 - EC004571FA0099969700D6BCBB00B9B9B9000000000000000000CC9A9900F3E3 - D100FEFFE100FEFFE100FEFFE100F0E4C700CDA6A000CC9A9900CC9A9900EADB - D400FFF8EE00FFFDF800FEF9F300F5EADF00CDA6A000E2BDB300FDF6C600FDF6 - C600FDF6C600DAB4A00000000000000000000000000000000000000000000000 - 00002EACD8009AE3FF0084E9FE0084E9FE0084E9FE0084E9FE0084E9FE007BDD - FE0037B4E000E4FDFE0025A63D0058E0870058E0870018992E00FCFEFE00F9FF - FE00BEE6F500059ACD0000000000000000000000000000000000059ACD007BDD - FE007BDDFE00B4817600BEE6F500F0FEFE00E4FDFE00D4FDFF00C2FDFF00C2FD - FF00ADFBFE00ADFBFE00C2FDFF0025A63D0047CE710018992E002A8C4300C7EF - F100D4FDFF002EACD80000000000000000000000000000000000E6E5E4000F83 - 190016B4320025BB4F0030C3690018992E00C0D5C200FEFFE100FEFED300FEFE - D300606060008F8F8F0030303000927D7000A18C8200CB9A8200FED7AB00ECEA - EA004571FA008F8E8D00C8ABAB00B9B9B9000000000000000000CC9A9900EFE4 - D800FEFFE100FEEBD700D5B3AF00CC9A9900BFBFBF00C7EFF100C0C0C000CC9A - 9900CC9A9900CDA6A000D5B3AF00CDA6A000CC9A9900F0E4C700FEFED300FEFE - D300FEFED300DAB4A00000000000000000000000000000000000000000000000 - 000037B4E00099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD - FE008DF3FE0037B4E00025A63D0058E0870058E0870018992E00BEE6F500BEE6 - F500FCFEFB00059ACD0000000000000000000000000000000000059ACD007BDD - FE007BDDFE00BA8E8500C7DDE1009BC3D80037B4E00041B3DA0037B4E0002EAC - D800F0FEFE00C2FDFF00C2FDFF0025A63D000F83190068A762009AE3FF00E4FD - FE00E4FDFE002EACD800DFEFF900000000000000000000000000ECEAEA000571 - 0A0016B4320025BB4F0025BB4F0018992E00C0D5C200FFFDF800FEFFE100FEFF - E100F0E4C700C6B8AB004040400059504700FED7AB00FDE8B700FDE8B700FFF8 - EE00FDE8B70086858500B9AAA600B9B9B9000000000000000000CC9A9900EADB - D400E2BDB300CC9A9900C6B8AB00E6E5E400F0FEFE00F9FFFE00E4FDFE00C2FD - FF00C7DDE100BEC6DC00C4C4C400AFCFDE00C8ABAB00CC9A9900FEEBD700FEFE - D300FEFED300DAB4A00000000000000000000000000000000000000000000000 - 000037B4E00099FDFE0099FDFE0099FDFE0099FDFE0099FDFE00ADFBFE0099FD - FE0099FDFE0099FDFE0025A63D0047CE710058E0870018992E002EACD80037B4 - E00037B4E000ACDBF400000000000000000000000000000000001DA6D50084E9 - FE0084E9FE00CB9A8200F8F3EC00FEF4E900FEF0E200FEEBD700FEEBD700C0D5 - C2002EACD800F0FEFE00F0FEFE0005710A00A1C79E00D4FDFF009AE3FF00F0FE - FE00F0FEFE00F0FEFE00059ACD0000000000000000000000000000000000448A - 3E000F83190016B4320025BB4F0018992E00A1C79E00FFFDF800FEFFE100FEFF - E100FEFFE100FEFED300E3D3AA0043424200826A5B00FED7AB00FDF6C600FEEB - D700C7D195008F8F8F0099969700D1D1D1000000000000000000CC9A9900CC9A - 9900CDA6A000BEC6DC00F9FFFE00FFFFFF00F9FFFE00F9FFFE00F0FEFE00F0FE - FE00E4FDFE00E4FDFE00E4FDFE00E4FDFE00D1EFF900C8ABAB00CC9A9900F0E4 - C700FEFFE100DAB4A00000000000000000000000000000000000000000000000 - 000037B4E000D4FDFF0099FDFE0099FDFE0099FDFE00C2FDFF00ACDBF40037B4 - E0002EACD80051B4940025A63D0047CE710058E0870018992E00000000000000 - 00000000000000000000000000000000000000000000000000001DA6D5008DF3 - FE008DF3FE00CB9A8200F8F3EC00FEF9F300FEF4E900FEF0E200FEEBD700FEEB - D700C0D5C2002EACD8002EACD8002EACD800DFEFF900FCFEFE00E4FDFE00FEFE - FE00FEFEFE00FCFEFE00059ACD0000000000000000000000000000000000AFAF - AF0005710A000EA31B0016B4320016B43200448A3E00FFFFFF00FCFEFB00FEF9 - F300FEFFE100FEFED300FEFED300E3D3AA0040404000826A5B00FED7AB00FDE8 - B700B1A097009996970086858500000000000000000000000000CC9A9900CC9A - 9900CC9A9900BEC6DC00FFFEFF00FFFEFF00FFFFFF00FFFFFF00F9FFFE00F9FF - FE00F0FEFE00E4FDFE00F0FEFE00E4FDFE00E4FDFE00D1EFF900B9AAA600CDA6 - A000FEEBD700D5B3AF0000000000000000000000000000000000000000000000 - 00002EACD8009EDEEE00E4FDFE00E4FDFE00D4FDFF00BEE6F5007ECBE600FEFF - FC00FFFEFF0005710A0025BB4F0030C3690047CE710018992E00000000000000 - 00000000000000000000000000000000000000000000000000001DA6D50099FD - FE0099FDFE00DCA88700F8F8F800FEFAF700FFF8EE00FEF4E900FEF0E200FEEB - D700FEEBD700FEE4CA00FED6C900B481760071EBF900059ACD00059ACD00059A - CD00059ACD00059ACD00059ACD0000000000000000000000000000000000E6E5 - E400668E67000F8319000EA31B0016B432000F8319008DBC8B00FFFEFF00FFFF - FF00FFFFFE00FFFDF800FEFED300FEFED300E3D3AA0040404000E3B18E00E3D3 - AA008C89880099969700A8A8A800000000000000000000000000F6EFE700CC9A - 9900C8ABAB0090D1F100FFFFFE00FFFEFF00FFFFFF00FEFEFE00FFFEFF00FFFC - FF00FFFFFF00F0FEFE00F0FEFE00E4FDFE00BEE6F500ACDBF4007ECBE600AB8F - A300CDA6A000CDA6A00000000000000000000000000000000000000000000000 - 0000F0F6FD0037B4E00041B3DA0037B4E00037B4E00005710A0005710A00448A - 3E00448A3E000F83190030C3690047CE710047CE710018992E00000000000000 - 00000000000000000000000000000000000000000000000000001DA6D50099FD - FE0099FDFE00E3B18E00F8FBFB00FFFEFE00FEF9F300FFF8EE00FEF4E900FEF0 - E200FEEBD700FEEBD700FEE4CA00B481760099FDFE0099FDFE002EACD8000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000B9B9B900668E67000F8319000EA31B0016B432000F831900448A3E00A1C7 - 9E00DDEADD00D1EFF900FFFDF8008DBC8B00C7D19500EDD9B700E3D3AA008C89 - 8800A8A8A8008F8E8D00EFEFEF0000000000000000000000000000000000F8F0 - F000CC9A9900A9ACD400FEFFFC00FFFFFF00FFFCFF00D0E3EC00ACDBF40090D1 - F10090D1F10098A9EF0085AFCB00AB8FA300AB8FA300CC9A9900B7A2B600B7A2 - B600CC9A9900CC9A990000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000049AA49000F83190016B4 - 320016B4320025BB4F0025BB4F0030C3690030C3690025BB4F000F8319000F83 - 190005710A0068A76200000000000000000000000000000000001DA6D500D4FD - FF0099FDFE00EDBD9200FFFCFF00FFFFFE00FFFFFF00FEFAF700FFF8EE00FEF4 - E900FEF0E200FECFC200FCA3A200B4817600C2FDFF00ADFBFE002EACD8000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000FAF3F200B5B3B3008DBC8B000F8319000F83190016B4320025BB4F001899 - 2E000F83190005710A0005710A00267D2700E3D3AA00EAC8A10099969700AFAF - AF0099969700CFCFCF0000000000000000000000000000000000000000000000 - 0000F8F0F000A9ACD40098A9EF0070D2FD0070D2FD0070D2FD009AE3FF0090D1 - F10090D1F10090D1F10090D1F10090D1F10098A9EF0098A9EF00A9ACD400B7A2 - B600CC9A9900CC9A990000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000EFF9F00005710A000EA3 - 1B0016B4320016B4320025BB4F0025BB4F0030C3690030C3690025BB4F000F83 - 19008DBC8B0000000000000000000000000000000000000000001DA6D500DFEF - F900E4FDFE00EDBD9200FEFEFE00FFFFFE00FEFEFE00FFFFFF00FEF9F300FEF9 - F300B4817600B4817600B4817600B48176002EACD8002EACD8002EACD8000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000EFEFEF00B9B9B900DDEADD007DA97200267D270005710A000F83 - 190005710A00448A3E007DA97200DAB4A000B1A09700A8A8A800B9B9B9009F9F - 9F00CFCFCF000000000000000000000000000000000000000000000000000000 - 00000000000000000000CDA6A000BFBFBF008DF3FE009AE3FF009AE3FF009AE3 - FF009AE3FF0090D1F10090D1F10090D1F10090D1F10090D1F10098A9EF00B7A2 - B600CC9A9900F1E3E20000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000AFD0B0000571 - 0A000EA31B0016B4320016B4320025BB4F0025BB4F0018992E00267D2700D0E2 - CE000000000000000000000000000000000000000000000000000000000041B3 - DA0041B3DA00EDBD9200FFFEFF00FFFFFF00FFFFFF00FFFFFF00FEFFFC00FEF9 - F300B4817600FECC9A00DCA88700ECDACC000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000EFEFEF00B9B9B900DAD9D900FBFBFC00E6E5E400C7C7 - C700BFBFBF00B9B9B900B5B3B300C4C4C400CFCFCF00C0C0C0009F9F9F00DAD9 - D900000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000CDA6A000BFBFBF008DF3FE008DF3FE009AE3 - FF009AE3FF009AE3FF0090D1F10090D1F10090D1F1009BC3D800CC9A9900D5B3 - AF00000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000000000000049AA - 49000F8319000EA31B0016B4320018992E000F8319008DBC8B00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000EDBD9200FEF0E200FEF0E200F5EADF00EFE4D800EFE4D800EADB - D400B4817600E3B18E00EADBD400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000DAD9D900B9B9B900C0C0C000DAD9 - D900DAD9D900D1D1D100CCCACA00B9B9B900A8A8A800C4C4C400000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000CDA6A000BFBFBF0099FDFE008DF3 - FE009AE3FF009AE3FF009AE3FF0090D1F100B7A2B600CC9A9900F1E3E2000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000F3F3 - F30005710A000EA31B0005710A00448A3E00E1F1E10000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 - 8700DCA88700EFE4D80000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000F3F3F300DFDF - DF00CCCACA00CCCACA00DAD9D900ECEAEA000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000CDA6A000B5B3B3009EDE - EE008DF3FE009AE3FF009BC3D800CC9A9900D5B3AF0000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000AFD0B00005710A00A1C79E00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000D6BCBB00CC9A - 9900CC9A9900CC9A9900CC9A9900F1E3E2000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000009F9F9F0080808000C8AB - AB00000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000D0E3EC0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000D0E3EC00F3F3 - F30000000000000000000000000000000000000000000000000000000000A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 7400A47874008C5D5C0000000000000000000000000000000000000000000000 - 0000000000000000000000000000C8ABAB00CB9A8200BA8E8500B4817600C8AB - AB00E4D1CD00FAF3F20000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000A8A8A8005D71AB005D71AB008D82 - A600C8ABAB000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000066A6C3000C7CAC000C7CAC00D0E3EC000000000000000000000000000000 - 000000000000000000000000000000000000F0F6FD00458EB60066A6C3000C7C - AC0000000000000000000000000000000000000000000000000000000000A478 - 7400E2BDB300F3B9B500F3B9B500F3B9B500F3B9B500F3B9B500F3B9B500F3B9 - B500F3B9B500F3B9B500F3B9B500E2BDB300F3B9B500D5B3AF00F3B9B500F3B9 - B500E3B18E008C5D5C0000000000000000000000000000000000000000000000 - 00000000000000000000BF989500DCA88700EDBD9200F3E3D100F0E4C700E5CD - BE00DAB4A000C8ABAB00CC9A9900D6BCBB00E2D6E200FAF3F200000000000000 - 00000000000000000000000000000000000085AFCB004BAFFF003A80E0005D71 - AB008D82A600CDA6A00000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000C7CAC0084E9FE0004B8EA000C7CAC00AFCFDE0000000000000000000000 - 0000000000000000000000000000D0E3EC002783AC009BC3D800D4FDFF002EAC - D800C0D9E600000000000000000000000000000000000000000000000000A478 - 7400DED2CA00FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDD - BB00FEDDBB00FED7AB00FEDDBB00FED7AB00FED7AB00FED7AB00F3D1A300FECC - 9A00FECFC2008C5D5C0000000000000000000000000000000000000000000000 - 0000ECEAEA00D6A89400E3B18E00EDBD9200EAC8A100EFE4D800F3E3D100F0E4 - C700ECDACC00EDD9B700B4817600BA8E8500BA8E8500BA8E8500BF989500C8AB - AB00DBC9C600F8F0F0000000000000000000ACDBF40061C6FE004BAFFF003A80 - E0005D71AB008D82A600C8ABAB00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000458EB600D0E3EC0010D1FE0004B8EA000C7CAC009BC3D800000000000000 - 00000000000000000000D0E3EC002783AC00ACDBF4008DF3FE003FE0FF000C7C - AC0000000000000000000000000000000000000000000000000000000000A478 - 7400DED7D300FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEDD - BB00FDE8B700FDE8B700FED7AB00FED7AB00FED7AB00FED7AB00FED7AB00F3D1 - A300FECFC2008C5D5C000000000000000000000000000000000000000000F6EF - E700D6A89400EDBD9200EDBD9200EDBD9200EAC8A100FEEBD700EFE4D800F3E3 - D100F0E4C700ECDACC00A4787400A4787400B4817600BF989500E3D3AA00DAB4 - A000D6A89400A18C8200BF9895000000000000000000ACDBF40061C6FE004BAF - FF003A80E0005D71AB008D82A600C8ABAB000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000AFCFDE0066A6C30084E9FE0010D1FE0010D1FE00059ACD0066A6C3000000 - 0000000000009BC3D8002783AC00C7EFF10063E5FD0010D1FE001DA6D50066A6 - C30000000000000000000000000000000000000000000000000000000000B481 - 7600DED7D300FEEBD700FEEBD700FEEBD700029A0300FEE4CA00FEE4CA00C7D1 - 95007DA972008DBC8B00E3D3AA00FEDDBB00FED7AB00FED7AB00FED7AB00FED7 - AB00FECFC2008C5D5C0000000000000000000000000000000000EADBD400D6A8 - 9400F3D1A300FECC9A00EAC8A100EDBD9200EAC8A100F5EADF00EFE4D800EFE4 - D800F3E3D100ECDACC00986B6600986B6600986B6600BA8E8500E3D3AA00E3D3 - AA00E3D3AA00EAC8A100BA8E850000000000000000000000000090D1F10061C6 - FE004BAFFF003A80E0005D71AB008D82A600C8ABAB0000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000002783AC00D1EFF90010D1FE0010D1FE003FE0FF002EACD8002783 - AC0085AFCB00458EB600DFEFF90084E9FE0010D1FE0010D1FE000C7CAC00DFEF - F90000000000000000000000000000000000000000000000000000000000B481 - 7600DAD9D900FEF0E200FEEBD700FEEBD700029A03007ACE7F0049AA4900029A - 0300029A0300029A0300029A030068A76200FDE8B700FED7AB00FED7AB00FED7 - AB00FECFC2008C5D5C00000000000000000000000000F1E3E200DAB4A000FED7 - AB00F3D1A300F3D1A300FECC9A00EDBD9200F3D1A300F6EFE700F5EADF00F5EA - DF00F3E3D100F3E3D100986B6600986B6600986B6600A18C8200EDD9B700E3D3 - AA00E3D3AA00E3D3AA00BA8E850000000000000000000000000000000000ACDB - F40061C6FE004BAFFF003A80E0005D71AB008D82A600D5B3AF00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000009BC3D80085AFCB0063E5FD0010D1FE0010D1FE003FE0FF004BBD - E00066A6C300F0FEFE008DF3FE003FE0FF0010D1FE0004B8EA002783AC000000 - 000000000000000000000000000000000000000000000000000000000000B481 - 7600DFDFDF00FEF0E200FEF0E200FEEBD700029A0300029A0300029A0300029A - 0300029A0300029A0300029A0300029A030068A76200FED7AB00FED7AB00FED7 - AB00FECFC2008C5D5C00000000000000000000000000DAB4A000E3D3AA00EDD9 - B700F3D1A300F3D1A300F3D1A300EAC8A100F3D1A300F6EFE700F6EFE700F5EA - DF00EFE4D800F3E3D100986B6600986B6600986B6600B4817600EDD9B700EDD9 - B700EDD9B700E3D3AA00BA8E8500000000000000000000000000000000000000 - 000090D1F10061C6FE004BAFFF003A80E0005D71AB00AB8FA300000000000000 - 0000F8F0F000DED7D300DED2CA00EADBD400EFE4D800F1E3E200F8F0F0000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000F3F3F3002783AC00D1EFF90010D1FE0010D1FE003FE0FF0063E5 - FD0099FDFE00ADFBFE008DF3FE0063E5FD003FE0FF00059ACD009BC3D8000000 - 000000000000000000000000000000000000000000000000000000000000B481 - 7600E1E0E000FEF4E900FEF0E200FEF0E200029A0300029A0300029A0300029A - 03000EA31B007ACE7F0068A76200029A0300029A0300C7D19500FED7AB00FEDD - BB00FECFC2008C5D5C00000000000000000000000000DAB4A000F3D1A300FED7 - AB00FED7AB00F3D1A300F3D1A300FECC9A00EDD9B700F8F3EC00FEF4E900F5EA - DF00F5EADF00EFE4D800986B6600986B6600986B6600B4817600EDD9B700EDD9 - B700E3D3AA00E3D3AA00BA8E8500000000000000000000000000000000000000 - 000000000000ACDBF4005DB2FC004BAFFF00458EB60099969700D1D1D100E4D1 - CD00BF989500BA8E8500BF989500CDA6A000C8ABAB00CDA6A000D5B3AF00E4D1 - CD00000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000066A6C300ACDBF4003FE0FF0010D1FE0010D1FE0063E5 - FD0071EBF90099FDFE0099FDFE0071EBF9003FE0FF000C7CAC00F2FAF5000000 - 000000000000000000000000000000000000000000000000000000000000BA8E - 8500E6E5E400FEF4E900FEF4E900FEF0E200029A0300029A0300029A0300029A - 03008DBC8B00FEE4CA00FEE4CA00EDD9B70049AA490049AA4900FEDDBB00FEDD - BB00FED6C9008C5D5C00000000000000000000000000DAB4A000E3D3AA00FDE8 - B700FED7AB00F3D1A300EDBD9200EDBD9200F3D1A300FEF9F300F8F3EC00F6EF - E700F5EADF00F5EADF00986B6600986B6600986B6600B4817600ECDACC00EDD9 - B700EDD9B700EDD9B700BA8E8500000000000000000000000000000000000000 - 00000000000000000000ACDBF40090D1F100CFCFCF00A4968E00A18C8200CB9A - 8200EAC8A100FDE8B700FDF6C600FEFED300FEFED300FDF6C600E5CDBE00CDA6 - A000D5B3AF000000000000000000000000000000000000000000000000000000 - 000000000000000000009BC3D800458EB6009AE3FF0010D1FE0010D1FE003FE0 - FF0071EBF9008DF3FE0099FDFE008DF3FE004BBDE000458EB600000000000000 - 000000000000000000000000000000000000000000000000000000000000BA8E - 8500E6E5E400FFF8EE00FEF4E900FEF0E200029A0300029A0300029A0300029A - 0300029A0300029A0300FEE4CA00FEE4CA00EDD9B70025A63D00FED7AB00FEDD - BB00FECFC200986B6600000000000000000000000000DAB4A000EDD9B700FDE8 - B700EAC8A10085AFCB004493ED004493ED00CABCB700FDFAFA00F9F6F500F8F3 - EC00F6EFE700F5EADF00E4D1CD00D8C5B500CDA6A000BF989500F0E4C700ECDA - CC00EDD9B700EDD9B700BA8E8500000000000000000000000000000000000000 - 0000000000000000000000000000F0F6FD00E6E5E400BF989500CB9A8200EDD9 - B700FDF6C600FEFED300FEFED300FEFED300FEFFE100FEFFE100FFFDF800F6EF - E700C8ABAB00C8ABAB0000000000000000000000000000000000000000000000 - 00000000000085AFCB000C7CAC0004B8EA0010D1FE0010D1FE0010D1FE003FE0 - FF003FE0FF008DF3FE0099FDFE0099FDFE0063E5FD001DA6D500458EB600DFEF - F90000000000000000000000000000000000000000000000000000000000BA8E - 8500ECEAEA00FFF8EE00FEF4E900FEF4E900FEF4E900FEF4E900FEF0E200FEF0 - E200FEEBD700FEE4CA00FEEBD700FEE4CA00FEE4CA00FEE4CA00EDD9B700FEDD - BB00FECFC200986B6600000000000000000000000000DAB4A000F3D1A300EAC8 - A10085AFCB004BAFFF00399CFE00399CFE004493ED00D1EFF900FEFAF700F9F6 - F500F8F3EC00F6EFE700F6EFE700F5EADF00EFE4D800F3E3D100F3E3D100F0E4 - C700ECDACC00EDD9B700BA8E8500000000000000000000000000000000000000 - 000000000000000000000000000000000000EADBD400CC9A9900FED7AB00FDF6 - C600FDF6C600FDF6C600FEFED300FEFFE100FEFFE100FFFDF800FFFFFF00FEFE - FE00F6EFE700BF989500DFDFDF0000000000000000000000000000000000C0D9 - E6002783AC00059ACD0010D1FE003FE0FF003FE0FF0010D1FE0010D1FE0010D1 - FE003FE0FF0071EBF90099FDFE0099FDFE0071EBF90063E5FD0004B8EA000C7C - AC0085AFCB00000000000000000000000000000000000000000000000000CB9A - 8200ECEAEA00FDFAFA00FEF9F3007ACE7F00FEF0E200FEF0E200FEF0E200FEF0 - E200FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDD - BB00FED6C900986B6600000000000000000000000000DAB4A000C6B8AB0061C6 - FE0061C6FE004BAFFF004BAFFF00399CFE00399CFE004493ED00DFEFF900FDFA - FA00FEF9F300F8F3EC00F6EFE700F5EADF00F5EADF00EFE4D800F3E3D100F3E3 - D100ECDACC00ECDACC00BF989500F1E3E2000000000000000000000000000000 - 000000000000000000000000000000000000E2BDB300DAB4A000FDF6C600FDE8 - B700FDE8B700FEFED300FEFED300FEFFE100FEF9F300FFFDF800FEFEFE00FFFD - F800FEFFE100E5CDBE00BF9895000000000000000000F3F3F30066A6C3000C7C - AC0004B8EA0063E5FD0071EBF90063E5FD003FE0FF0010D1FE0010D1FE0010D1 - FE003FE0FF0063E5FD008DF3FE0099FDFE008DF3FE0071EBF9003FE0FF0010D1 - FE00059ACD000C7CAC00C0D9E60000000000000000000000000000000000CB9A - 8200EFEFEF00FFFDF800FEF9F3007ACE7F00BBE5B900FEF4E900FEF4E900FEF0 - E200029A0300029A0300029A0300029A0300029A0300FEE4CA00FEE4CA00FEE4 - CA00FED6C900986B6600000000000000000000000000C6B8AB0061C6FE0061C6 - FE0061C6FE0061C6FE004BAFFF004BAFFF00399CFE00399CFE004493ED00DFEF - F900FDFAFA00FEF9F300F8F3EC00F6EFE700F5EADF00F5EADF00EFE4D800F3E3 - D100EADBD400BF989500BF989500F1E3E2000000000000000000000000000000 - 0000000000000000000000000000ECEAEA00CDA6A000EDD9B700FDF6C600FED7 - AB00FDE8B700FEFED300FEFED300FEFFE100FFFDF800FFFDF800FFFDF800FEF9 - F300FEFFE100F0E4C700B4817600ECEAEA009BC3D8000C7CAC0004B8EA0010D1 - FE008DF3FE0099FDFE008DF3FE0071EBF9003FE0FF0010D1FE0010D1FE0010D1 - FE0010D1FE003FE0FF0071EBF90099FDFE0099FDFE008DF3FE003FE0FF0010D1 - FE0010D1FE0010D1FE000C7CAC0085AFCB00000000000000000000000000CB9A - 8200EFEFEF00F9FFFE00FEFAF700D0E2CE000EA31B00BBE5B900FEF4E900FEF0 - E200FEEBD70025A63D00029A0300029A0300029A0300FEEBD700FEE4CA00FEE4 - CA00FECFC200986B66000000000000000000ACDBF4004BAFFF005DB2FC0061C6 - FE0061C6FE0061C6FE0061C6FE005DB2FC004BAFFF00399CFE00399CFE005DB2 - FC00F0F6FD00F9F6F500F9F6F500F8F3EC00F6EFE700F5EADF00F5EADF00EFE4 - D800AB8FA3008D82A600DED7D300000000000000000000000000000000000000 - 0000000000000000000000000000F1E3E200CDA6A000FDF6C600FDE8B700FED7 - AB00FDE8B700FDF6C600FEFED300FEFFE100FEFFE100FFF8EE00FFF8EE00FEFF - E100FEFED300FDF6C600BF989500F1E3E2002783AC003FE0FF0063E5FD00ADFB - FE00C2FDFF00C2FDFF00D4FDFF00D4FDFF00D4FDFF00FCFEFE003FE0FF0010D1 - FE0010D1FE003FE0FF0063E5FD00E4FDFE00E4FDFE00D4FDFF00ADFBFE008DF3 - FE0063E5FD003FE0FF0063E5FD002783AC00000000000000000000000000CB9A - 8200F3F3F300FFFFFF00FFFEFF00FFFDF80049AA4900029A03007ACE7F00D8EB - CC00D8EBCC0049AA4900029A0300029A0300029A0300FEEBD700FEEBD700FEE4 - CA00FECFC200A47874000000000000000000DFEFF9004BAFFF004BAFFF005DB2 - FC0061C6FE0061C6FE0061C6FE0061C6FE005DB2FC004BAFFF00399CFE00399C - FE005DB2FC00F0F6FD00FEF9F300F9F6F500F6EFE700F6EFE700F5EADF008D82 - A6008D82A600D1CDE40000000000000000000000000000000000000000000000 - 0000000000000000000000000000F1E3E200CDA6A000FDF6C600FDE8B700FED7 - AB00FDE8B700FDF6C600FEFED300FEFED300FEFFE100FEFFE100FEFFE100FEFE - D300FEFED300FEFED300BF989500F1E3E200458EB60066A6C30085AFCB0066A6 - C30066A6C300458EB600458EB6002783AC002783AC0066A6C3007BDDFE0010D1 - FE0010D1FE003FE0FF0037B4E0002783AC002783AC002783AC00458EB60066A6 - C30066A6C30085AFCB0085AFCB002783AC00000000000000000000000000DCA8 - 8700F3F3F300FFFFFF00FEFEFE00FFFEFF00D8EBCC00029A0300029A0300029A - 0300029A0300029A0300029A0300029A0300029A0300FEEBD700FEEBD700FEEB - D700F3B9B500A4787400000000000000000000000000DFEFF9004BAFFF004BAF - FF005DB2FC0061C6FE0061C6FE0061C6FE0061C6FE005DB2FC004BAFFF004BAF - FF00399CFE004BAFFF00F0F6FD00FEF9F300F9F6F500F8F0F00085AFCB005D71 - AB00BEC6DC000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000F1E3E200CDA6A000FDF6C600FDF6C600FDE8 - B700FDE8B700FDE8B700FDF6C600FEFED300FEFED300FEFED300FEFED300FEFE - D300FEFED300FDE8B700BA8E8500E6E5E400F0F6FD009BC3D800C0D9E600C0D9 - E600C0D9E600F2FAF500000000000000000000000000458EB600ADFBFE0010D1 - FE0010D1FE0010D1FE00059ACD00C7DDE100000000000000000000000000C0D9 - E600C0D9E600C0D9E6009BC3D800DFEFF900000000000000000000000000DCA8 - 8700F3F3F300FFFFFF00FFFEFF00FFFFFF00FFFDF80091DEA900029A0300029A - 0300029A0300029A0300029A03000EA31B00029A0300FEEBD700F3B9B500FCA3 - A200FCA3A200A478740000000000000000000000000000000000DFEFF9004BAF - FF004BAFFF004BAFFF0061C6FE0061C6FE0061C6FE0061C6FE005DB2FC004BAF - FF004BAFFF00399CFE005DB2FC00F0F6FD00F0FEFE0085AFCB005D71AB00BEC6 - DC00000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000F8F0F000DAB4A000EDD9B700FEFFE100FEE4 - CA00FDE8B700FED7AB00FDE8B700FDE8B700FDF6C600FDF6C600FDF6C600FDF6 - C600FEFED300FED7AB00B4817600F8F0F0000000000000000000000000000000 - 00000000000000000000000000000000000000000000458EB600D1EFF90010D1 - FE0010D1FE0010D1FE000C7CAC00000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000DCA8 - 8700F8F8F800FFFFFF00FEFEFE00FFFFFF00FFFEFF00FEFEFE00DDEADD007ACE - 7F0049AA490049AA49007ACE7F00FEEBD700029A0300E2BDB300D6A89400DCA8 - 8700CB9A8200A47874000000000000000000000000000000000000000000D1EF - F9004BAFFF004BAFFF004BAFFF0061C6FE0061C6FE0061C6FE0061C6FE0061C6 - FE004BAFFF004BAFFF00399CFE005DB2FC0098A9EF003A80E000C0D9E6000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000D6BCBB00E2BDB300FFF8EE00FEFF - FC00FEF9F300FEE4CA00FDE8B700FDE8B700FDE8B700FDE8B700FDE8B700FDF6 - C600FDF6C600D6A89400C8ABAB00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000085AFCB00AFCFDE003FE0 - FF0010D1FE0004B8EA00458EB600000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000DCA8 - 8700FAFAFA00FFFFFF00FCFEFE00FFFFFF00FFFFFF00FFFEFE00FEFAF700FEFA - F700FFF8EE00FFF8EE00FEF4E900FEF4E900FEF4E900B4817600B4817600B481 - 7600B4817600A478740000000000000000000000000000000000000000000000 - 0000D1EFF9005DB2FC004BAFFF004BAFFF0061C6FE0061C6FE0070D2FD0061C6 - FE0061C6FE004BAFFF004BAFFF00399CFE00399CFE006682F100000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000ECEAEA00CDA6A000ECDACC00FFFF - FF00FFFFFF00FEE4CA00FDE8B700FED7AB00F3D1A300FED7AB00FDF6C600FDF6 - C600EDBD9200B481760000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000C7DDE10066A6C30084E9 - FE0010D1FE0004B8EA0085AFCB00000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000E3B1 - 8E00FFFDF800FFFEFF00FFFFFF00FFFFFF00FFFEFF00FFFFFE00FFFEFF00FFFF - FF00FFFDF800FDFAFA00FEF9F300FEF9F300FFF8EE00B4817600FCB04C00DCA8 - 8700CB9A8200E4D1CD0000000000000000000000000000000000000000000000 - 000000000000000000005DB2FC004BAFFF004BAFFF005DB2FC0061C6FE0061C6 - FE0061C6FE0061C6FE004BAFFF004493ED003A80E0006682F100000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000DED7D300CDA6A000EADB - D400FCFEFE00FFF8EE00FDF6C600FDF6C600FDF6C600FEFED300FDE8B700EDBD - 9200BA8E8500DFDFDF0000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000002783AC00C2FD - FF0010D1FE00059ACD00C0D9E600000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000E3B1 - 8E00FEFEFE00FFFEFE00FFFFFE00FFFFFF00FFFFFF00FEFEFE00FFFFFE00FFFF - FE00FFFEFF00FFFDF800FFFDF800FEF9F300FEF9F300B4817600DCA88700CB9A - 8200ECDACC000000000000000000000000000000000000000000000000000000 - 00000000000000000000F0F6FD004BAFFF004BAFFF004BAFFF005DB2FC0070D2 - FD009AE3FF00D1EFF9007C7FCC0002019A000732DE006682F100000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000EADBD400BA8E - 8500D6A89400EDD9B700FDE8B700FDF6C600FDE8B700E3D3AA00D6A89400BF98 - 9500F1E3E2000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000458EB600DFEF - F9003FE0FF000C7CAC0000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000E3B1 - 8E00FFFFFE00FCFEFB00FFFCFF00F8FBFB00FAFAFA00FAFAFA00F9F6F500F9F6 - F500F3F3F300EFEFEF00EFEFEF00ECEAEA00ECEAEA00B4817600DCA88700EADB - D400000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000F0FEFE00ACDBF400BEE6F500F0F6FD000000 - 000000000000000000007C7FCC0002019A00295AF7006682F100000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000FAF3 - F200CABCB700BA8E8500B4817600BA8E8500BF989500CC9A9900D6BCBB000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000066A6C300AFCF - DE0060D4F000458EB60000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 - 8700DCA88700DCA88700DCA88700DCA88700DCA88700B4817600F3E3D1000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000BEC6DC008D82A6008D82A600D1CDE400000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000002783 - AC000C7CAC00AFCFDE0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000D0E2CE00C0D5C200C7C7 - C700C0D5C200C0D5C200EFEFEF00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000EFF9F000C0D5C200C7C7 - C700C0D5C200C0D5C200DDEADD00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000E1F1E1007DA97200267D27000450070005710A000571 - 0A0005710A000450070004500700255E2800A8A8A80000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000A1C79E00267D27000450070005710A000571 - 0A0005710A000450070004500700255E2800668E6700DDEADD00000000000000 - 000000000000000000000000000000000000000000000000000000000000A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 7400A47874008C5D5C000000000000000000CC670100CC670100CC670100CC67 - 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 - 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 - 0100CC670100CC670100CC670100000000000000000000000000000000000000 - 0000000000008DBC8B0005710A000F8319000EA31B0016B4320009B2190009B2 - 190009B2190009B21900029A03000F83190004500700255E2800D1D1D1000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000D0E2CE000F83190005710A0018992E0009B2190009B2190009B2 - 190009B2190009B2190009B21900029A030005710A0004500700879185000000 - 000000000000000000000000000000000000000000000000000000000000A478 - 7400E2BDB300F3B9B500F3B9B500F3B9B500F3B9B500F3B9B500F3B9B500F3B9 - B500F3B9B500F3B9B500F3B9B500E2BDB300F3B9B500D5B3AF00F3B9B500F3B9 - B500E3B18E008C5D5C000000000000000000CC670100FFFFFE00FFFFFF00FEFA - F700FEF9F300FFF8EE00FEF4E900FEF0E200FEF0E200FEEBD700FEEBD700FEEB - D700FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7 - AB00FED7AB00FED7AB00CC67010000000000000000000000000000000000EFF9 - F00049AA490005710A0016B4320016B4320016B4320016B4320016B4320009B2 - 190009B2190009B2190009B2190009B2190009B2190005710A0004500700A8A8 - A800000000000000000000000000000000000000000000000000000000000000 - 0000A1C79E0005710A0018992E0016B4320016B4320016B4320016B4320009B2 - 190009B2190009B2190009B2190009B2190009B21900029A030004500700668E - 670000000000000000000000000000000000000000000000000000000000A478 - 7400DED2CA00FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDD - BB00FEDDBB00FEDDBB00FEDDBB00FED0B700FED7AB00FED7AB00F3D1A300FECC - 9A00FECFC2008C5D5C000000000000000000CC670100FFFFFE00FFFFFF00FFFF - FF00FEF9F300FEF4E900FEF0E200FEF0E200FEF0E200FEEBD700FEE4CA00FEE4 - CA00FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FED7AB00FED7AB00FED7 - AB00FED7AB00FED0B700CC6701000000000000000000000000000000000068A7 - 62000F83190025BB4F0025BB4F0016B4320016B4320016B4320016B4320016B4 - 320016B4320009B2190009B2190009B2190009B2190009B21900029A03000450 - 0700B9B9B900000000000000000000000000000000000000000000000000A1C7 - 9E000F83190016B4320025BB4F0025BB4F0016B4320016B4320016B4320016B4 - 320016B4320009B2190009B2190009B2190009B2190009B21900029A03000450 - 0700668E6700000000000000000000000000000000000000000000000000A478 - 7400DAD9D900FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDD - BB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00F3D1 - A300FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFFFE00FFFF - FF00999697009996970099969700FEF4E900FEF4E900FEF0E200999697009996 - 970099969700FEE4CA00FEE4CA00FEE4CA00999697009996970099969700FED7 - AB00FEDDBB00FED7AB00CC6701000000000000000000000000008DBC8B000F83 - 190025BB4F0025BB4F0025BB4F0025BB4F0025BB4F0016B4320030C36900EFF9 - F000EFF9F00047CE710009B2190009B2190009B2190009B2190009B21900029A - 030004500700DDEADD0000000000000000000000000000000000E1F1E1000F83 - 190025A63D0025BB4F0025BB4F0025BB4F0025BB4F0016B4320047CE7100F2FA - F500F2FAF50039C3390016B4320009B2190009B2190009B2190009B219000EA3 - 1B00045007009F9F9F000000000000000000000000000000000000000000B481 - 7600DED7D300FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4 - CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7 - AB00FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFFFF00FFFF - FE00FFFFFF00FFFFFF00FFFDF800FEF9F300FFF8EE00FFF8EE00F6EFE700F6EF - E700F3E3D100FEE4CA00FEEBD700FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDD - BB00FEDDBB00FEDDBB00CC6701000000000000000000DDEADD000F83190025BB - 4F0030C3690025BB4F0025BB4F0025BB4F0025BB4F0047CE7100EFF9F000FFFF - FE00FEFEFE0091DEA90016B4320016B4320009B2190009B2190009B2190009B2 - 190005710A00668E67000000000000000000000000000000000049AA49001899 - 2E0030C3690030C3690025BB4F0025BB4F0025BB4F0025BB4F0091DEA900FEFE - FE00FFFFFF00F2FAF50030C3690016B4320009B2190009B2190009B2190009B2 - 19000EA31B0004500700F3F3F30000000000000000000000000000000000B481 - 7600DAD9D900FEF0E200FEEBD700FEEBD700FEEBD700FEEBD700FEE4CA00FEE4 - CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7 - AB00FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFEFF00FFFF - FF004571FA004571FA004571FA00FFFCFB00FEFAF700F6EFE700A23F0800A23F - 0800A23F0800FEEBD700FEEBD700FEE4CA00059ACD00059ACD00059ACD00FEDD - BB00FEDDBB00FEDDBB00CC67010000000000000000007ACE7F0018992E0030C3 - 690030C3690030C3690030C3690030C3690047CE7100F2FAF500FFFFFF00FCFE - FE00EFF9F00025BB4F0016B4320016B4320016B4320016B4320009B2190009B2 - 190009B2190004500700DDEADD000000000000000000D9F3E2000F83190030C3 - 690030C3690030C3690030C3690030C3690025BB4F0025BB4F0047CE7100EFF9 - F000FFFFFF00FCFEFE00F8F8F80039C3390016B4320016B4320009B2190009B2 - 190009B2190005710A007DA9720000000000000000000000000000000000B481 - 7600DFDFDF00FEF0E200FEF0E200FEEBD700FEEBD700A9ACD400EADBD400FEE4 - CA00FEE4CA00FEDDBB00CCC0CC00FEDDBB00FEDDBB00FED7AB00FEDDBB00FED7 - AB00FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFFFE00FFFF - FF004571FA006682F1004571FA00FFFFFF00FEFAF700FEF9F300A23F0800A23F - 0800A23F0800F3E3D100FEEBD700FEEBD700059ACD00059ACD00059ACD00FEDD - BB00FEDDBB00FEDDBB00CC670100000000000000000018992E0025BB4F0030C3 - 690030C3690030C3690030C3690047CE7100F8FBFB00FFFFFF00FEFFFC00F2FA - F50047CE710025BB4F0016B4320016B4320016B4320016B4320016B4320009B2 - 190009B2190005710A007DA9720000000000000000007ACE7F0018992E0030C3 - 690030C3690030C3690030C3690030C3690030C3690025BB4F0025BB4F0047CE - 7100F2FAF500FFFEFF00FFFFFF00EFF9F00030C3690016B4320016B4320009B2 - 190009B219000EA31B00255E280000000000000000000000000000000000B481 - 7600E1E0E000FEF4E900FEF0E200FEF0E20098A9EF000335FB00295AF700EADB - D400FEE4CA0098A9EF000335FB006682F100FED0B700FEDDBB00FEDDBB00FED7 - AB00FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFEFF00FFFF - FF004571FA004571FA004571FA00FFFFFF00FEFEFE00F8F8F800A23F0800A23F - 0800A23F0800FEF0E200FEF0E200FEEBD700059ACD00059ACD00059ACD00FEE4 - CA00FEE4CA00FEE4CA00CC67010000000000E1F1E100029A030030C3690030C3 - 690030C3690030C3690047CE7100F2FAF500FFFFFF00FFFFFF00F8FBFB0047CE - 710025BB4F0025BB4F0025BB4F0016B4320016B4320016B4320016B4320016B4 - 320016B432000F831900448A3E00000000000000000049AA490025BB4F0030C3 - 690030C3690030C3690030C3690030C3690030C3690030C3690030C3690030C3 - 690047CE7100F2FAF500FCFEFE00FFFFFE00F2FAF50030C3690016B4320016B4 - 320016B4320009B2190004500700DDEADD00000000000000000000000000BA8E - 8500E6E5E400FEF4E900FEF4E900E2D6E2000335FB000335FB000335FB00295A - F70098A9EF000335FB000335FB000335FB00A9ACD400FEDDBB00FEDDBB00FEDD - BB00FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFFFF00FFFF - FE00FFFEFF00FCFEFE00FEFFFC00FFFFFF00FFFEFF00FFFDF800FEF9F300FFF8 - EE00FEF4E900FEF0E200FEF0E200FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4 - CA00FEE4CA00FEE4CA00CC67010000000000BBE5B9000EA31B0030C3690030C3 - 690030C3690058E08700F9F6F500FCFEFE00FFFFFE00FFFFFE00AFE6BF0091DE - A90091DEA90091DEA90091DEA90091DEA90091DEA90091DEA90047CE710016B4 - 320016B432000EA31B0005710A0000000000000000000EA31B0025BB4F0030C3 - 690030C3690058E08700AFE6BF0091DEA90091DEA90091DEA90091DEA90091DE - A90091DEA900AFE6BF00FFFFFF00FFFEFF00FFFFFF00F2FAF50030C3690016B4 - 320016B4320016B4320005710A00C0D5C200000000000000000000000000BA8E - 8500E6E5E400FFF8EE00FEF4E900FEF4E90098A9EF000335FB000335FB000335 - FB000335FB000335FB000335FB006682F100FEDDBB00FEE4CA00FEDDBB00FEDD - BB00FED6C900986B66000000000000000000CC670100FFFFFF00FFFFFF00FFFF - FF00B5B3B300B5B3B300B5B3B300FFFFFE00FFFFFE00FFFFFF00B5B3B300B5B3 - B300AFAFAF00FFF8EE00FEF4E900FEF0E200AFAFAF00AFAFAF00B9AAA600FEE4 - CA00FEE4CA00FEE4CA00CC67010000000000BBE5B9000EA31B0030C3690030C3 - 690047CE7100F2FAF500FFFFFF00FFFFFE00FCFEFE00FFFFFF00FFFFFF00FFFE - FF00FFFFFF00FFFEFF00FCFEFE00FFFFFF00FFFEFF00FEFFFC0091DEA90016B4 - 320016B432000EA31B0005710A000000000000000000029A030030C3690030C3 - 690030C3690091DEA900FFFFFF00FFFEFF00FEFEFE00FFFFFF00FFFFFF00FEFE - FE00FFFFFF00FFFEFF00FFFFFF00FFFEFF00FFFFFF00FEFEFE00F2FAF50030C3 - 690025BB4F0016B4320005710A00C0D5C200000000000000000000000000BA8E - 8500E6E5E400FEF9F300FFF8EE00FEF4E900FEF4E900BEC6DC000335FB000335 - FB000335FB000335FB006682F100FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDD - BB00FECFC200986B66000000000000000000CC670100FFFFFF00FFFFFF00FFFF - FF00FEFEFE00FFFFFF00FFFFFE00FFFEFF00FFFFFF00FFFFFE00FFFFFF00FFFF - FF00FEF9F300FFF8EE00FFF8EE00FFF8EE00FEF4E900FEF4E900FEEBD700FEEB - D700FEEBD700FEEBD700CC67010000000000BBE5B9000EA31B0030C3690030C3 - 690058E08700F0F6FD00FFFFFF00FCFEFE00FFFEFF00FFFEFF00FFFEFF00FFFF - FF00FEFEFE00FFFEFF00F9FFFE00F9FFFE00FFFFFF00FFFFFF0091DEA90025BB - 4F0016B4320016B4320005710A000000000000000000029A030030C3690030C3 - 690030C3690091DEA900FBFBFC00FCFEFE00FFFFFF00F9FFFE00FCFEFE00FFFF - FF00FFFFFF00FFFFFF00FCFEFE00FFFEFF00FCFEFE00FFFFFF00D9F3E20025BB - 4F0016B4320016B432000F831900C0D5C200000000000000000000000000CB9A - 8200ECEAEA00FEFAF700FEF9F300FFF8EE00FFF8EE0098A9EF000335FB000335 - FB000335FB000335FB00295AF700EADBD400FEE4CA00FEE4CA00FEE4CA00FEDD - BB00FED6C900986B66000000000000000000CC670100FFFFFF00FFFFFF00FCFE - FE00CC9A9900CC9A9900CC9A9900FFFEFF00FEFFFC00FFFFFF00E27E0300E27E - 0300E27E0300FEF9F300FEFAF700FEF4E900029A0300029A0300029A0300FEEB - D700FEEBD700FEEBD700CC67010000000000BBE5B90009B2190030C3690030C3 - 690030C3690047CE7100F3F3F300FFFEFF00FFFFFF00FCFEFE00D9F3E20091DE - A90091DEA90091DEA900AFE6BF0091DEA90091DEA90091DEA90047CE710025BB - 4F0025BB4F0025A63D002A8C4300000000000000000016B4320030C3690030C3 - 690030C3690058E08700AFE6BF0091DEA90091DEA900AFE6BF0091DEA90091DE - A90091DEA900D9F3E200FFFFFF00FFFEFF00FFFFFF00D9F3E20030C3690025BB - 4F0025BB4F0025BB4F0005710A00C0D5C200000000000000000000000000CB9A - 8200EFEFEF00FFFDF800FEFAF700FEF9F30098A9EF000335FB000335FB000335 - FB000335FB000335FB000335FB00295AF700EADBD400FEE4CA00FEE4CA00FEE4 - CA00FED6C900986B66000000000000000000CC670100FFFFFF00FFFFFF00FFFF - FF00CC9A9900CC9A9900CC9A9900FFFFFF00FFFEFF00FCFEFE00E27E0300E27E - 0300E27E0300FBFBFC00FEFAF700FFF8EE00029A0300029A0300029A0300FEF0 - E200FEF0E200FEF0E200CC67010000000000EFF9F000029A030047CE710047CE - 710030C3690030C3690058E08700F0F6FD00FFFEFF00FFFFFF00FFFFFF0091DE - A90030C3690030C3690030C3690030C3690030C3690030C3690025BB4F0025BB - 4F0025BB4F0018992E0049AA4900000000000000000039C3390039C3390047CE - 710030C3690030C3690030C3690030C3690030C3690030C3690030C3690030C3 - 690091DEA900F9FFFE00FFFEFF00FEFEFE00D9F3E20030C3690030C3690025BB - 4F0025BB4F0025BB4F0005710A0000000000000000000000000000000000CB9A - 8200EFEFEF00FFFEFE00FDFAFA00DFEFF9000335FB000335FB000335FB006682 - F100D1CDE4000335FB000335FB000335FB0098A9EF00FEE4CA00FEE4CA00FEE4 - CA00FECFC200986B66000000000000000000CC670100FFFFFF00FFFFFF00FFFF - FE00CC9A9900CC9A9900CC9A9900FFFFFE00FFFFFF00FFFFFF00E27E0300E27E - 0300E27E0300FEFFFC00FFFEFF00FEFAF700029A0300029A0300029A0300FEF0 - E200FEF0E200FEF0E200CC670100000000000000000039C3390047CE71007ACE - 7F0047CE710030C3690030C3690047CE7100FCFEFB00FCFEFE00FFFFFF00FCFE - FE0091DEA90030C3690030C3690030C3690030C3690030C3690030C3690030C3 - 690025BB4F000F831900A1C79E00000000000000000091DEA90016B432007ACE - 7F0047CE710047CE710030C3690030C3690030C3690030C3690030C3690091DE - A900FFFFFE00FFFFFF00FCFEFE00D9F3E20030C3690030C3690030C3690030C3 - 690025BB4F0018992E0049AA490000000000000000000000000000000000CB9A - 8200F3F3F300FFFFFE00FEFEFE00FEFEFE0098A9EF000335FB006682F100FEF4 - E900FEF4E900D1CDE4000335FB006682F100FEEBD700FEEBD700FEEBD700FEE4 - CA00FECFC200986B66000000000000000000CC670100FFFFFF00FFFFFF00FFFF - FF00FEFEFE00FFFEFE00FFFFFF00FFFEFF00FFFFFE00FFFEFF00FFFEFF00FFFF - FE00FFFEFF00FFFFFF00FFFFFF00FDFAFA00FEFAF700FFF8EE00FEF4E900FEF0 - E200FEF0E200FEF0E200CC670100000000000000000091DEA90009B2190091DE - A9007ACE7F0058E0870047CE710030C3690051B49400F8FBFB00FFFCFF00FFFE - FF00FFFFFF0047CE710030C3690030C3690030C3690030C3690030C3690030C3 - 690025BB4F000F831900EFF9F0000000000000000000EFF9F00009B219007ACE - 7F0091DEA90058E0870047CE710030C3690030C3690030C3690058E08700FBFB - FC00FEFEFE00FFFEFF00D9F3E20047CE710030C3690030C3690030C3690030C3 - 690030C369000F831900AFD0B00000000000000000000000000000000000DCA8 - 8700F3F3F300FCFEFE00FFFEFF00FFFCFB00FEFAF700CED7FA00FFF8EE00FAF3 - F200FEF4E900FEF4E900E2D6E200FEF0E200FEEBD700FEEBD700FEEBD700FEEB - D700F3B9B500A47874000000000000000000CC670100FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FEFEFE00FFFFFF00FFFEFF00FFFFFF00FFFFFE00FFFF - FF00FFFFFF00FFFEFF00FEFFFC00FEFAF700FEF9F300FFF8EE00FEF4E900FEF0 - E200FEF0E200FEF0E200CC67010000000000000000000000000039C3390047CE - 710091DEA90091DEA9007ACE7F0058E0870030C3690058E08700F0FEFE00FFFF - FF00FBFBFC0058E0870030C3690030C3690030C3690030C3690030C3690030C3 - 69000F831900AFD0B000000000000000000000000000000000007ACE7F0016B4 - 320091DEA90091DEA90058E087007ACE7F0047CE710030C369007ACE7F00FFFE - FF00FEFEFE00D9F3E20047CE710030C3690030C3690030C3690030C3690030C3 - 690025A63D0049AA49000000000000000000000000000000000000000000DCA8 - 8700F9F6F500FFFFFF00FFFFFF00FFFFFF00FEFEFE00FFFDF800FEFAF700FFF8 - EE00FFF8EE00FEF4E900FEF4E900FEF0E200FEF0E200FEEBD700F3B9B500FCA3 - A200FCA3A200A47874000000000000000000CC670100E27E0300E27E0300E27E - 0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E - 0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E - 0300E27E0300E27E0300CC670100000000000000000000000000D8EBCC0009B2 - 190091DEA90091DEA90091DEA9007ACE7F0058E0870047CE710051B49400AFE6 - BF00AFE6BF0030C3690030C3690030C3690030C3690030C3690030C369001899 - 2E0049AA490000000000000000000000000000000000000000000000000039C3 - 390039C33900AFE6BF0091DEA90091DEA90058E0870047CE710047CE710091DE - A900AFE6BF0047CE710030C3690030C3690030C3690030C3690030C3690025BB - 4F000F831900D9F3E2000000000000000000000000000000000000000000DCA8 - 8700F8F8F800FFFEFF00FFFFFF00FFFEFF00FFFFFF00FFFEFF00FFFDF800FEFA - F700FFF8EE00FFF8EE00FEF4E900FEF4E900FEF4E900E2BDB300D6A89400DCA8 - 8700CB9A8200A47874000000000000000000D3936400CC670100CC670100CC67 - 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 - 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 - 0100CC670100CC670100CC6701000000000000000000000000000000000091DE - A90009B2190091DEA900BBE5B90091DEA90091DEA9007ACE7F0047CE710047CE - 710030C3690030C3690030C3690030C3690030C3690030C369000EA31B0025A6 - 3D00EFF9F000000000000000000000000000000000000000000000000000EFF9 - F00039C3390039C33900BBE5B90091DEA90091DEA9007ACE7F0058E0870051B4 - 940030C3690030C3690030C3690030C3690030C3690030C3690025BB4F00029A - 0300A1C79E00000000000000000000000000000000000000000000000000E3B1 - 8E00FAFAFA00FFFFFF00FFFFFF00FFFEFE00FFFFFF00FFFFFF00FFFEFE00FFFD - F800FEFAF700FEF9F300FFF8EE00FEF4E900FEF4E900B4817600B4817600B481 - 7600B4817600A47874000000000000000000F3E3D100C56E2600CC670100CC67 - 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 - 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 - 0100CC670100CC670100EAC8A100000000000000000000000000000000000000 - 0000BBE5B90009B2190047CE7100BBE5B900AFE6BF0091DEA90091DEA90058E0 - 870047CE710030C3690030C3690030C3690025BB4F000EA31B0025A63D00EFF9 - F000000000000000000000000000000000000000000000000000000000000000 - 0000EFF9F00039C3390039C3390091DEA900BBE5B90091DEA90091DEA90058E0 - 870058E0870030C3690030C3690030C3690030C3690016B432000EA31B00AFD0 - B00000000000000000000000000000000000000000000000000000000000E3B1 - 8E00FBFBFC00FFFFFF00FFFEFF00FFFFFE00FFFEFF00FFFFFE00FFFFFF00FFFF - FF00FFFDF800FFFDF800FEFAF700FFF8EE00FFF8EE00B4817600FCB04C00DCA8 - 8700CB9A8200E4D1CD0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000E1F1E10047CE710009B2190039C339007ACE7F007ACE7F007ACE - 7F007ACE7F0030C3690025BB4F000EA31B000EA31B007ACE7F00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000007ACE7F0009B2190039C339007ACE7F007ACE7F007ACE - 7F007ACE7F0047CE710025BB4F0016B43200029A030047CE7100E1F1E1000000 - 000000000000000000000000000000000000000000000000000000000000E3B1 - 8E00FEFEFE00FFFFFF00FFFFFE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FEFE - FE00FFFFFF00FFFDF800FDFAFA00FEF9F300FEF9F300B4817600DCA88700CB9A - 8200EADBD4000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000D9F3E2007ACE7F0039C3390009B2190009B2 - 190009B2190039C3390039C3390091DEA900EFF9F00000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000EFF9F00091DEA90039C3390039C3390009B2 - 190009B2190009B2190039C3390091DEA900E1F1E10000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000E3B1 - 8E00FCFEFE00FCFEFE00FEFEFE00FBFBFC00FAFAFA00F8F8F800F8F8F800F3F3 - F300F3F3F300F3F3F300EFEFEF00ECEAEA00F6EFE700B4817600DCA88700EADB - D400000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 - 8700DCA88700DCA88700DCA88700DCA88700DCA88700B4817600F3E3D1000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000FAF3F200D6A89400D6A89400F1E3E20000000000000000000000 - 0000000000000000000000000000FAF3F200DAB4A000D6A89400FAF3F2000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000A4787400A4787400A4787400A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 7400A47874008C5D5C0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000F3F3F300A23F0800A23F0800AF4B0200A23F0800DAB4A000000000000000 - 00000000000000000000EADBD400A23F0800AF4B0200AF4B0200A23F0800EADB - D400000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000A4787400A4787400A4787400A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 7400A4787400A47874008C5D5C00000000000000000000000000000000000000 - 000000000000000000000000000000000000A4787400D8C5B500FECFC200FECF - C200FECFC200FECFC200FECFC200FECFC200FECFC200FECFC200FECFC200FECF - C200FECFC2008C5D5C0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000D3936400AF4B0200AF4B0200A23F0800AF4B0200A23F0800EADBD4000000 - 000000000000F5EADF00A23F0800AF4B0200A23F0800AF4B0200BD580100BD79 - 5800000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000B4817600DBC9C600FECFC200FECF - C200FECFC200FECFC200FECFC200FECFC200FECFC200FECFC200FECFC200FECF - C200FECFC200FECFC2008C5D5C00000000000000000000000000000000007ECB - E60041B3DA0041B3DA0041B3DA0041B3DA00A4787400DBC9C600F6EFE700F6EF - E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF - E700FEDDBB008C5D5C00000000000000000000000000059ACD00059ACD00D1EF - F900000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000B3664100BD580100CB9A8200F8F3EC00BD795800AF4B0200BD7958000000 - 000000000000B4817600AF4B0200BD79580000000000BD795800BD580100AB56 - 2900000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000B4817600D8C5B500F6EFE700F6EF - E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF - E700F6EFE700FEDDBB008C5D5C000000000000000000000000007ECBE6001DA6 - D50060D4F00071EBF90071EBF90071EBF900B4817600E5CDBE00F6EFE700FEDD - BB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00FED7AB00F6EF - E700FEDDBB00986B6600000000000000000000000000059ACD0064C1E1004BBD - E000059ACD0041B3DA007ECBE600BEE6F500F0F6FD0000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000B3664100AF4B0200E2BDB30000000000F1E3E200AF4B0200AF4B02000000 - 000000000000AB562900AF4B02000000000000000000E2BDB300AF4B0200AB56 - 2900000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000B4817600E5CDBE00F6EFE700F6EF - E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF - E700F6EFE700FEDDBB008C5D5C0000000000000000000000000041B3DA008DF3 - FE0070D2FD0070D2FD0070D2FD0070D2FD00B4817600DED2CA00F6EFE700FECC - 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00F6EF - E700FEDDBB008C5D5C00000000000000000000000000059ACD004BBDE000D1EF - F90070D2FD0056C6F00037B4E0001DA6D500059ACD002EACD80064C1E100BEE6 - F500DFEFF9000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000BD795800BD580100BD79580000000000F8F3EC00AF4B0200AF4B02000000 - 000000000000AF4B0200AF4B02000000000000000000BD795800CC670100BD79 - 5800000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000BA8E8500E5CDBE00F6EFE700FEE4 - CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7 - AB00F6EFE700FEDDBB008C5D5C0000000000000000000000000041B3DA008DF3 - FE0070D2FD0070D2FD0070D2FD0070D2FD00BA8E8500DED2CA00F6EFE700F6EF - E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF - E700FEDDBB00986B6600000000000000000000000000059ACD00059ACD00F0F6 - FD007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE0056C6F0004BBDE0001DA6 - D500059ACD001DA6D50064C1E10090D1F100D1EFF90000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000E5CDBE00AF4B0200AF4B0200BD795800BD795800BD580100AF4B0200F1E3 - E20000000000A23F0800BD580100BD795800BD795800BD580100AF4B0200DAB4 - A000000000000000000000000000000000000000000000000000A4787400A478 - 7400A4787400A4787400A4787400A4787400BA8E8500DED2CA00F6EFE700FECC - 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC - 9A00F6EFE700FEDDBB008C5D5C0000000000000000000000000041B3DA008DF3 - FE007BDDFE007BDDFE007BDDFE007BDDFE00BA8E8500ECDACC00F6EFE700FEEB - D700FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00F6EF - E700FEDDBB00986B6600000000000000000000000000059ACD0056C6F0009EDE - EE009AE3FF007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE007BDD - FE0070D2FD003A80E00037B4E00037B4E000059ACD001DA6D500ACDBF4000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000BD795800AF4B0200CC670100CC670100CC670100AF4B0200DAB4 - A000E5CDBE00AF4B0200CC670100BD580100CC670100BD580100BD7958000000 - 0000000000000000000000000000000000000000000000000000A4787400FED6 - C900FED6C900FED6C900FED6C900FED6C900BA8E8500E4D1CD00F6EFE700F6EF - E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700FEF0E200F6EF - E700F6EFE700FEDDBB00986B660000000000000000000000000041B3DA0099FD - FE007BDDFE007BDDFE007BDDFE007BDDFE00CB9A8200EADBD400F6EFE700FECC - 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00F6EF - E700FEDDBB00986B6600000000000000000000000000059ACD0070D2FD004BBD - E000D4FDFF0084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0071EBF9007BDD - FE00295AF7000335FB004493ED0084E9FE0084E9FE0056C6F00037B4E0000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000CB9A8200A23F0800A23F0800A23F0800A23F0800BD79 - 5800B4817600A23F0800A23F0800A23F0800A23F0800BA8E8500FAF3F2000000 - 0000000000000000000000000000000000000000000000000000A4787400F6EF - E700F6EFE700F6EFE700F6EFE700F6EFE700CB9A8200ECDACC00F6EFE700FED7 - AB00FED7AB00FED7AB00FED7AB00FED7AB00FED7AB00FED7AB00F3D1A300F3D1 - A300F6EFE700FEDDBB00986B660000000000000000000000000041B3DA0099FD - FE0084E9FE0084E9FE0084E9FE0084E9FE00CB9A8200EADBD400F6EFE700F6EF - E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF - E700FEDDBB00986B6600000000000000000000000000059ACD0090D1F1002EAC - D800F9FFFE0084E9FE008DF3FE008DF3FE008DF3FE0084E9FE008DF3FE004571 - FA000335FB000335FB00295AF7008DF3FE008DF3FE0061C6FE0060D4F000BEE6 - F500000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000B4817600AB562900826A - 5B00826A5B00B3664100BD795800000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000A4787400F6EF - E700F6EFE700F6EFE700F6EFE700F8F3EC00CB9A8200EADBD400F6EFE700FECC - 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC - 9A00F6EFE700FEDDBB00986B660000000000000000000000000041B3DA00ADFB - FE0084E9FE0084E9FE0084E9FE0084E9FE00CB9A8200EFE4D800F9F6F500FEDD - BB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00F6EF - E700FEDDBB00A4787400000000000000000000000000059ACD0070D2FD0037B4 - E000ACDBF400ADFBFE008DF3FE008DF3FE008DF3FE0099FDFE004571FA000335 - FB000335FB000335FB000335FB007BDDFE008DF3FE0061C6FE0099FDFE004BBD - E000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000F6EFE700826A5B00927D - 7000B1A09700826A5B00DED7D300000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000B4817600F6EF - E700FEDDBB00FEDDBB00FEDDBB00FED7AB00CB9A8200EFE4D800F6EFE700F6EF - E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF - E700F6EFE700FEDDBB00A478740000000000000000000000000041B3DA00ADFB - FE008DF3FE0084E9FE008DF3FE0084E9FE00DCA88700EFE4D800F9F6F500FECC - 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00F6EF - E700FEDDBB00A4787400000000000000000000000000059ACD009AE3FF0056C6 - F00064C1E100D4FDFF0099FDFE0099FDFE0099FDFE004571FA000335FB000335 - FB005DB2FC00295AF7000335FB005DB2FC0099FDFE0070D2FD00C2FDFF004BBD - E000DFEFF9000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000C3C2C200826A5B00F1E3 - E200C4C4C400826A5B00A4968E00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000B4817600F6EF - E700FECC9A00FECC9A00FECC9A00FECC9A00DCA88700EFE4D800F9F6F500FEDD - BB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDD - BB00F6EFE700FEDDBB00A478740000000000000000000000000041B3DA00ADFB - FE008DF3FE008DF3FE008DF3FE008DF3FE00DCA88700F5EADF00FFFEFE00FFFF - FF00FFFCFB00FEFAF700FFF8EE00FEF4E900FEF4E900FEF0E200FEEBD700FEE4 - CA00FED0B700A4787400000000000000000000000000059ACD009AE3FF0061C6 - FE0037B4E000F0FEFE0099FDFE00ADFBFE00399CFE000335FB000335FB005DB2 - FC0099FDFE004BAFFF000335FB004571FA0099FDFE0061C6FE00C2FDFF00ADFB - FE0064C1E1000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000ECEAEA00826A5B00CABCB700B1A0 - 9700826A5B00B9AAA600826A5B00DED7D3000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000B4817600F6EF - E700F6EFE700F6EFE700F6EFE700F6EFE700DCA88700EFE4D800F9F6F500FECC - 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC - 9A00F6EFE700FEDDBB00A478740000000000000000000000000041B3DA00C2FD - FF008DF3FE0099FDFE008DF3FE0099FDFE00E3B18E00F5EADF00FFFFFF00FEFE - FE00FFFFFF00FFFCFF00FEF9F300FEF9F300FFF8EE00FEF0E200F3E3D100F3B9 - B500FCA3A200B48176000000000000000000000000001DA6D5009AE3FF0070D2 - FD004BBDE0009EDEEE00F0FEFE00D4FDFF0090D1F100295AF7005DB2FC00C2FD - FF00ADFBFE009AE3FF000335FB000335FB00ADFBFE0061C6FE00D4FDFF00D4FD - FF004BBDE000F0FEFE0000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000A4968E00B9AAA600B9B9B900826A - 5B00927D7000B9AAA600C8ABAB00927D70000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000BA8E8500F8F3 - EC00FEDDBB00FEDDBB00FEDDBB00FEDDBB00DCA88700F5EADF00FFFFFF00FFFF - FE00FFFFFF00FDFAFA00FEFAF700FFF8EE00FEF4E900FEF4E900FEF0E200FEF0 - E200F6EFE700FEDDBB00A478740000000000000000000000000041B3DA00C2FD - FF0099FDFE0099FDFE0099FDFE0099FDFE00E3B18E00FEF0E200FFFEFF00FFFE - FF00FFFFFE00FFFFFF00FFFCFB00FEFAF700FFF8EE00FFF8EE00B4817600B481 - 7600B4817600B48176000000000000000000000000001DA6D5009AE3FF007BDD - FE007BDDFE004BBDE0004BBDE0004BBDE0004BBDE000ACDBF400D1EFF900F0FE - FE00C2FDFF00C2FDFF00295AF7000335FB005DB2FC0061C6FE00E4FDFE00E4FD - FE00BEE6F5007ECBE60000000000000000000000000000000000000000000000 - 0000000000000000000000000000ECEAEA00826A5B00CCCACA00A4968E00C6B8 - AB00DED7D300927D7000C0C0C000927D7000DED7D30000000000000000000000 - 0000000000000000000000000000000000000000000000000000BA8E8500F8F3 - EC00FECC9A00FECC9A00FECC9A00FECC9A00E3B18E00F5EADF00FFFEFF00FFFE - FF00FFFFFE00FFFEFF00FEFAF700FEF9F300FFF8EE00FEF4E900FEF4E900FEE4 - CA00F3B9B500FCA3A200B481760000000000000000000000000041B3DA00D4FD - FF0099FDFE0099FDFE0099FDFE0099FDFE00EDBD9200FEF0E200FFFFFE00FFFE - FF00FFFFFF00FFFFFE00FFFFFF00FCFEFE00FEFAF700FFF8EE00B4817600FCC4 - 7C00DCA88700E2BDB3000000000000000000000000001DA6D5009AE3FF0084E9 - FE0084E9FE0084E9FE0084E9FE0084E9FE007BDDFE0060D4F00037B4E00064C1 - E100F8FBFB00E4FDFE0098A9EF000335FB00295AF70070D2FD00F0FEFE00F0FE - FE00F0FEFE004BBDE00000000000000000000000000000000000000000000000 - 0000000000000000000000000000B9AAA600B9AAA600C7C7C700927D70000000 - 000000000000A18C8200B1A09700B9AAA600B1A0970000000000000000000000 - 0000000000000000000000000000000000000000000000000000CB9A8200F9F6 - F500FEF9F300FEF9F300FEF4E900FEF4E900E3B18E00F5EADF00FFFFFF00FCFE - FE00FFFFFF00FFFEFF00FEFFFC00FFFCFB00FEF9F300FFF8EE00FFF8EE00B481 - 7600B4817600B4817600B481760000000000000000000000000041B3DA00D4FD - FF0099FDFE00ADFBFE0099FDFE00ADFBFE00EDBD9200FEF4E900FFFFFE00FEFE - FE00FBFBFC00FBFBFC00FAFAFA00FAFAFA00F9F6F500F8F3EC00B4817600E3B1 - 8E00D8C5B500000000000000000000000000000000001DA6D500ADFBFE008DF3 - FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE0060D4 - F0004BBDE0009EDEEE00ACDBF4000335FB000335FB00ACDBF400FFFFFE00FFFE - FF00FFFCFB00BEE6F5004BBDE000000000000000000000000000000000000000 - 0000000000000000000000000000927D7000F3F3F300927D7000DED7D3000000 - 000000000000ECEAEA00927D7000E1E0E000826A5B0000000000000000000000 - 0000000000000000000000000000000000000000000000000000CB9A8200FAFA - FA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00EDBD9200FEF0E200FFFEFF00FFFF - FF00FFFFFE00FCFEFE00FFFFFF00FEFEFE00FFFDF800FEF9F300FEFAF700B481 - 7600FCC47C00CB9A8200E2BDB30000000000000000000000000041B3DA00D4FD - FF00ADFBFE00ADFBFE00ADFBFE00ADFBFE00EDBD9200DCA88700DCA88700DCA8 - 8700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700B4817600E5CD - BE0000000000000000000000000000000000000000001DA6D500ADFBFE0099FD - FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD - FE0099FDFE0071EBF90060D4F0004571FA000335FB00295AF7004BBDE0004BBD - E0004BBDE0004BBDE0004BBDE000000000000000000000000000000000000000 - 00000000000000000000E1E0E000A18C8200C6B8AB00B1A09700000000000000 - 00000000000000000000C6B8AB00B1A09700B9AAA600C3C2C200000000000000 - 0000000000000000000000000000000000000000000000000000DCA88700FBFB - FC00FECC9A00FECC9A00FECC9A00FECC9A00EDBD9200FEF0E200FCFEFB00FCFE - FB00F8FBFB00F9F6F500F9F6F500F3F3F300F3F3F300EFEFEF00EFEFEF00B481 - 7600E3B18E00D8C5B5000000000000000000000000000000000041B3DA00E4FD - FE00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FD - FF00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FDFF0090D1F100059A - CD0000000000000000000000000000000000000000001DA6D500ADFBFE0099FD - FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD - FE0099FDFE0099FDFE0099FDFE0070D2FD000335FB000335FB00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000B1A09700B1A09700826A5B0000000000000000000000 - 0000000000000000000000000000927D7000B1A09700A18C8200000000000000 - 0000000000000000000000000000000000000000000000000000DCA88700FBFB - FC00FFFEFF00FFFFFF00FFFDF800FEF9F300EDBD9200DCA88700DCA88700DCA8 - 8700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700B481 - 7600E5CDBE00000000000000000000000000000000000000000041B3DA00E4FD - FE00D4FDFF00C2FDFF009EDEEE009EDEEE009EDEEE009AE3FF009EDEEE009AE3 - FF009EDEEE009AE3FF009EDEEE009EDEEE00D4FDFF00D4FDFF0090D1F100059A - CD0000000000000000000000000000000000000000001DA6D500E4FDFE0099FD - FE0099FDFE0099FDFE0099FDFE0099FDFE00F0FEFE00BEE6F500BEE6F500E4FD - FE00D4FDFF00C2FDFF00ADFBFE00ADFBFE00295AF7000335FB0098A9EF00F0F6 - FD00000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000927D7000826A5B00DED2CA0000000000000000000000 - 0000000000000000000000000000E1E0E000826A5B00826A5B00000000000000 - 0000000000000000000000000000000000000000000000000000E3B18E00FBFB - FC00FFFFFF00FFFFFE00FEFEFE00FFFDF800FEFAF700FFF8EE00FEF4E900FEF0 - E200FEEBD700D6A89400D6A89400B48176000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000041B3DA00F0FE - FE00D4FDFF009BC3D800A18C8200A18C8200A18C8200A18C8200A18C8200A18C - 8200A18C8200A18C8200A18C8200A18C820090D1F100D4FDFF0090D1F100059A - CD0000000000000000000000000000000000000000002EACD80090D1F100D4FD - FF00D4FDFF00C2FDFF00ADFBFE00E4FDFE0064C1E1001DA6D5001DA6D5001DA6 - D5001DA6D5001DA6D5001DA6D5001DA6D5001DA6D5000335FB004571FA000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000FAF3F200826A5B00927D70000000000000000000000000000000 - 000000000000000000000000000000000000B1A097006F5B4D00DED7D3000000 - 0000000000000000000000000000000000000000000000000000E3B18E00FFFE - FE00FFFFFE00FFFFFF00FFFFFF00FFFFFF00FFFCFB00FEFAF700FFF8EE00FFF8 - EE00B4817600B4817600B4817600B48176000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000041B3DA00F0FE - FE00E4FDFE00B1A09700DED7D300DED7D300DED7D300DED7D300DED7D300DED7 - D300DED7D300DED7D300DED7D3008C8988004BBDE000E4FDFE0090D1F100059A - CD000000000000000000000000000000000000000000000000001DA6D5007ECB - E6007ECBE6009EDEEE00BEE6F500ACDBF4001DA6D50000000000000000000000 - 00000000000000000000000000000000000000000000CED7FA00DFEFF9000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000DED7D3006F5B4D00ECEAEA000000000000000000000000000000 - 00000000000000000000000000000000000000000000826A5B00CABCB7000000 - 0000000000000000000000000000000000000000000000000000EDBD9200FFFE - FE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFEFE00FFFDF800FEFAF700FFF8 - EE00B4817600FCC47C00DCA88700E2BDB3000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000007ECBE6002EAC - D80099FDFE009BC3D800A4968E00C6B8AB00FFFFFF00FFFFFF00FCFEFE00FFFE - FF00FFFFFE00DED7D300A4968E008791850041B3DA007ECBE600059ACD00DFEF - F900000000000000000000000000000000000000000000000000000000001DA6 - D5001DA6D5001DA6D5001DA6D5001DA6D5000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000ECEAEA00DBC9C600000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000DED7D300DED7D3000000 - 0000000000000000000000000000000000000000000000000000EDBD9200FCFE - FE00FFFCFF00FEFEFE00FCFEFB00FAFAFA00F8F8F800F8F8F800F9F6F500F8F3 - EC00B4817600E3B18E00D8C5B500000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000000000000090D1 - F10041B3DA0041B3DA0041B3DA00A18C8200CABCB700CABCB700CABCB700CABC - B700CABCB700B9AAA60066A6C30041B3DA0041B3DA004BBDE000BEE6F5000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000EDBD9200DCA8 - 8700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 - 8700B4817600E5CDBE0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000A18C8200A18C8200A18C8200A18C8200A18C - 8200A18C8200A18C8200DBC9C600000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000CED7FA00295AF70098A9EF00000000000000000000000000000000000000 - 000000000000000000000000000000000000EADBD400D3936400000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000FAF3F200A23F0800DAB4A00000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 - 74008C5D5C000000000000000000000000000000000000000000D0E3EC00D1CD - E400ECEAEA000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000CED7 - FA000732DE000732DE000732DE00000000000000000000000000000000000000 - 0000000000000000000000000000EADBD400A23F0800A23F0800D39364000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000AB562900BD580100A23F0800DAB4A000000000000000 - 000000000000000000000000000000000000000000000000000000000000A478 - 7400ECDACC00FED6C900FED6C900FED6C900FED6C900FED6C900FED6C900FED6 - C900FED0B700FECFC200FECFC200FED0B700FED0B700FED0B700FED0B700FED0 - B7008C5D5C0000000000000000000000000000000000F0F6FD000732DE000732 - DE000732DE00C7DDE10000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000D1CDE4000732 - DE000732DE000732DE00CED7FA00000000000000000000000000000000000000 - 00000000000000000000EADBD400AF4B0200CC670100CC670100A23F0800DAB4 - A000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000BD795800BD580100CC670100CC670100A23F0800DAB4A0000000 - 000000000000000000000000000000000000000000000000000000000000A478 - 7400F3E3D100FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDD - BB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00FECC9A00FED0 - B7008C5D5C0000000000000000000000000000000000D1CDE4000732DE000732 - DE000732DE000732DE00CED7FA00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000098A9EF000732DE000732 - DE000732DE00CED7FA0000000000000000000000000000000000000000000000 - 000000000000EADBD400A23F0800BD580100CC670100CC670100AF4B0200D6A8 - 9400000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000DAB4A000A23F0800CC670100CC670100CC670100A23F0800E5CD - BE0000000000000000000000000000000000000000000000000000000000A478 - 7400EFE4D800FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDD - BB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00FED0 - B7008C5D5C0000000000000000000000000000000000F0F6FD000732DE000732 - DE000732DE000732DE000732DE00BEC6DC000000000000000000000000000000 - 00000000000000000000000000000000000098A9EF000732DE000732DE000732 - DE00CED7FA000000000000000000000000000000000000000000000000000000 - 0000F8F0F000AB562900BD580100CC670100CC670100AF4B0200DAB4A0000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000DAB4A000A23F0800CC670100CC670100CC670100A23F - 0800FAF3F200000000000000000000000000000000000000000000000000A478 - 7400F1E3E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FED6C900FEDD - BB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED0 - B7008C5D5C000000000000000000000000000000000000000000F3F3F300295A - F7000732DE000732DE000732DE000732DE0098A9EF0000000000000000000000 - 00000000000000000000000000006682F1000732DE000732DE000732DE00CED7 - FA00000000000000000000000000000000000000000000000000000000000000 - 0000D3936400AF4B0200CC670100CC670100AF4B0200BD795800000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000DAB4A000A23F0800CC670100CC670100BD58 - 0100B3664100000000000000000000000000000000000000000000000000B481 - 7600F5EADF00FEF0E200FEEBD700FEEBD700FEE4CA00F3E3D100CCC0CC0098A9 - EF00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FECF - C2008C5D5C000000000000000000000000000000000000000000000000000000 - 00006682F1000732DE000732DE000732DE000732DE0098A9EF00000000000000 - 000000000000000000006682F1000732DE000732DE000732DE00CED7FA000000 - 000000000000000000000000000000000000000000000000000000000000E5CD - BE00A23F0800CC670100CC670100AF4B0200BD79580000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000CB9A8200AF4B0200CC670100CC67 - 0100A23F0800E2BDB3000000000000000000000000000000000000000000B481 - 7600F5EADF00FEF0E200FEF0E200FEEBD700EFE4D8006682F1000335FB000335 - FB00CFC4D600FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED0 - B7008C5D5C000000000000000000000000000000000000000000000000000000 - 00000000000098A9EF000732DE000732DE000732DE000732DE0098A9EF000000 - 0000F3F3F300295AF7000732DE000732DE000732DE00CED7FA00000000000000 - 000000000000000000000000000000000000000000000000000000000000B366 - 4100BD580100CC670100BD580100AB562900F8F0F00000000000ECDACC00A23F - 0800AF4B0200AF4B0200AF4B0200AF4B0200AF4B0200AF4B0200AF4B0200AF4B - 0200AF4B0200AF4B0200B3664100000000000000000000000000B3664100BD58 - 0100BD580100BD580100BD580100BD580100BD580100BD580100BD580100BD58 - 0100BD580100A23F0800E2BDB3000000000000000000B3664100BD580100CC67 - 0100CC670100AB5629000000000000000000000000000000000000000000B481 - 7600F6EFE700FEF4E900FEF0E20098A9EF000335FB000335FB000335FB000335 - FB00295AF700FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED0 - B700986B66000000000000000000000000000000000000000000000000000000 - 00000000000000000000CED7FA00295AF7000732DE000732DE000732DE0098A9 - EF00295AF7000732DE000732DE000732DE00CED7FA0000000000000000000000 - 0000000000000000000000000000000000000000000000000000E5CDBE00AF4B - 0200CC670100CC670100A23F0800E5CDBE000000000000000000CB9A8200BD58 - 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 - 0100CC670100CC670100B3664100000000000000000000000000B3664100CC67 - 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 - 0100CC670100BD580100CB9A82000000000000000000F5EADF00A23F0800CC67 - 0100CC670100AF4B0200DAB4A00000000000000000000000000000000000B481 - 7600F8F3EC00FEF4E90098A9EF000335FB000335FB000335FB0098A9EF000335 - FB000335FB00A9ACD400FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FECF - C200986B66000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000F0F6FD004571FA000732DE000335FB000732 - DE000732DE000732DE000732DE00CED7FA000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000BD795800CC67 - 0100E27E0300BD580100BD795800000000000000000000000000D6A89400AF4B - 0200BD580100BD580100BD580100BD580100BD580100CC670100CC670100CC67 - 0100CC670100CC670100B3664100000000000000000000000000B3664100E27E - 0300E27E0300CC670100CC670100BD580100AF4B0200AF4B0200AF4B0200AF4B - 0200AF4B0200A23F0800ECDACC00000000000000000000000000B4817600BD58 - 0100CC670100BD580100BD79580000000000000000000000000000000000BA8E - 8500F8F3EC00FFF8EE00ECEAEA000335FB006682F100F1E3E200FEEBD7006682 - F1000335FB000335FB00FED6C900FEE4CA00FEDDBB00FEDDBB00FEDDBB00FED6 - C900986B66000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000006682F1000732DE000732 - DE000335FB000732DE00CED7FA00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000AF4B0200E27E - 0300E27E0300AF4B0200F5EADF0000000000000000000000000000000000D6A8 - 9400CB9A8200CB9A8200CB9A8200D3936400A23F0800BD580100CC670100CC67 - 0100CC670100CC670100B3664100000000000000000000000000B3664100E27E - 0300E27E0300E27E0300CC670100CC670100A23F0800D6A89400E5CDBE00E5CD - BE00E5CDBE00F1E3E20000000000000000000000000000000000F5EADF00AF4B - 0200CC670100CC670100A23F080000000000000000000000000000000000BA8E - 8500FAF3F200FEF9F300FFF8EE00FEF4E900FEF4E900FEF0E200FEF0E200EFE4 - D8000335FB000335FB006682F100FEE4CA00FEE4CA00FEE4CA00FEDDBB00FED6 - C900986B66000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000BEC6DC000732DE000335FB000732 - DE000732DE000335FB006682F100000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000ECDACC00BD580100FB9B - 0F00E27E0300AB56290000000000000000000000000000000000000000000000 - 00000000000000000000F8F0F000AB562900BD580100CC670100CC670100CC67 - 0100CC670100CC670100B3664100000000000000000000000000B3664100E27E - 0300E27E0300E27E0300E27E0300E27E0300CC670100A23F0800EADBD4000000 - 000000000000000000000000000000000000000000000000000000000000AB56 - 2900CC670100CC670100AF4B0200ECDACC00000000000000000000000000CB9A - 8200F9F6F500FFFCFB00FEF9F300FFF8EE00FEF4E900FEF4E900FEF0E200FEF0 - E20098A9EF000335FB000335FB00CFC4D600FEE4CA00FEE4CA00FEE4CA00FED6 - C900986B66000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000098A9EF000732DE000335FB000732DE000335 - FB00295AF7000335FB000732DE006682F1000000000000000000000000000000 - 00000000000000000000000000000000000000000000E5CDBE00CC670100FB9B - 0F00E27E0300BD79580000000000000000000000000000000000000000000000 - 000000000000FAF3F200AB562900BD580100CC670100CC670100BD580100AF4B - 0200CC670100CC670100B3664100000000000000000000000000B3664100FB9B - 0F00E27E0300AF4B0200AF4B0200E27E0300E27E0300CC670100A23F0800EADB - D40000000000000000000000000000000000000000000000000000000000B366 - 4100CC670100CC670100AF4B0200E5CDBE00000000000000000000000000CB9A - 8200FDFAFA00FFFDF800FEFAF700FEF9F300FFF8EE00FEF4E900FEF4E900FEF0 - E200F5EADF004571FA000335FB00295AF700FEEBD700FEE4CA00FEE4CA00FED6 - C900A47874000000000000000000000000000000000000000000000000000000 - 0000000000000000000098A9EF000335FB000335FB000732DE000335FB00CED7 - FA00F0F6FD006682F1000335FB000335FB006682F10000000000000000000000 - 00000000000000000000000000000000000000000000E5CDBE00CC670100FB9B - 0F00FB9B0F00B366410000000000000000000000000000000000000000000000 - 0000FAF3F200AB562900BD580100CC670100CC670100BD580100AB562900AF4B - 0200CC670100CC670100B3664100000000000000000000000000B3664100FB9B - 0F00FB9B0F00AF4B0200DAB4A000AF4B0200E27E0300E27E0300CC670100A23F - 0800E5CDBE00000000000000000000000000000000000000000000000000AB56 - 2900CC670100CC670100AF4B0200F1E3E200000000000000000000000000CB9A - 8200FAFAFA00FFFFFF00FFFCFB00FEFAF700FEF9F300FFF8EE00FEF4E900FEF4 - E900FEF0E200D1CDE4000335FB000335FB00CFC4D600FEE4CA00FEE4CA00FED6 - C900A47874000000000000000000000000000000000000000000000000000000 - 0000000000006682F1000335FB000732DE000335FB000335FB00CED7FA000000 - 0000000000000000000098A9EF000335FB000335FB006682F100000000000000 - 00000000000000000000000000000000000000000000F8F3EC00AF4B0200FCB0 - 4C00FB9B0F00AF4B0200F1E3E20000000000000000000000000000000000E5CD - BE00A23F0800BD580100CC670100CC670100BD580100BD795800E5CDBE00AF4B - 0200CC670100CC670100B3664100000000000000000000000000B3664100FB9B - 0F00FB9B0F00AF4B020000000000DAB4A000BD580100E27E0300E27E0300E27E - 0300A23F0800CB9A820000000000000000000000000000000000DAB4A000AF4B - 0200CC670100CC670100A23F080000000000000000000000000000000000DCA8 - 8700F8FBFB00FFFFFF00FFFFFF00FFFDF800FEFAF700FEF9F300FFF8EE00FEF4 - E900FEF0E200FEF0E20098A9EF00E2D6E200FEEBD700FEEBD700FEE4CA00FECF - C200A47874000000000000000000000000000000000000000000000000000000 - 00006682F1000335FB000335FB000335FB000335FB00CED7FA00000000000000 - 0000000000000000000000000000CED7FA00295AF7000335FB006682F1000000 - 0000000000000000000000000000000000000000000000000000AB562900FB9B - 0F00FCB04C00E27E0300AB562900F1E3E20000000000F5EADF00BD795800AF4B - 0200E27E0300E27E0300CC670100BD580100BD79580000000000E5CDBE00AF4B - 0200CC670100CC670100B3664100000000000000000000000000B3664100FCB0 - 4C00FB9B0F00AF4B02000000000000000000DAB4A000AF4B0200E27E0300E27E - 0300E27E0300BD580100AB562900D6A89400E5CDBE00CB9A8200A23F0800CC67 - 0100CC670100BD580100BD79580000000000000000000000000000000000DCA8 - 8700FBFBFC00FCFEFE00FFFFFE00FFFFFF00FFFCFB00FEFAF700FEF9F300FFF8 - EE00FEF4E900FEF4E900FEF0E200FEF0E200FEEBD700FED6C900FECFC200F3B9 - B500A47874000000000000000000000000000000000000000000F0F6FD00295A - F7000335FB000335FB000335FB000335FB00CED7FA0000000000000000000000 - 000000000000000000000000000000000000F0F6FD004571FA000335FB004571 - FA00000000000000000000000000000000000000000000000000DAB4A000C56E - 2600FCB04C00FCB04C00E27E0300BD580100AF4B0200BD580100CC670100E27E - 0300E27E0300E27E0300AF4B0200BD7958000000000000000000E5CDBE00AF4B - 0200CC670100CC670100B3664100000000000000000000000000B3664100FCB0 - 4C00FCB04C00AF4B0200000000000000000000000000DAB4A000AF4B0200E27E - 0300E27E0300E27E0300E27E0300BD580100BD580100BD580100CC670100CC67 - 0100CC670100A23F0800F5EADF0000000000000000000000000000000000DCA8 - 8700FCFEFE00FFFEFF00FFFEFF00FFFFFF00FFFEFE00FFFCFB00FEF9F300FFF8 - EE00FFF8EE00FEF4E900FEF4E900FEF0E200FED6C900F3B9B500FCA3A200FCA3 - A200B481760000000000000000000000000000000000F0F6FD00295AF7000335 - FB000335FB000335FB000335FB00CED7FA000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000098A9EF000335 - FB00CED7FA00000000000000000000000000000000000000000000000000B366 - 4100D3936400FCB04C00FCB04C00FCB04C00FB9B0F00FB9B0F00FB9B0F00FB9B - 0F00E27E0300A23F0800D6A89400000000000000000000000000E5CDBE00AF4B - 0200CC670100CC670100B3664100000000000000000000000000B3664100FCB0 - 4C00FCC47C00AF4B020000000000000000000000000000000000ECDACC00AB56 - 2900CC670100E27E0300E27E0300E27E0300E27E0300E27E0300CC670100CC67 - 0100A23F0800DAB4A0000000000000000000000000000000000000000000E3B1 - 8E00FCFEFB00FFFFFE00FFFEFF00FEFEFE00FFFFFE00FEFEFE00FFFDF800FEFA - F700FFF8EE00FFF8EE00FEF4E900B4817600B4817600B4817600B4817600B481 - 7600B4817600000000000000000000000000000000006682F1000335FB000335 - FB000335FB000335FB00CED7FA00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000F8F3 - EC00BD795800C56E2600FCB04C00FCB04C00FCB04C00FB9B0F00E27E0300BD58 - 0100AB562900ECDACC000000000000000000000000000000000000000000AB56 - 2900AF4B0200AF4B0200E2BDB300000000000000000000000000E5CDBE00AB56 - 2900AF4B0200CB9A82000000000000000000000000000000000000000000FAF3 - F200CB9A8200AF4B0200CC670100CC670100E27E0300CC670100BD580100A23F - 0800DAB4A000000000000000000000000000000000000000000000000000E3B1 - 8E00FFFEFE00FFFFFE00FFFFFF00FFFEFF00FEFEFE00FFFEFF00FFFEFF00FDFA - FA00FEFAF700FFF8EE00FFF8EE00B4817600E3B18E00FCB04C00FB9B0F00D393 - 6400CB9A8200000000000000000000000000000000006682F1000335FB000335 - FB000335FB00CED7FA0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000DAB4A000BD795800AF4B0200AB562900A23F0800BD795800E2BD - B30000000000000000000000000000000000000000000000000000000000F8F0 - F000DAB4A000ECDACC0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000F8F3EC00DAB4A000D3936400B3664100BD795800DAB4A000F8F3 - EC0000000000000000000000000000000000000000000000000000000000EDBD - 9200FFFCFF00FFFFFF00FFFFFF00FFFEFF00FFFFFE00FFFFFF00FFFFFF00FFFF - FE00FEFAF700FEFAF700FFF8EE00B4817600EAC8A100FCC47C00CB9A8200DCA8 - 8700F6EFE70000000000000000000000000000000000CED7FA004571FA004571 - FA00CED7FA000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200FFFFFE00FFFEFF00FFFFFF00FEFEFE00FFFFFF00FEFEFE00FFFFFF00FFFF - FE00FEFEFE00FEFAF700FEFAF700B4817600EAC8A100E3B18E00DCA88700F6EF - E700000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200FEF0E200FEF0E200F5EADF00F5EADF00EFE4D800EFE4D800EADBD400EADB - D400ECDACC00E4D1CD00DED2CA00B4817600DCA88700D6A89400F6EFE7000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000000000000000EDBD - 9200DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 - 8700DCA88700DCA88700DCA88700B4817600DCA88700F6EFE700000000000000 - 000000000000000000000000000000000000424D3E000000000000003E000000 - 2800000060000000A80000000100010000000000E00700000000000000000000 - 000000000000000000000000FFFFFF00FF003FFFFFFFFFFFFF000000FC000FE0 - 0007E00007000000F00003E00007C00007000000E00000E00007C00007000000 - C00000E00007C00007000000800001E00007E00007000000800001E00007E000 - 07000000800001E00007E00007000000800001E00007E00007000000800001E0 - 0007E00007000000800001E00007E00007000000C00003E00007E00007000000 - E00003E00007E00007000000F80007E00007E00007000000F8001FE00007E000 - 07000000FC007FE00007E00007000000FC00FFE00007E00007000000F800FFE0 - 0007E00007000000F800FFE00007E00007000000F801FFE00007E00007000000 - F001FFE0000FE0000F000000F001FFE0001FE0001F000000E003FFE0003FE000 - 3F000000E003FFE0007FE0007F000000FFFFFFFFFFFFFFFFFFFFFFFFE7FFFFFF - FFFFC3FFFFC00003E07FFFF81FFFC03FFF800003E007FFF800FFC003FF800003 - 80007FF8000FC0007F80000380000F80000FC0007F800003800007800007C000 - 3F800003800007800007C0003F800003800007800003C0001F80000380000380 - 0003C0001F800003800003800001C0000F800003800001800001C0000F800003 - 800001800001C00007800003800000800001C0000780000380000080001FC000 - 0780000380000080001FC0000380000380001F80001FC0780180000380001F80 - 00FFE0FF0F800003E0001F8000FFFFFE0F800003E0007F8000FFFFFE0F800003 - FC00FF80FFFFFFF81F800003FC01FFC0FFFFFF803F800003FFFFFFFFFFFFFFC0 - FF800003FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF807FC0 - FFFFF0FFFFC3FEFFFE001FC00FFFF007FFC03E7FFC000FC000FFF0007FC0001F - F80007C0000FF0001FC0000FF00003C00003F0001FC00007E00001C00003F000 - 0FC00003C00001C00003F0000FC00001C00000C00003F00007C00001800000C0 - 0003F00007C00003000000C00003F00007C00003000000C00003F00003C00003 - C00000C00003F00003C00001C00000C00003F00003C00001E00000C00003F000 - 3FC00001E00001C00003F0003FC00001E00001C00003F0003FC0001FF00001E0 - 0003FF8003C0001FF00003F00003FF8007C0001FF80007FC0003FFC00FE000FF - FC000FFE000FFFE03FF801FFFF003FFF001FFFE07FF803FFFFC0FFFF807FFFF1 - FFFFFFFFFFFFFFFFC0FFFFFFFFFFFFFFFFFFFFFFFFFF8FFFFFFBFFCFE00003FE - 03FF07FFFFF0FF0FE00003FC003F03FFFFF07E07E00003F0000301FFFFF03C0F - E00003E0000180FFFFF0180FE00003C00001C07FFFF8000FE00003800001E03F - FFF8001FE00003800001F0301FF8001FE00003800001F8000FFC001FE0000380 - 0001FC0007FC003FE00003800001FE0003F8000FE00003800001FF0001E00007 - E00003800000FF0001800001E00003800000FE0000000000E00003000001FE00 - 00000000E00003000003FE0000000000E00003800007FE00000380E0E00003C0 - 000FFE0000FF81FFE00003E0001FFF0001FF81FFE00003F0003FFF0003FF81FF - E00003FC003FFF8003FFC1FFE00007FC003FFFC007FFC3FFE0000FFE1C3FFFE0 - 1FFFC3FFE0001FFFFC3FFFFFFFFFE3FFFFFFFFFF81FFFF81FFFFFFFFFFFFFFFC - 007FFE003FE00003000001F8001FF8001FE00003000001E0000FF0000FE00003 - 000001E00007E00007E00003000001C00003C00003E00003000001800003C000 - 01E00003000001800001800001E00003000001800001800001E0000300000100 - 0001800000E00003000001000001800000E00003000001000001800000E00003 - 000001000001800000E00003000001000001800000E000030000010000018000 - 01E00003000001800001800001E00003000001800001800001E00003000001C0 - 0003C00003E00003000001C00007E00003E00003000001E00007E00007E00003 - 000001F0000FF0000FE00003FFFFFFF8003FFC001FE00007FFFFFFFE007FFE00 - 7FE0000FFFFFFFFFFFFFFFFFFFE0001FF87E1FFFFFFFFF0003FFFFFFF03C0FFF - 0001FF0003FFFFFFF0180FFF0001E000038FFFFFF0188FFF0001C00003807FFF - F1198FFF0001C000038007FFF1198FFF0001C0000380007FF0080FC00001C000 - 0380001FF8001FC00001C0000380001FFC001FC00001C0000380000FFF81FFC0 - 0001C0000380000FFF81FFC00001C00003800007FF81FFC00001C00003800007 - FF00FFC00001C00003800003FF00FFC00001C00003800003FE007FC00001C000 - 03800003FE187FC00001C00007800001FE187FC00001C0000F800001FC3C3FC0 - 0003C0000F80003FFC7E3FC00007C0000F80000FFC7E3FC000FFC0000F80001F - F8FF1FC000FFC0000FC07F9FF8FF9FC000FFC0000FE0FFFFF9FF9FC001FFE000 - 1FFFFFFFFFFFFFC003FFFE01FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF1FF - 3FFFFFFC7FE00007C7FFE1FE1FFFFFFC3FE0000783FFC1FC0FFFFFF81FE00007 - 81FF83F80FFFFFF80FE0000780FF07F01FFFFFFC07E00007C07E0FF03FFFFFFE - 07E00007F03C1FE07FFFFFFF03E00007F8103FE04001C00183E00007FC007FC0 - C001C00181E00007FE00FFC1C001C001C1E00007FF81FFC1E001C003C1E00007 - FF01FF83FC01C01FE0E00007FE00FF83F801C00FE0E00007FC007F83F001C007 - E0E00007F81C3F81E001C203C1E00007F03E1FC08041C30001E00007C07F0FC0 - 00C1C38001E0000780FFC7E001C1C3C003E0000781FFFFE003E1C3E007E00007 - 83FFFFF80FE3FFF80FE0000787FFFFFFFFFFFFFFFFE0000FFFFFFFFFFFFFFFFF - FFE0001FFFFFFFFFFFFFFFFFFFE0003F00000000000000000000000000000000 - 000000000000} - end -end +object FormModelView: TFormModelView + Left = 0 + Top = 0 + Caption = 'Charity Events' + ClientHeight = 532 + ClientWidth = 872 + Color = clBtnFace + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Segoe UI' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + ShowHint = True + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 520 + Top = 456 + Width = 313 + Height = 57 + AutoSize = False + Caption = + 'Click on a column header to sort. See design notes at the top of' + + ' source files.' + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Segoe UI' + Font.Style = [] + ParentFont = False + WordWrap = True + end + object btDisplayStars: TButton + Left = 48 + Top = 480 + Width = 201 + Height = 25 + Hint = 'Removes all items that do not have a star' + Caption = 'Display Star Events Only' + TabOrder = 0 + OnClick = btDisplayStarsClick + end + object btDisplayAll: TButton + Left = 288 + Top = 480 + Width = 201 + Height = 25 + Caption = 'Display All' + TabOrder = 1 + OnClick = btDisplayAllClick + end + object VST: TVirtualStringTree + Left = 0 + Top = 0 + Width = 872 + Height = 441 + Align = alTop + DefaultNodeHeight = 21 + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Segoe UI' + Font.Style = [] + Header.AutoSizeIndex = 0 + Header.Height = 21 + Header.MainColumn = -1 + Header.Options = [hoColumnResize, hoDrag, hoShowHint, hoShowSortGlyphs] + HintMode = hmTooltip + Images = ImageList1 + ParentFont = False + TabOrder = 2 + Columns = <> + end + object ImageList1: TImageList + Height = 24 + Width = 24 + Left = 16 + Top = 376 + Bitmap = { + 494C01011B003000480018001800FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 000000000000360000002800000060000000A8000000010020000000000000FC + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000C4C4C4009996970099969700D1D1 + D100F9F6F500FBFBFC00DBC9C600B5B3B300CFCFCF00DAD9D900000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000CCCACA00B9B9B900DAD9D900DFDFDF00AFAFAF00B5B3 + B30099969700BA8E8500A18C8200AFAFAF00DAD9D900C7C7C700BFBFBF00D1D1 + D10000000000000000000000000000000000000000000000000000000000A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 74008C5D5C00000000000000000000000000000000000000000000000000A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 74008C5D5C000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000ECEAEA00B9B9B900CFCFCF00EFEFEF00EFEFEF00DAD9D900AFAFAF00B5B3 + B3008F8F8F004F4C4C0060606000606060008C89880099969700D1D1D100D1D1 + D100B9B9B900CCCACA000000000000000000000000000000000000000000A478 + 7400FED6C900FED6C900FED6C900FED6C900FED6C900FED6C900FED6C900FED6 + C900FECFC200FECFC200FECFC200FED0B700FED0B700FED0B700FED0B700FED0 + B7008C5D5C000000000000000000000000000000000000000000B5B3B300897D + 8B00CC9A9900CABCB700FEE4CA00FEE4CA00FEE4CA00FED6C900FEE4CA00FED6 + C900FEDDBB00FEDDBB00FEDDBB00FED0B700FED0B700FED0B700FED0B700FED0 + B7008C5D5C000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000BFBF + BF00C0C0C000ECEAEA00F3F3F300EFEFEF00ECEAEA00D1D1D100A8A8A800AFAF + AF008F8F8F004F4C4C00434242006060600060606000868585008F8F8F00AFAF + AF00C7C7C700DAD9D900BFBFBF00DAD9D900000000000000000000000000A478 + 7400F3E3D100FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDD + BB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00FECC9A00FED0 + B7008C5D5C000000000000000000000000000000000000000000458EB6005D71 + AB00AB8FA300C8ABAB00FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4 + CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FECC9A00FED0 + B7008C5D5C000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000B9B9B900DFDF + DF00FAFAFA00F9F6F500EFEFEF00ECEAEA00E1E0E000D1D1D100A8A8A800A8A8 + A800AFAFAF00AFAFAF00A8A8A8008C8988007070700060606000868585008F8F + 8F00B5B3B3009F9F9F00CFCFCF00F3F3F300000000000000000000000000A478 + 7400EFE4D800FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDD + BB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00FED0 + B7008C5D5C00000000000000000000000000000000000000000061C6FE003A80 + E0005D71AB00AB8FA300D5B3AF00FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4 + CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED0 + B7008C5D5C000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B9B9B900FEFEFE00FBFB + FC00F9F6F500EFEFEF00ECEAEA00DAD9D900B5B3B3008F8F8F00808080008F8F + 8F00A8A8A800AFAFAF00AFAFAF00B5B3B300B9B9B900AFAFAF009F9F9F006060 + 600051515100CCCACA00E1E0E00000000000000000000000000000000000A478 + 7400F5EADF00FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4 + CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED0 + B7008C5D5C000000000000000000000000000000000000000000000000005DB2 + FC003A80E0005D71AB00AB8FA300D5B3AF00FEEBD700FEEBD700FEE4CA00FEE4 + CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED0 + B7008C5D5C000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000AFAFAF00FBFBFC00F9F6 + F500EFEFEF00DAD9D9009F9F9F009F9F9F00B9B9B900C7C7C7009F9F9F008F8E + 8D0080808000808080008F8F8F009F9F9F00B5B3B300B9B9B900BFBFBF00C3C2 + C200B9B9B900C4C4C400E1E0E00000000000000000000000000000000000B481 + 7600F5EADF00FEF0E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4 + CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED0 + B7008C5D5C000000000000000000000000000000000000000000000000008F8F + 8F005DB2FC003A80E0005D71AB00AB8FA300E2BDB300FEEBD700FEEBD700FEE4 + CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED0 + B7008C5D5C000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000A8A8A800F3F3F300CFCF + CF00999697009F9F9F00D1D1D100DAD9D900D1D1D100D1D1D100CCCACA00BFBF + BF00A8A8A800A8A8A8009F9F9F008F8F8F00868585008C8988009F9F9F00B9B9 + B9008DBC8B008DBC8B00E1E0E00000000000000000000000000000000000B481 + 7600F6EFE700FEF0E200FEF0E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4 + CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED0 + B7008C5D5C00000000000000000000000000000000000000000000000000B481 + 7600CABCB7005DB2FC003A80E0005D71AB00B9AAA600F3E3D100E2BDB300BF98 + 9500CDA6A000C8ABAB00E2BDB300FEDDBB00FEDDBB00FEDDBB00FED7AB00FECF + C2008C5D5C000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000009F9F9F008C8988009996 + 9700DAD9D900DFDFDF00DAD9D900D1D1D100CCCACA00ECEAEA00E6E5E400E6E5 + E400ECEAEA00DAD9D900CCCACA00B9B9B900AFAFAF00AFAFAF00999697008685 + 85008080800099969700DFDFDF0000000000000000000000000000000000B481 + 7600F6EFE700FEF4E900FEF0E200FEF0E200FEEBD700FEEBD700FEEBD700FEE4 + CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FECF + C2008C5D5C00000000000000000000000000000000000000000000000000B481 + 7600F8F3EC00FEF4E9005DB2FC0085AFCB008F8F8F00BF989500DAB4A000FDE8 + B700FEFED300FDF6C600D8C5B500CC9A9900E5CDBE00FEDDBB00FEDDBB00FED0 + B7008C5D5C000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000008F8F8F00ECEAEA00E1E0 + E000DFDFDF00DAD9D900D1D1D100CFCFCF00E1E0E000DAD9D900B5B3B300B9B9 + B900B9B9B900BFBFBF00CFCFCF00E6E5E400E6E5E400D1D1D100C7C7C700BFBF + BF00B9B9B900A8A8A800DAD9D90000000000000000000000000000000000BA8E + 8500F6EFE700FEF4E900FEF4E900FEF0E200FEF0E200FEEBD700FEEBD700FEEB + D700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FECF + C200986B6600000000000000000000000000000000000000000000000000B481 + 7600F6EFE700FEF4E900F8F3EC00DED7D300BF989500FED7AB00FDF6C600FEFE + D300FEFFE100FEFFE100FFFDF800F6EFE700BF989500EDD9B700FEDDBB00FECF + C200986B66000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000008C898800E1E0E000DFDF + DF00DAD9D900D1D1D100CFCFCF00DAD9D900E6E5E400C0C0C000EFEFEF00EFEF + EF00ECEAEA00CFCFCF00BFBFBF00B9B9B900B9B9B900BFBFBF00D1D1D100E1E0 + E000DFDFDF00D1D1D100E6E5E40000000000000000000000000000000000BA8E + 8500F8F3EC00FFF8EE00FEF4E900FEF4E900FEF0E200FEF0E200FEEBD700FEEB + D700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FECF + C200986B6600000000000000000000000000000000000000000000000000BA8E + 8500F8F3EC00FFF8EE00FFF8EE00D5B3AF00EAC8A100FDF6C600FDE8B700FEFE + D300FEFFE100FEF9F300FEFFFC00FFFFFF00DED2CA00CDA6A000FEDDBB00FED6 + C900986B66000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000D1D1D100DAD9 + D900D1D1D100CFCFCF00DFDFDF00CFCFCF00C3C2C200F3F3F300F3F3F300EFEF + EF00EFEFEF00EFEFEF00ECEAEA00ECEAEA00DAD9D900C7C7C700B9B9B900B9B9 + B900B9B9B900CCCACA000000000000000000000000000000000000000000BA8E + 8500F8F3EC00FEF9F300FFF8EE00FEF4E900FEF4E900FEF0E200FEF0E200FEEB + D700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FECF + C200986B6600000000000000000000000000000000000000000000000000BA8E + 8500FAF3F200FFF8EE00FEF9F300C8ABAB00FDE8B700FDE8B700FDF6C600FEFE + D300FEFFE100FFFDF800FEFFFC00FFF8EE00FDF6C600BF989500FEDDBB00FED6 + C900986B66000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000E6E5 + E400AFAFAF00BFBFBF00C3C2C200D1D1D100C4C4C400CCCACA00E6E5E400F3F3 + F300EFEFEF00EFEFEF00EFEFEF00ECEAEA00ECEAEA00E6E5E400E6E5E400D1D1 + D100AFAFAF00E6E5E4000000000000000000000000000000000000000000CB9A + 8200F9F6F500FEFAF700FFF8EE00FFF8EE00FEF4E900FEF4E900FEF0E200FEF0 + E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FED6 + C900986B6600000000000000000000000000000000000000000000000000CB9A + 8200F9F6F500FEF9F300FFFDF800CDA6A000FDF6C600FED7AB00FDE8B700FEFE + D300FEFED300FEFFE100FEFFE100FEFFE100FEFED300BF989500FEE4CA00FED6 + C900986B66000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000A8A8A800E6E5E400E6E5E400AFAFAF00B5B3B300B9B9B900B9B9 + B900C3C2C200CCCACA00DAD9D900E6E5E400E6E5E400ECEAEA00CCCACA00B5B3 + B300DFDFDF00000000000000000000000000000000000000000000000000CB9A + 8200F8F8F800FFFDF800FEF9F300FFF8EE00FFF8EE00FEF4E900FEF4E900FEF0 + E200FEF0E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FED6 + C900A4787400000000000000000000000000000000000000000000000000CB9A + 8200F8F8F800FFFCFB00FEFFFC00CDA6A000FDF6C600FDE8B700FDE8B700FEFE + D300FEFED300FEFED300FEFFE100FEFED300FDF6C600BF989500FEE4CA00FED6 + C900A47874000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000A8A8A800FEF9F300FEF0E200ECDACC00D1D1D100C4C4C400C4C4 + C400B9B9B900C0C0C000BFBFBF00B9AAA600B9AAA600B5B3B300DAD9D9000000 + 000000000000000000000000000000000000000000000000000000000000CB9A + 8200FBFBFC00FFFEFE00FFFDF800FEF9F300FFF8EE00FFF8EE00FEF4E900FEF4 + E900FEF0E200FEF0E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FED6 + C900A4787400000000000000000000000000000000000000000000000000CB9A + 8200FCFEFB00FFFEFE00FFFFFF00D5B3AF00EDD9B700FEF0E200FDE8B700FED7 + AB00FDF6C600FDF6C600FDF6C600FDF6C600EDD9B700BF989500FEE4CA00FED6 + C900A47874000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000CB9A8200FED7AB00FED7AB00FED7AB00FEDDBB00FEDD + BB00FEEBD700F3E3D100EFE4D800C8ABAB00DAD9D90000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000DCA8 + 8700F8FBFB00FFFFFF00FFFEFE00FFFCFB00FEFAF700FFF8EE00FFF8EE00FEF4 + E900FEF4E900FEF0E200FEF0E200FEEBD700FEEBD700FEEBD700FEE4CA00FECF + C200A4787400000000000000000000000000000000000000000000000000DCA8 + 8700FBFBFC00FFFEFF00FFFEFF00DED7D300E2BDB300F9F6F500F9FFFE00FDE8 + B700FDE8B700FED7AB00FDE8B700FDE8B700D6A89400D8C5B500FEE4CA00FED0 + B700A47874000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000D6A89400FEDDBB00FED7AB00FEDDBB00FED7AB00FEDD + BB00FED7AB00FEDDBB00F3D1A300BF9895000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000DCA8 + 8700F8FBFB00FFFFFF00FFFFFE00FFFEFF00FEFAF700FEFAF700FEF9F300FFF8 + EE00FEF4E900FEF4E900FEF0E200FEF0E200FEEBD700FED6C900FECFC200F3B9 + B500A4787400000000000000000000000000000000000000000000000000DCA8 + 8700FBFBFC00FFFFFF00FFFFFF00FFFEFF00D5B3AF00D8C5B500EFE4D800F5EA + DF00FDE8B700FDE8B700EDD9B700D6A89400CDA6A000FED6C900FECFC200F3B9 + B500A47874000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000E6E5E400FED0B700FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDD + BB00FEDDBB00FEDDBB00D5B3AF00BF9895000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000DCA8 + 8700FFFDF800FFFFFF00FFFFFE00FFFFFE00FFFEFE00FEFAF700FEFAF700FFF8 + EE00FFF8EE00FEF4E900FEF4E900FEF0E200FED6C900F3B9B500FCA3A200FCA3 + A200B4817600000000000000000000000000000000000000000000000000DCA8 + 8700FCFEFB00FFFFFE00FEFFFC00FFFEFF00FFFFFF00D6BCBB00CDA6A000DAB4 + A000C8ABAB00DAB4A000CDA6A000E2BDB300FED6C900F3B9B500FCA3A200FCA3 + A200B48176000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000D8C5B500FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEE4 + CA00FEE4CA00FEE4CA00BF989500EADBD4000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000E3B1 + 8E00FCFEFE00FFFFFF00FFFEFF00FFFFFF00FFFFFF00FEFFFC00FEFAF700FEFA + F700FFF8EE00FFF8EE00FEF4E900B4817600B4817600B4817600A4787400B481 + 7600B4817600000000000000000000000000000000000000000000000000E3B1 + 8E00FCFEFE00FFFFFF00FCFEFE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00EADB + D400EFE4D800F1E3E200FFF8EE00B4817600B4817600B4817600A4787400B481 + 7600B48176000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000BF989500FEEBD700FEEBD700FEEBD700FEEBD700FEEBD700FEEB + D700FEEBD700ECDACC00BF989500000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000E3B1 + 8E00FCFEFE00FFFEFE00FCFEFE00FFFFFF00FFFFFE00FEFEFE00FFFFFF00FDFA + FA00FEFAF700FFF8EE00FFF8EE00B4817600E3B18E00FCB04C00FB9B0F00D393 + 6400D6A89400000000000000000000000000000000000000000000000000E3B1 + 8E00FCFEFE00FFFFFF00FFFEFF00FFFFFF00FFFFFE00FFFFFF00FFFFFE00FFFE + FF00FFFEFE00FEFAF700FEF9F300B4817600E3B18E00FCB04C00FB9B0F00D393 + 6400D6A894000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000ECEAEA00DBC9C600FEF0E200FEF0E200FEF0E200FEF0E200FEF0E200FEF0 + E200FEF0E200D5B3AF00BF989500000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200FFFEFE00FFFEFF00FEFEFE00FFFFFF00FFFFFE00FFFEFF00FCFEFE00FFFF + FF00FEFAF700FEFAF700FFF8EE00B4817600EAC8A100FCC47C00DCA88700D6A8 + 940000000000000000000000000000000000000000000000000000000000EDBD + 9200FEFEFE00FFFFFF00FFFFFE00FFFFFF00FFFFFF00FFFFFF00FFFEFF00FCFE + FE00FEFAF700FEF9F300FEF9F300B4817600EAC8A100FCC47C00DCA88700D6A8 + 9400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000D6BCBB00FEF4E900FFF8EE00FFF8EE00FFF8EE00FFF8EE00FFF8EE00FFF8 + EE00FEF4E900BF989500E4D1CD00000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200FCFEFE00FFFFFE00FFFFFE00FFFFFF00FFFEFF00FCFEFE00FFFFFF00FFFF + FF00FEFEFE00FEFAF700FEFAF700B4817600EAC8A100E3B18E00D6A894000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200FFFFFF00FFFFFF00FFFFFE00FFFEFE00FFFEFF00FFFFFF00FFFFFE00FFFF + FF00FEFFFC00FFFDF800FEFAF700B4817600EAC8A100E3B18E00D6A894000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000F8F0 + F000DED7D300FEFEFE00FBFBFC00FCFEFB00FCFEFB00FBFBFC00FCFEFB00FCFE + FB00ECEAEA00BF98950000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200FEF0E200FEF0E200F5EADF00F5EADF00EFE4D800EFE4D800EADBD400EADB + D400DED7D300DED2CA00DED2CA00B4817600DCA88700E3B18E00000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200FEF0E200FEF0E200F5EADF00F5EADF00EFE4D800EFE4D800EADBD400EADB + D400EADBD400DED2CA00DED2CA00B4817600DCA88700E3B18E00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000CABC + B700BF989500BF989500BF989500BF989500BF989500BF989500BF989500BF98 + 9500BF989500F8F0F00000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 + 8700DCA88700DCA88700DCA88700B4817600DCA8870000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 + 8700DCA88700DCA88700DCA88700B4817600DCA8870000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000D1EF + F900F0FEFE000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000059ACD00059A + CD00BEE6F500F0F6FD0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000A3453F00A345 + 3F00994C4D00A3453F00994C4D00B5B3B300B5B3B300B5B3B300B5B3B300B5B3 + B300B5B3B300B5B3B300B5B3B300B5B3B300994C4D00994C4D00994C4D00994C + 4D00994C4D00DAD9D900000000000000000000000000000000000000000041B3 + DA0064C1E10037B4E00064C1E1009EDEEE00DFEFF90000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000059ACD00059ACD00059ACD004BBDE00090D1F100D1EFF9000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000059ACD00C7EF + F10037B4E0001DA6D500059ACD007ECBE600ACDBF400E4FDFE00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B4817600994C4D00CB66 + 6600CB666600CB666600994C4D00A8A8A800C4C4C400DAD9D900F8F8F800FAFA + FA00F3F3F300E6E5E400DFDFDF00DAD9D900993434009934340099343400BB57 + 5700CB666600994C4D000000000000000000000000000000000000000000059A + CD00F9FFFE0070D2FD0056C6F0004BBDE0002EACD8002EACD80064C1E1009EDE + EE00D1EFF9000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000059ACD00D1EFF90060D4F0004BBDE0002EACD800059ACD00059A + CD0041B3DA007ECBE600BEE6F500F0FEFE000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000059ACD0090D1 + F1009AE3FF007BDDFE0070D2FD0056C6F00037B4E0001DA6D500059ACD004BBD + E0009EDEEE00DFEFF90000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B4817600CB666600CB66 + 6600CB666600CB666600994C4D00A4968E00B4817600CC9A9900DBC9C600FAFA + FA00F8F8F800EFEFEF00E6E5E400DFDFDF00993434009934340099343400BB57 + 5700CB666600994C4D00000000000000000000000000A4787400A4787400A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A478740037B4 + E00037B4E0002EACD8004BBDE00090D1F100D1EFF90000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000059ACD0090D1F1009AE3FF007BDDFE007BDDFE007BDDFE0070D2 + FD0056C6F00037B4E0001DA6D500059ACD002EACD8007ECBE600ACDBF400DFEF + F900000000000000000000000000000000000000000000000000059ACD004BBD + E000D1EFF9007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE0060D4 + F0004BBDE0002EACD800059ACD001DA6D5009EDEEE0000000000000000000000 + 00000000000000000000000000000000000000000000B4817600CB666600CB66 + 6600CB666600CB666600994C4D00B1A09700BB575700BB575700CC9A9900DFDF + DF00FAFAFA00F8FBFB00EFEFEF00E6E5E400993434009934340099343400BB57 + 5700CB666600994C4D00000000000000000000000000A4787400F3E3D100FEE4 + CA00FED6C900FED6C900FED0B700FED0B700FED0B700FED7AB00A478740084E9 + FE0084E9FE007BDDFE007BDDFE0060D4F0004BBDE0001DA6D50041B3DA00ACDB + F4000000000000000000000000000000000000000000059ACD00059ACD007ECB + E600BEE6F500059ACD004BBDE000D1EFF90084E9FE0084E9FE0084E9FE0084E9 + FE0084E9FE0084E9FE0084E9FE007BDDFE0060D4F0004BBDE0001DA6D50041B3 + DA00000000000000000000000000000000000000000000000000059ACD0037B4 + E000D1EFF90084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0084E9 + FE0084E9FE0084E9FE0084E9FE0060D4F00037B4E00000000000000000000000 + 00000000000000000000000000000000000000000000B4817600CB666600CB66 + 6600CB666600CB666600994C4D00D5B3AF00BB575700BB575700B4817600C4C4 + C400DFDFDF00FEFAF700FBFBFC00EFEFEF00993434009934340099343400BB57 + 5700CB666600994C4D00000000000000000000000000B4817600FEEBD700FEE4 + CA00FEE4CA00FEDDBB00C7D19500448A3E0005710A0005710A000F8319000571 + 0A002A8C430060D4F00084E9FE0084E9FE007BDDFE0084E9FE007BDDFE0041B3 + DA00DFEFF90000000000000000000000000000000000059ACD009EDEEE004BBD + E0001DA6D500059ACD0037B4E000DFEFF90084E9FE0084E9FE0084E9FE0084E9 + FE0084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0070D2FD004BBD + E000D1EFF9000000000000000000000000000000000000000000059ACD0056C6 + F00090D1F100ADFBFE0084E9FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3 + FE008DF3FE008DF3FE008DF3FE007BDDFE007BDDFE00059ACD00000000000000 + 00000000000000000000000000000000000000000000B4817600CB666600CB66 + 6600CB666600CB666600994C4D00DBC9C600A3453F00A3453F00A4787400A8A8 + A800C4C4C400DFDFDF00FAFAFA00FAFAFA00993434009934340099343400BB57 + 5700CB666600994C4D00000000000000000000000000BA8E8500FEEBD700FEEB + D700FEE4CA00FEE4CA00448A3E007DA972007DA97200448A3E000F8319001899 + 2E0025A63D000F83190069CCC0008DF3FE008DF3FE008DF3FE0084E9FE0060D4 + F00064C1E10000000000000000000000000000000000059ACD0064C1E100BEE6 + F5007BDDFE00059ACD004BBDE00090D1F100ADFBFE008DF3FE008DF3FE008DF3 + FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE0070D2FD008DF3 + FE0064C1E10000000000000000000000000000000000000000001DA6D50061C6 + FE0064C1E100C2FDFF0099FDFE0099FDFE008DF3FE0099FDFE008DF3FE0099FD + FE008DF3FE0099FDFE008DF3FE007BDDFE0084E9FE004BBDE000000000000000 + 00000000000000000000000000000000000000000000B4817600CB666600CB66 + 6600CB666600CB666600994C4D00DBC9C60099343400A3453F00B48176009F9F + 9F00A8A8A800C3C2C200DFDFDF00FAFAFA00993434009934340099343400BB57 + 5700CB666600994C4D00000000000000000000000000CB9A8200FEF4E900FEEB + D700FEEBD700FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00B4817600255E + 280025BB4F0030C369000F8319007ECBE6008DF3FE008DF3FE0084E9FE0084E9 + FE0041B3DA0000000000000000000000000000000000059ACD0037B4E000D1EF + F90060D4F000059ACD0070D2FD004BBDE000D4FDFF0099FDFE0099FDFE0099FD + FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0070D2FD008DF3 + FE004BBDE000DFEFF900000000000000000000000000000000001DA6D50070D2 + FD002EACD800E4FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD + FE0099FDFE0099FDFE0099FDFE0084E9FE009AE3FF00ADFBFE00059ACD000000 + 00000000000000000000000000000000000000000000B4817600CB666600CB66 + 6600CB666600CB666600994C4D00DBC9C600E4D1CD00DBC9C600E4D1CD00CCCA + CA00B9B9B900CABCB700C7C7C700DED7D300993434009934340099343400BB57 + 5700CB666600994C4D00000000000000000000000000CB9A8200FEF4E900FEF0 + E200FEF0E200FEEBD700FEE4CA00FEE4CA00FEDDBB00FEDDBB00B481760084E9 + FE000F83190047CE710025BB4F002A8C430099FDFE0099FDFE0084E9FE00ADFB + FE0064C1E10090D1F100000000000000000000000000059ACD0056C6F00090D1 + F1009EDEEE00059ACD0070D2FD0037B4E000E4FDFE0099FDFE0099FDFE0099FD + FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE007BDDFE00BEE6 + F500ADFBFE007ECBE600000000000000000000000000000000001DA6D50070D2 + FD002EACD8009EDEEE00D4FDFF00ADFBFE00ADFBFE00ADFBFE00ADFBFE00ADFB + FE00ADFBFE00ADFBFE00ADFBFE0084E9FE009AE3FF00D4FDFF004BBDE0000000 + 00000000000000000000000000000000000000000000B4817600CB666600CB66 + 6600CB666600CB666600CB666600B4817600B4817600B4817600B4817600CB66 + 6600CB666600986B6600CB666600B4817600BB575700BB575700A3453F00CB66 + 6600CB666600994C4D00000000000000000000000000DCA88700FEF9F300FEF4 + E900FEF0E200FEEBD700FEEBD700FEE4CA00FEE4CA00FEDDBB00B481760084E9 + FE000F83190047CE710058E087000F83190099FDFE0099FDFE008DF3FE00ADFB + FE009AE3FF004BBDE000000000000000000000000000059ACD0061C6FE002EAC + D800BEE6F5001DA6D50070D2FD0056C6F00064C1E100DFEFF900E4FDFE00E4FD + FE00D4FDFF00C2FDFF00ADFBFE00C2FDFF00ADFBFE00ADFBFE0070D2FD00C2FD + FF00D4FDFF004BBDE000F0F6FD000000000000000000000000001DA6D5007BDD + FE007BDDFE0037B4E0004BBDE0007ECBE600ACDBF400D1EFF900E4FDFE00C2FD + FF00C2FDFF00C2FDFF00C2FDFF009AE3FF009AE3FF00E4FDFE00ACDBF400059A + CD000000000000000000000000000000000000000000B4817600CB666600CB66 + 6600CB666600CB666600CB666600CB666600CB666600CB666600CB666600CB66 + 6600CB666600CB666600CB666600CB666600CB666600CB666600CB666600CB66 + 6600CB666600994C4D00000000000000000000000000E3B18E00FFFDF800FFF8 + EE00FEF4E900FEF0E200FEEBD700FEEBD700FEE4CA000F8319000F8319000F83 + 19000F83190058E0870058E087000F8319000F8319000F8319000F831900ADFB + FE00D4FDFF004BBDE000BEE6F5000000000000000000059ACD0070D2FD0037B4 + E0007ECBE6001DA6D5007BDDFE007BDDFE0060D4F0004BBDE0002EACD8002EAC + D8002EACD800D1EFF900E4FDFE00C2FDFF00C2FDFF00D4FDFF007BDDFE00D1EF + F900E4FDFE00BEE6F5009EDEEE000000000000000000000000002EACD80084E9 + FE0084E9FE007BDDFE0084E9FE004BBDE00037B4E00037B4E00041B3DA00F2FA + F500D4FDFF00D4FDFF00D4FDFF009AE3FF009EDEEE000F8319008DBC8B0064C1 + E1000000000000000000000000000000000000000000B4817600CB666600A345 + 3F00BA8E8500BF989500CC9A9900BF989500CC9A9900CC9A9900CC9A9900CC9A + 9900CC9A9900CC9A9900CC9A9900CC9A9900CC9A9900CC9A9900A4787400CB66 + 6600CB666600994C4D00000000000000000000000000EDBD9200FFFFFF00FEFA + F700FEF9F300FEF4E900FEF0E200FEEBD700FEEBD700F0E4C700267D270025A6 + 3D0047CE710058E0870058E0870058E0870025A63D00267D27009EDEEE00C2FD + FF00D4FDFF009EDEEE0041B3DA0000000000000000001DA6D5007BDDFE0061C6 + FE002EACD8001DA6D50084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0084E9 + FE0084E9FE004BBDE000BEE6F500F0FEFE00F0FEFE00F0FEFE009AE3FF00E4FD + FE00F9FFFE00F0FEFE0064C1E1000000000000000000000000002EACD8008DF3 + FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE0071EBF9001DA6 + D50041B3DA004BBDE0004BBDE0004BBDE0002A8C430047CE71000F83190051B4 + 9400F0F6FD0000000000000000000000000000000000B4817600CB666600A345 + 3F00F3F3F300F3F3F300F3F3F300F3F3F300FAF3F200F3F3F300F3F3F300F3F3 + F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 + 5700CB666600994C4D00000000000000000000000000EDBD9200FFFFFF00FFFF + FE00FDFAFA00FEF9F300FEF4E900FEF0E200FEEBD700F3B9B500B48176000571 + 0A0047CE710058E0870058E0870058E087000F831900C7EFF100ADFBFE00D1EF + F900F0FEFE00D4FDFF0041B3DA00F0F6FD00000000001DA6D5007BDDFE0061C6 + FE0037B4E0001DA6D50099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD + FE0099FDFE0099FDFE0060D4F0004BBDE0004BBDE0004BBDE0004BBDE0004BBD + E0004BBDE0004BBDE0004BBDE0000000000000000000000000002EACD80099FD + FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD + FE0099FDFE0071EBF90060D4F000097B450025BB4F0058E0870058E087001899 + 2E00DDEADD0000000000000000000000000000000000B4817600CB666600A345 + 3F00FAF3F200F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 + F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 + 5700CB666600994C4D00000000000000000000000000EDBD9200FFFFFF00FFFE + FF00FEFEFE00FFFDF800FEF9F300FEF4E900B4817600B4817600B4817600B1A0 + 97000F83190058E0870058E08700267D2700F0FEFE00F0FEFE00D1EFF900E4FD + FE00FCFEFE00FCFEFE007ECBE60041B3DA00000000001DA6D5007BDDFE007BDD + FE0037B4E0001DA6D50099FDFE0099FDFE0099FDFE0099FDFE0099FDFE00ADFB + FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE002EACD8000000 + 000000000000000000000000000000000000000000000000000037B4E000ADFB + FE0099FDFE0099FDFE0099FDFE0099FDFE00D4FDFF00C2FDFF00C2FDFF00ADFB + FE0099FDFE0099FDFE0049AA490018992E0058E0870058E0870058E0870058E0 + 8700267D270000000000000000000000000000000000B4817600CB666600A345 + 3F00F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 + F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 + 5700CB666600994C4D00000000000000000000000000EDBD9200FCFEFB00FCFE + FE00FEFFFC00FCFEFE00FEFAF700FFF8EE00B4817600FCC47C00DCA88700FED6 + C9008DBC8B00267D27000F83190041B3DA0041B3DA0041B3DA0041B3DA0041B3 + DA0041B3DA0041B3DA0041B3DA0041B3DA00000000001DA6D5009AE3FF0084E9 + FE007BDDFE001DA6D500C2FDFF0099FDFE0099FDFE0099FDFE00C2FDFF009EDE + EE009EDEEE00ACDBF400C2FDFF00D4FDFF00C2FDFF00ADFBFE002EACD8000000 + 000000000000000000000000000000000000000000000000000037B4E000E4FD + FE00ADFBFE00ADFBFE0099FDFE00D4FDFF007ECBE60037B4E00037B4E00037B4 + E00037B4E0008DBC8B000F83190047CE710058E0870058E0870058E0870058E0 + 870058E0870068A76200000000000000000000000000B4817600CB666600A345 + 3F00F8F0F000F3F3F300CCCACA00C0C0C000C3C2C200C3C2C200C4C4C400C4C4 + C400C4C4C400C7C7C700C7C7C700C7C7C700D1D1D100F3F3F300D6BCBB00BB57 + 5700CB666600994C4D00000000000000000000000000DCA88700FFFEFE00FDFA + FA00F8F8F800F3F3F300F3F3F300ECEAEA00B4817600D6A89400F3E3D100FEF0 + E200FEF0E2007DA972008DBC8B00FECFC200B481760099FDFE0041B3DA000000 + 000000000000000000000000000000000000000000002EACD8008DF3FE008DF3 + FE008DF3FE001DA6D500DFEFF900E4FDFE00D4FDFF00D4FDFF00C7EFF1004BBD + E00060D4F00060D4F00037B4E0002EACD8002EACD8002EACD8002EACD8000000 + 000000000000000000000000000000000000000000000000000037B4E00064C1 + E10090D1F1009EDEEE00BEE6F50090D1F10037B4E00000000000000000000000 + 0000000000008DBC8B007DA97200448A3E0025BB4F0058E0870058E087000F83 + 190068A762007DA97200F3F3F3000000000000000000B4817600CB666600A345 + 3F00F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 + F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 + 5700CB666600994C4D00000000000000000000000000DCA88700DCA88700DCA8 + 8700DCA88700DCA88700DCA88700DCA88700DCA88700F5EADF00FFF8EE00FEF4 + E900FEF0E200FEEBD700FECFC200F3B9B500B481760099FDFE0041B3DA000000 + 000000000000000000000000000000000000000000001DA6D500ADFBFE0099FD + FE0099FDFE008DF3FE0041B3DA0037B4E00037B4E00037B4E00037B4E00099FD + FE0099FDFE0099FDFE0071EBF9002EACD8000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000037B4 + E00037B4E00037B4E00037B4E00037B4E0000000000000000000000000000000 + 00000000000000000000000000000000000025A63D0047CE710058E087000F83 + 19000000000000000000000000000000000000000000B4817600CB666600A345 + 3F00F3F3F300F3F3F300CCCACA00C0C0C000C0C0C000C0C0C000C3C2C200C3C2 + C200C4C4C400C4C4C400C4C4C400C7C7C700D1D1D100F3F3F300D6BCBB00BB57 + 5700CB666600994C4D00000000000000000000000000000000000000000041B3 + DA00D4FDFF00D4FDFF00EDBD9200FEFAF700FEFAF700FDFAFA00FEFAF700FEF9 + F300FEF4E900B4817600B4817600B4817600B481760041B3DA0041B3DA000000 + 000000000000000000000000000000000000000000002EACD800C2FDFF0099FD + FE0099FDFE0099FDFE0099FDFE00C2FDFF00C2FDFF00C2FDFF00ADFBFE0099FD + FE0099FDFE0099FDFE0071EBF9002EACD8000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000D0E2CE0025A63D0047CE710030C369008DBC + 8B000000000000000000000000000000000000000000B4817600CB666600A345 + 3F00F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 + F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 + 5700CB666600994C4D000000000000000000000000000000000000000000ACDB + F40041B3DA0037B4E000EDBD9200FFFEFF00FFFEFF00FFFFFE00FFFFFF00FEF9 + F300FEF9F300B4817600FCB04C00D3936400D8C5B50000000000000000000000 + 000000000000000000000000000000000000000000001DA6D500E4FDFE00ADFB + FE0099FDFE0099FDFE00C2FDFF009EDEEE002EACD8002EACD8002EACD8002EAC + D8002EACD8002EACD8002EACD8002EACD8000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000448A3E0025BB4F0047CE71000F831900EFF9 + F0000000000000000000000000000000000000000000B4817600CB666600A345 + 3F00F8F0F000F3F3F300C7C7C700BFBFBF00C0C0C000BFBFBF00C0C0C000C0C0 + C000C3C2C200C4C4C400C3C2C200C4C4C400CFCFCF00F3F3F300D6BCBB00BB57 + 5700CB666600994C4D0000000000000000000000000000000000000000000000 + 00000000000000000000EDBD9200FFFFFF00FCFEFB00F8FBFB00FAFAFA00F8F8 + F800F8F0F000B4817600EDBD9200D8C5B5000000000000000000000000000000 + 000000000000000000000000000000000000000000002EACD8007ECBE6007ECB + E6009EDEEE00BEE6F500ACDBF40037B4E0000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000E1F1E10068A7620018992E0030C369000F831900DDEADD000000 + 00000000000000000000000000000000000000000000B4817600CB666600A345 + 3F00F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 + F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 + 5700CB666600994C4D0000000000000000000000000000000000000000000000 + 00000000000000000000DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 + 8700DCA88700DCA88700DCA88700000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000037B4E00037B4 + E00037B4E00037B4E00041B3DA00F0FEFE000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000AFD0B00005710A00448A + 3E0005710A000F8319000EA31B0018992E00267D2700DDEADD00000000000000 + 00000000000000000000000000000000000000000000B4817600CB666600A345 + 3F00F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3 + F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300F3F3F300D6BCBB00BB57 + 5700CB666600994C4D0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000F2FAF500AFD0 + B00068A762007DA972007DA97200D0E2CE000000000000000000000000000000 + 00000000000000000000000000000000000000000000B4817600994C4D009934 + 3400C4C4C400C4C4C400C3C2C200C3C2C200C4C4C400C4C4C400C4C4C400C4C4 + C400C4C4C400C3C2C200C4C4C400C4C4C400C4C4C400C3C2C200BF989500994C + 4D00994C4D00DAD9D90000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000EFEFEF00C0C0C0009F9F + 9F009F9F9F00A8A8A8008F8F8F00B9B9B900E6E5E40000000000000000000000 + 0000000000000000000000000000000000000000000000000000CC9A9900CC9A + 9900CC9A9900D5B3AF00EADBD400F8F0F0000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000059ACD00059ACD0090D1F100BEE6F5000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000059ACD0064C1 + E1009EDEEE00DFEFF90000000000000000000000000000000000000000000000 + 0000000000000000000000000000AFD0B0000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000EFEFEF009F9F9F008C8988009F9F9F00B9AA + A600C8ABAB00CABCB700D6BCBB00D5B3AF00B1A0970086858500D1D1D1000000 + 0000000000000000000000000000000000000000000000000000CC9A9900CC9A + 9900D6A89400D6A89400D6A89400CC9A9900CC9A9900CDA6A000E4D1CD00F6EF + E700000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000059ACD00C7EFF10037B4E000059ACD00059ACD0041B3DA007ECBE600ACDB + F400F0F6FD000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000059ACD00DFEF + F90056C6F0002EACD8002EACD80064C1E10090D1F100D1EFF900000000000000 + 000000000000000000000000000005710A0068A7620000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000D1D1D1008C89880099969700999697008F8E8D008F8E + 8D00A4968E00A18C8200A4968E008C898800C8ABAB00FECFC200BF989500A8A8 + A800000000000000000000000000000000000000000000000000CC9A9900CC9A + 9900CC9A9900FECC9A00FECC9A00FECC9A00EDBD9200E3B18E00D6A89400CC9A + 9900CC9A9900CC9A9900DBC9C600F1E3E2000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000059ACD007ECBE6009AE3FF007BDDFE0070D2FD0056C6F00037B4E0001DA6 + D500059ACD002EACD8007ECBE6009EDEEE00DFEFF90000000000000000000000 + 0000000000000000000000000000000000000000000000000000059ACD0090D1 + F1009AE3FF007BDDFE0070D2FD0060D4F00056C6F00037B4E0001DA6D5004BBD + E00090D1F100C7EFF100D1EFF9000F8319000F831900448A3E00EFF9F0000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000A1C79E00879185009F9F9F008C898800B1A09700EDD9B700FDE8 + B700CFCFCF006682F100FDF6C600FDE8B700D8C5B50086858500E2BDB300E2BD + B3008C8988000000000000000000000000000000000000000000CC9A9900EDBD + 9200D6A89400D6A89400FED7AB00FED7AB00F3D1A300FECC9A00FECC9A00FECC + 9A00EDBD9200EDBD9200D6A89400CC9A9900CC9A9900CC9A9900D6BCBB00F1E3 + E200000000000000000000000000000000000000000000000000000000000000 + 0000059ACD0037B4E000D1EFF9007BDDFE007BDDFE007BDDFE007BDDFE007BDD + FE0051B4940056C6F00037B4E0001DA6D500059ACD001DA6D500BEE6F5000000 + 0000000000000000000000000000000000000000000000000000059ACD0064C1 + E100D1EFF9007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE0070D2 + FD0060D4F00037B4E00037B4E0000F8319000EA31B000F831900267D2700D0E2 + CE00000000000000000000000000000000000000000000000000000000000000 + 0000AFD0B0000F831900267D270087918500E3D3AA00FDE8B700FDF6C600FEF9 + F300BEC6DC004571FA00FFFDF800FEFFFC00FFF8EE00FDF6C600A4968E00D5B3 + AF00E2BDB300A8A8A80000000000000000000000000000000000CC9A9900EAC8 + A100F3D1A300CC9A9900DAB4A000FDE8B700FDE8B700FED7AB00FED7AB00FED7 + AB00F3D1A300FECC9A00FECC9A00FECC9A00FECC9A00EDBD9200D6A89400D6A8 + 9400CC9A9900CC9A990000000000000000000000000000000000000000000000 + 0000059ACD004BBDE000D1EFF90084E9FE0084E9FE0084E9FE0084E9FE0084E9 + FE002A8C430005710A0069CCC00084E9FE0084E9FE0060D4F000059ACD000000 + 0000000000000000000000000000000000000000000000000000059ACD004BBD + E000F0F6FD007BDDFE0084E9FE007BDDFE002A8C43000F8319000F8319000F83 + 19000F8319000F8319000F8319000F83190016B432000EA31B000EA31B000571 + 0A00A1C79E00000000000000000000000000000000000000000000000000D0E2 + CE00267D270058E0870030C36900448A3E00FDE8B700FDF6C600FDE8B700FED7 + AB00FED7AB00FED7AB00FDE8B700FEEBD700FFFDF800FEFFFC00FDF6C6008F8E + 8D00E2BDB300AB8FA300DAD9D900000000000000000000000000CC9A9900F3D1 + A300FDE8B700EAC8A100CC9A9900EDD9B700FDF6C600FDF6C600FDE8B700FDE8 + B700FDE8B700FDE8B700FED7AB00FED7AB00FECC9A00F3D1A300FECC9A00FECC + 9A00D6A89400CC9A990000000000000000000000000000000000000000000000 + 0000059ACD0061C6FE0090D1F100ADFBFE008DF3FE008DF3FE008DF3FE008DF3 + FE0051B4940025A63D0018992E0051B494008DF3FE0084E9FE00059ACD00D1EF + F900000000000000000000000000000000000000000000000000059ACD0056C6 + F0009EDEEE00ADFBFE0084E9FE0084E9FE002A8C430058E0870047CE710047CE + 710047CE710030C3690030C3690025BB4F0016B4320016B432000EA31B000EA3 + 1B0005710A007DA9720000000000000000000000000000000000F2FAF5001899 + 2E0030C3690058E0870058E0870025A63D007DA97200FDE8B700FDE8B700FDE8 + B700FDE8B700FED7AB00FED7AB00FED7AB00FEDDBB00FFFDF800FFFDF800FDF6 + C6008F8E8D00FECFC20099969700000000000000000000000000CC9A9900EDD9 + B700FDF6C600FDE8B700EAC8A100CC9A9900FEE4CA00FEFED300FDF6C600FDF6 + C600FDF6C600FDE8B700FDE8B700FDE8B700FDE8B700FED7AB00FED7AB00DAB4 + A000CC9A9900CC9A990000000000000000000000000000000000000000000000 + 0000059ACD0070D2FD0041B3DA00D4FDFF0099FDFE0099FDFE0099FDFE0099FD + FE0099FDFE0018992E0058E0870025A63D0051B4940084E9FE00ADFBFE0064C1 + E100000000000000000000000000000000000000000000000000059ACD0056C6 + F0002EACD800D4FDFF0084E9FE008DF3FE002A8C430058E0870058E0870058E0 + 870047CE710030C3690047CE710025BB4F0025BB4F0016B4320016B432000EA3 + 1B000EA31B0005710A0068A76200000000000000000000000000448A3E0025A6 + 3D0047CE710058E0870058E0870058E087000EA31B00A1C79E00FDE8B700FDE8 + B700FDE8B700FDE8B700FDE8B700FED7AB00FED7AB00FDE8B700FCFEFB00FFF8 + EE00B9AAA600D5B3AF00A4968E00ECEAEA000000000000000000CC9A9900FDE8 + B700FEFED300FEFED300FDF6C600C8ABAB00DAB4A000FEFFE100FEFED300FEFE + D300FEFED300FEFED300FDF6C600FDF6C600FDF6C600FDF6C600EAC8A100CC9A + 9900DAB4A000CDA6A00000000000000000000000000000000000000000000000 + 00001DA6D50070D2FD0037B4E000D1EFF90099FDFE0099FDFE0099FDFE0099FD + FE0099FDFE0051B4940025A63D0058E0870018992E007ECBE600C2FDFF00059A + CD00DFEFF9000000000000000000000000000000000000000000059ACD0061C6 + FE0037B4E000F0F6FD0099FDFE008DF3FE002A8C430058E0870058E0870058E0 + 870047CE710047CE710030C3690047CE710025BB4F0025BB4F0016B4320016B4 + 32000EA31B0005710A008DBC8B0000000000000000007DA972000F83190030C3 + 690047CE710058E0870058E0870058E0870058E087000F831900C7D19500FDF6 + C600FDF6C600FDE8B700FDE8B700FDE8B700FED7AB00FED7AB00FEF0E200FCFE + FE00FDE8B700A4968E00C8ABAB00C7C7C7000000000000000000CC9A9900F0E4 + C700FEFED300FEFED300FEFED300FDE8B700CDA6A000D8C5B500FEFFE100FEFF + E100FEFFE100FEFED300FEFED300FEFED300FEFED300EDD9B700CC9A9900EAC8 + A100FECC9A00D6A8940000000000000000000000000000000000000000000000 + 00001DA6D5007BDDFE0056C6F0007ECBE600E4FDFE00D4FDFF00C2FDFF00C2FD + FF00ADFBFE00ADFBFE0025A63D0058E0870030C3690051B49400D4FDFF00C2FD + FF00059ACD000000000000000000000000000000000000000000059ACD0070D2 + FD0061C6FE009EDEEE00C2FDFF0099FDFE002A8C430049AA490025A63D0025A6 + 3D0025A63D0025A63D0018992E0025BB4F0030C3690030C3690025BB4F0016B4 + 320005710A00AFD0B0000000000000000000A1C79E0005710A0025BB4F0025BB + 4F0030C3690030C3690047CE710058E0870058E0870047CE7100267D2700FDF6 + C600E3D3AA00CB9A8200EDBD9200FDE8B700FDE8B700FED7AB00FDE8B700FFFF + FE00FDF6C60080808000D6BCBB00B5B3B3000000000000000000CC9A9900F0E4 + C700FEFED300FEFED300FEFED300FEFED300E5CDBE00CC9A9900F3E3D100FFF8 + EE00FEFFE100FEFFE100FEFFE100FEFFE100EDD9B700CC9A9900DAB4A000FDE8 + B700FDE8B700D6A8940000000000000000000000000000000000000000000000 + 00001DA6D50084E9FE007BDDFE0056C6F00037B4E00037B4E00037B4E00037B4 + E000E4FDFE00ADFBFE0025A63D0058E0870058E08700267D2700E4FDFE00E4FD + FE00059ACD000000000000000000000000000000000000000000059ACD0070D2 + FD0061C6FE009BC3D800D4FDFF0099FDFE0099FDFE0099FDFE0099FDFE0099FD + FE0099FDFE0099FDFE0099FDFE0025A63D0030C3690030C3690018992E002A8C + 430069CCC000D1EFF900000000000000000068A76200448A3E00448A3E000F83 + 190025BB4F0047CE710047CE710025BB4F00267D2700448A3E00448A3E008DBC + 8B0060606000707070004E4940006F5B4D006F5B4D00826A5B00FED7AB00D0E3 + EC004571FA0099969700D6BCBB00B9B9B9000000000000000000CC9A9900F3E3 + D100FEFFE100FEFFE100FEFFE100F0E4C700CDA6A000CC9A9900CC9A9900EADB + D400FFF8EE00FFFDF800FEF9F300F5EADF00CDA6A000E2BDB300FDF6C600FDF6 + C600FDF6C600DAB4A00000000000000000000000000000000000000000000000 + 00002EACD8009AE3FF0084E9FE0084E9FE0084E9FE0084E9FE0084E9FE007BDD + FE0037B4E000E4FDFE0025A63D0058E0870058E0870018992E00FCFEFE00F9FF + FE00BEE6F500059ACD0000000000000000000000000000000000059ACD007BDD + FE007BDDFE00B4817600BEE6F500F0FEFE00E4FDFE00D4FDFF00C2FDFF00C2FD + FF00ADFBFE00ADFBFE00C2FDFF0025A63D0047CE710018992E002A8C4300C7EF + F100D4FDFF002EACD80000000000000000000000000000000000E6E5E4000F83 + 190016B4320025BB4F0030C3690018992E00C0D5C200FEFFE100FEFED300FEFE + D300606060008F8F8F0030303000927D7000A18C8200CB9A8200FED7AB00ECEA + EA004571FA008F8E8D00C8ABAB00B9B9B9000000000000000000CC9A9900EFE4 + D800FEFFE100FEEBD700D5B3AF00CC9A9900BFBFBF00C7EFF100C0C0C000CC9A + 9900CC9A9900CDA6A000D5B3AF00CDA6A000CC9A9900F0E4C700FEFED300FEFE + D300FEFED300DAB4A00000000000000000000000000000000000000000000000 + 000037B4E00099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD + FE008DF3FE0037B4E00025A63D0058E0870058E0870018992E00BEE6F500BEE6 + F500FCFEFB00059ACD0000000000000000000000000000000000059ACD007BDD + FE007BDDFE00BA8E8500C7DDE1009BC3D80037B4E00041B3DA0037B4E0002EAC + D800F0FEFE00C2FDFF00C2FDFF0025A63D000F83190068A762009AE3FF00E4FD + FE00E4FDFE002EACD800DFEFF900000000000000000000000000ECEAEA000571 + 0A0016B4320025BB4F0025BB4F0018992E00C0D5C200FFFDF800FEFFE100FEFF + E100F0E4C700C6B8AB004040400059504700FED7AB00FDE8B700FDE8B700FFF8 + EE00FDE8B70086858500B9AAA600B9B9B9000000000000000000CC9A9900EADB + D400E2BDB300CC9A9900C6B8AB00E6E5E400F0FEFE00F9FFFE00E4FDFE00C2FD + FF00C7DDE100BEC6DC00C4C4C400AFCFDE00C8ABAB00CC9A9900FEEBD700FEFE + D300FEFED300DAB4A00000000000000000000000000000000000000000000000 + 000037B4E00099FDFE0099FDFE0099FDFE0099FDFE0099FDFE00ADFBFE0099FD + FE0099FDFE0099FDFE0025A63D0047CE710058E0870018992E002EACD80037B4 + E00037B4E000ACDBF400000000000000000000000000000000001DA6D50084E9 + FE0084E9FE00CB9A8200F8F3EC00FEF4E900FEF0E200FEEBD700FEEBD700C0D5 + C2002EACD800F0FEFE00F0FEFE0005710A00A1C79E00D4FDFF009AE3FF00F0FE + FE00F0FEFE00F0FEFE00059ACD0000000000000000000000000000000000448A + 3E000F83190016B4320025BB4F0018992E00A1C79E00FFFDF800FEFFE100FEFF + E100FEFFE100FEFED300E3D3AA0043424200826A5B00FED7AB00FDF6C600FEEB + D700C7D195008F8F8F0099969700D1D1D1000000000000000000CC9A9900CC9A + 9900CDA6A000BEC6DC00F9FFFE00FFFFFF00F9FFFE00F9FFFE00F0FEFE00F0FE + FE00E4FDFE00E4FDFE00E4FDFE00E4FDFE00D1EFF900C8ABAB00CC9A9900F0E4 + C700FEFFE100DAB4A00000000000000000000000000000000000000000000000 + 000037B4E000D4FDFF0099FDFE0099FDFE0099FDFE00C2FDFF00ACDBF40037B4 + E0002EACD80051B4940025A63D0047CE710058E0870018992E00000000000000 + 00000000000000000000000000000000000000000000000000001DA6D5008DF3 + FE008DF3FE00CB9A8200F8F3EC00FEF9F300FEF4E900FEF0E200FEEBD700FEEB + D700C0D5C2002EACD8002EACD8002EACD800DFEFF900FCFEFE00E4FDFE00FEFE + FE00FEFEFE00FCFEFE00059ACD0000000000000000000000000000000000AFAF + AF0005710A000EA31B0016B4320016B43200448A3E00FFFFFF00FCFEFB00FEF9 + F300FEFFE100FEFED300FEFED300E3D3AA0040404000826A5B00FED7AB00FDE8 + B700B1A097009996970086858500000000000000000000000000CC9A9900CC9A + 9900CC9A9900BEC6DC00FFFEFF00FFFEFF00FFFFFF00FFFFFF00F9FFFE00F9FF + FE00F0FEFE00E4FDFE00F0FEFE00E4FDFE00E4FDFE00D1EFF900B9AAA600CDA6 + A000FEEBD700D5B3AF0000000000000000000000000000000000000000000000 + 00002EACD8009EDEEE00E4FDFE00E4FDFE00D4FDFF00BEE6F5007ECBE600FEFF + FC00FFFEFF0005710A0025BB4F0030C3690047CE710018992E00000000000000 + 00000000000000000000000000000000000000000000000000001DA6D50099FD + FE0099FDFE00DCA88700F8F8F800FEFAF700FFF8EE00FEF4E900FEF0E200FEEB + D700FEEBD700FEE4CA00FED6C900B481760071EBF900059ACD00059ACD00059A + CD00059ACD00059ACD00059ACD0000000000000000000000000000000000E6E5 + E400668E67000F8319000EA31B0016B432000F8319008DBC8B00FFFEFF00FFFF + FF00FFFFFE00FFFDF800FEFED300FEFED300E3D3AA0040404000E3B18E00E3D3 + AA008C89880099969700A8A8A800000000000000000000000000F6EFE700CC9A + 9900C8ABAB0090D1F100FFFFFE00FFFEFF00FFFFFF00FEFEFE00FFFEFF00FFFC + FF00FFFFFF00F0FEFE00F0FEFE00E4FDFE00BEE6F500ACDBF4007ECBE600AB8F + A300CDA6A000CDA6A00000000000000000000000000000000000000000000000 + 0000F0F6FD0037B4E00041B3DA0037B4E00037B4E00005710A0005710A00448A + 3E00448A3E000F83190030C3690047CE710047CE710018992E00000000000000 + 00000000000000000000000000000000000000000000000000001DA6D50099FD + FE0099FDFE00E3B18E00F8FBFB00FFFEFE00FEF9F300FFF8EE00FEF4E900FEF0 + E200FEEBD700FEEBD700FEE4CA00B481760099FDFE0099FDFE002EACD8000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000B9B9B900668E67000F8319000EA31B0016B432000F831900448A3E00A1C7 + 9E00DDEADD00D1EFF900FFFDF8008DBC8B00C7D19500EDD9B700E3D3AA008C89 + 8800A8A8A8008F8E8D00EFEFEF0000000000000000000000000000000000F8F0 + F000CC9A9900A9ACD400FEFFFC00FFFFFF00FFFCFF00D0E3EC00ACDBF40090D1 + F10090D1F10098A9EF0085AFCB00AB8FA300AB8FA300CC9A9900B7A2B600B7A2 + B600CC9A9900CC9A990000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000049AA49000F83190016B4 + 320016B4320025BB4F0025BB4F0030C3690030C3690025BB4F000F8319000F83 + 190005710A0068A76200000000000000000000000000000000001DA6D500D4FD + FF0099FDFE00EDBD9200FFFCFF00FFFFFE00FFFFFF00FEFAF700FFF8EE00FEF4 + E900FEF0E200FECFC200FCA3A200B4817600C2FDFF00ADFBFE002EACD8000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FAF3F200B5B3B3008DBC8B000F8319000F83190016B4320025BB4F001899 + 2E000F83190005710A0005710A00267D2700E3D3AA00EAC8A10099969700AFAF + AF0099969700CFCFCF0000000000000000000000000000000000000000000000 + 0000F8F0F000A9ACD40098A9EF0070D2FD0070D2FD0070D2FD009AE3FF0090D1 + F10090D1F10090D1F10090D1F10090D1F10098A9EF0098A9EF00A9ACD400B7A2 + B600CC9A9900CC9A990000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000EFF9F00005710A000EA3 + 1B0016B4320016B4320025BB4F0025BB4F0030C3690030C3690025BB4F000F83 + 19008DBC8B0000000000000000000000000000000000000000001DA6D500DFEF + F900E4FDFE00EDBD9200FEFEFE00FFFFFE00FEFEFE00FFFFFF00FEF9F300FEF9 + F300B4817600B4817600B4817600B48176002EACD8002EACD8002EACD8000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000EFEFEF00B9B9B900DDEADD007DA97200267D270005710A000F83 + 190005710A00448A3E007DA97200DAB4A000B1A09700A8A8A800B9B9B9009F9F + 9F00CFCFCF000000000000000000000000000000000000000000000000000000 + 00000000000000000000CDA6A000BFBFBF008DF3FE009AE3FF009AE3FF009AE3 + FF009AE3FF0090D1F10090D1F10090D1F10090D1F10090D1F10098A9EF00B7A2 + B600CC9A9900F1E3E20000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000AFD0B0000571 + 0A000EA31B0016B4320016B4320025BB4F0025BB4F0018992E00267D2700D0E2 + CE000000000000000000000000000000000000000000000000000000000041B3 + DA0041B3DA00EDBD9200FFFEFF00FFFFFF00FFFFFF00FFFFFF00FEFFFC00FEF9 + F300B4817600FECC9A00DCA88700ECDACC000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000EFEFEF00B9B9B900DAD9D900FBFBFC00E6E5E400C7C7 + C700BFBFBF00B9B9B900B5B3B300C4C4C400CFCFCF00C0C0C0009F9F9F00DAD9 + D900000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000CDA6A000BFBFBF008DF3FE008DF3FE009AE3 + FF009AE3FF009AE3FF0090D1F10090D1F10090D1F1009BC3D800CC9A9900D5B3 + AF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000049AA + 49000F8319000EA31B0016B4320018992E000F8319008DBC8B00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000EDBD9200FEF0E200FEF0E200F5EADF00EFE4D800EFE4D800EADB + D400B4817600E3B18E00EADBD400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000DAD9D900B9B9B900C0C0C000DAD9 + D900DAD9D900D1D1D100CCCACA00B9B9B900A8A8A800C4C4C400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000CDA6A000BFBFBF0099FDFE008DF3 + FE009AE3FF009AE3FF009AE3FF0090D1F100B7A2B600CC9A9900F1E3E2000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000F3F3 + F30005710A000EA31B0005710A00448A3E00E1F1E10000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 + 8700DCA88700EFE4D80000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000F3F3F300DFDF + DF00CCCACA00CCCACA00DAD9D900ECEAEA000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000CDA6A000B5B3B3009EDE + EE008DF3FE009AE3FF009BC3D800CC9A9900D5B3AF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000AFD0B00005710A00A1C79E00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000D6BCBB00CC9A + 9900CC9A9900CC9A9900CC9A9900F1E3E2000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000009F9F9F0080808000C8AB + AB00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000D0E3EC0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000D0E3EC00F3F3 + F30000000000000000000000000000000000000000000000000000000000A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 7400A47874008C5D5C0000000000000000000000000000000000000000000000 + 0000000000000000000000000000C8ABAB00CB9A8200BA8E8500B4817600C8AB + AB00E4D1CD00FAF3F20000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000A8A8A8005D71AB005D71AB008D82 + A600C8ABAB000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000066A6C3000C7CAC000C7CAC00D0E3EC000000000000000000000000000000 + 000000000000000000000000000000000000F0F6FD00458EB60066A6C3000C7C + AC0000000000000000000000000000000000000000000000000000000000A478 + 7400E2BDB300F3B9B500F3B9B500F3B9B500F3B9B500F3B9B500F3B9B500F3B9 + B500F3B9B500F3B9B500F3B9B500E2BDB300F3B9B500D5B3AF00F3B9B500F3B9 + B500E3B18E008C5D5C0000000000000000000000000000000000000000000000 + 00000000000000000000BF989500DCA88700EDBD9200F3E3D100F0E4C700E5CD + BE00DAB4A000C8ABAB00CC9A9900D6BCBB00E2D6E200FAF3F200000000000000 + 00000000000000000000000000000000000085AFCB004BAFFF003A80E0005D71 + AB008D82A600CDA6A00000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000C7CAC0084E9FE0004B8EA000C7CAC00AFCFDE0000000000000000000000 + 0000000000000000000000000000D0E3EC002783AC009BC3D800D4FDFF002EAC + D800C0D9E600000000000000000000000000000000000000000000000000A478 + 7400DED2CA00FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDD + BB00FEDDBB00FED7AB00FEDDBB00FED7AB00FED7AB00FED7AB00F3D1A300FECC + 9A00FECFC2008C5D5C0000000000000000000000000000000000000000000000 + 0000ECEAEA00D6A89400E3B18E00EDBD9200EAC8A100EFE4D800F3E3D100F0E4 + C700ECDACC00EDD9B700B4817600BA8E8500BA8E8500BA8E8500BF989500C8AB + AB00DBC9C600F8F0F0000000000000000000ACDBF40061C6FE004BAFFF003A80 + E0005D71AB008D82A600C8ABAB00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000458EB600D0E3EC0010D1FE0004B8EA000C7CAC009BC3D800000000000000 + 00000000000000000000D0E3EC002783AC00ACDBF4008DF3FE003FE0FF000C7C + AC0000000000000000000000000000000000000000000000000000000000A478 + 7400DED7D300FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEDD + BB00FDE8B700FDE8B700FED7AB00FED7AB00FED7AB00FED7AB00FED7AB00F3D1 + A300FECFC2008C5D5C000000000000000000000000000000000000000000F6EF + E700D6A89400EDBD9200EDBD9200EDBD9200EAC8A100FEEBD700EFE4D800F3E3 + D100F0E4C700ECDACC00A4787400A4787400B4817600BF989500E3D3AA00DAB4 + A000D6A89400A18C8200BF9895000000000000000000ACDBF40061C6FE004BAF + FF003A80E0005D71AB008D82A600C8ABAB000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000AFCFDE0066A6C30084E9FE0010D1FE0010D1FE00059ACD0066A6C3000000 + 0000000000009BC3D8002783AC00C7EFF10063E5FD0010D1FE001DA6D50066A6 + C30000000000000000000000000000000000000000000000000000000000B481 + 7600DED7D300FEEBD700FEEBD700FEEBD700029A0300FEE4CA00FEE4CA00C7D1 + 95007DA972008DBC8B00E3D3AA00FEDDBB00FED7AB00FED7AB00FED7AB00FED7 + AB00FECFC2008C5D5C0000000000000000000000000000000000EADBD400D6A8 + 9400F3D1A300FECC9A00EAC8A100EDBD9200EAC8A100F5EADF00EFE4D800EFE4 + D800F3E3D100ECDACC00986B6600986B6600986B6600BA8E8500E3D3AA00E3D3 + AA00E3D3AA00EAC8A100BA8E850000000000000000000000000090D1F10061C6 + FE004BAFFF003A80E0005D71AB008D82A600C8ABAB0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000002783AC00D1EFF90010D1FE0010D1FE003FE0FF002EACD8002783 + AC0085AFCB00458EB600DFEFF90084E9FE0010D1FE0010D1FE000C7CAC00DFEF + F90000000000000000000000000000000000000000000000000000000000B481 + 7600DAD9D900FEF0E200FEEBD700FEEBD700029A03007ACE7F0049AA4900029A + 0300029A0300029A0300029A030068A76200FDE8B700FED7AB00FED7AB00FED7 + AB00FECFC2008C5D5C00000000000000000000000000F1E3E200DAB4A000FED7 + AB00F3D1A300F3D1A300FECC9A00EDBD9200F3D1A300F6EFE700F5EADF00F5EA + DF00F3E3D100F3E3D100986B6600986B6600986B6600A18C8200EDD9B700E3D3 + AA00E3D3AA00E3D3AA00BA8E850000000000000000000000000000000000ACDB + F40061C6FE004BAFFF003A80E0005D71AB008D82A600D5B3AF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000009BC3D80085AFCB0063E5FD0010D1FE0010D1FE003FE0FF004BBD + E00066A6C300F0FEFE008DF3FE003FE0FF0010D1FE0004B8EA002783AC000000 + 000000000000000000000000000000000000000000000000000000000000B481 + 7600DFDFDF00FEF0E200FEF0E200FEEBD700029A0300029A0300029A0300029A + 0300029A0300029A0300029A0300029A030068A76200FED7AB00FED7AB00FED7 + AB00FECFC2008C5D5C00000000000000000000000000DAB4A000E3D3AA00EDD9 + B700F3D1A300F3D1A300F3D1A300EAC8A100F3D1A300F6EFE700F6EFE700F5EA + DF00EFE4D800F3E3D100986B6600986B6600986B6600B4817600EDD9B700EDD9 + B700EDD9B700E3D3AA00BA8E8500000000000000000000000000000000000000 + 000090D1F10061C6FE004BAFFF003A80E0005D71AB00AB8FA300000000000000 + 0000F8F0F000DED7D300DED2CA00EADBD400EFE4D800F1E3E200F8F0F0000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000F3F3F3002783AC00D1EFF90010D1FE0010D1FE003FE0FF0063E5 + FD0099FDFE00ADFBFE008DF3FE0063E5FD003FE0FF00059ACD009BC3D8000000 + 000000000000000000000000000000000000000000000000000000000000B481 + 7600E1E0E000FEF4E900FEF0E200FEF0E200029A0300029A0300029A0300029A + 03000EA31B007ACE7F0068A76200029A0300029A0300C7D19500FED7AB00FEDD + BB00FECFC2008C5D5C00000000000000000000000000DAB4A000F3D1A300FED7 + AB00FED7AB00F3D1A300F3D1A300FECC9A00EDD9B700F8F3EC00FEF4E900F5EA + DF00F5EADF00EFE4D800986B6600986B6600986B6600B4817600EDD9B700EDD9 + B700E3D3AA00E3D3AA00BA8E8500000000000000000000000000000000000000 + 000000000000ACDBF4005DB2FC004BAFFF00458EB60099969700D1D1D100E4D1 + CD00BF989500BA8E8500BF989500CDA6A000C8ABAB00CDA6A000D5B3AF00E4D1 + CD00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000066A6C300ACDBF4003FE0FF0010D1FE0010D1FE0063E5 + FD0071EBF90099FDFE0099FDFE0071EBF9003FE0FF000C7CAC00F2FAF5000000 + 000000000000000000000000000000000000000000000000000000000000BA8E + 8500E6E5E400FEF4E900FEF4E900FEF0E200029A0300029A0300029A0300029A + 03008DBC8B00FEE4CA00FEE4CA00EDD9B70049AA490049AA4900FEDDBB00FEDD + BB00FED6C9008C5D5C00000000000000000000000000DAB4A000E3D3AA00FDE8 + B700FED7AB00F3D1A300EDBD9200EDBD9200F3D1A300FEF9F300F8F3EC00F6EF + E700F5EADF00F5EADF00986B6600986B6600986B6600B4817600ECDACC00EDD9 + B700EDD9B700EDD9B700BA8E8500000000000000000000000000000000000000 + 00000000000000000000ACDBF40090D1F100CFCFCF00A4968E00A18C8200CB9A + 8200EAC8A100FDE8B700FDF6C600FEFED300FEFED300FDF6C600E5CDBE00CDA6 + A000D5B3AF000000000000000000000000000000000000000000000000000000 + 000000000000000000009BC3D800458EB6009AE3FF0010D1FE0010D1FE003FE0 + FF0071EBF9008DF3FE0099FDFE008DF3FE004BBDE000458EB600000000000000 + 000000000000000000000000000000000000000000000000000000000000BA8E + 8500E6E5E400FFF8EE00FEF4E900FEF0E200029A0300029A0300029A0300029A + 0300029A0300029A0300FEE4CA00FEE4CA00EDD9B70025A63D00FED7AB00FEDD + BB00FECFC200986B6600000000000000000000000000DAB4A000EDD9B700FDE8 + B700EAC8A10085AFCB004493ED004493ED00CABCB700FDFAFA00F9F6F500F8F3 + EC00F6EFE700F5EADF00E4D1CD00D8C5B500CDA6A000BF989500F0E4C700ECDA + CC00EDD9B700EDD9B700BA8E8500000000000000000000000000000000000000 + 0000000000000000000000000000F0F6FD00E6E5E400BF989500CB9A8200EDD9 + B700FDF6C600FEFED300FEFED300FEFED300FEFFE100FEFFE100FFFDF800F6EF + E700C8ABAB00C8ABAB0000000000000000000000000000000000000000000000 + 00000000000085AFCB000C7CAC0004B8EA0010D1FE0010D1FE0010D1FE003FE0 + FF003FE0FF008DF3FE0099FDFE0099FDFE0063E5FD001DA6D500458EB600DFEF + F90000000000000000000000000000000000000000000000000000000000BA8E + 8500ECEAEA00FFF8EE00FEF4E900FEF4E900FEF4E900FEF4E900FEF0E200FEF0 + E200FEEBD700FEE4CA00FEEBD700FEE4CA00FEE4CA00FEE4CA00EDD9B700FEDD + BB00FECFC200986B6600000000000000000000000000DAB4A000F3D1A300EAC8 + A10085AFCB004BAFFF00399CFE00399CFE004493ED00D1EFF900FEFAF700F9F6 + F500F8F3EC00F6EFE700F6EFE700F5EADF00EFE4D800F3E3D100F3E3D100F0E4 + C700ECDACC00EDD9B700BA8E8500000000000000000000000000000000000000 + 000000000000000000000000000000000000EADBD400CC9A9900FED7AB00FDF6 + C600FDF6C600FDF6C600FEFED300FEFFE100FEFFE100FFFDF800FFFFFF00FEFE + FE00F6EFE700BF989500DFDFDF0000000000000000000000000000000000C0D9 + E6002783AC00059ACD0010D1FE003FE0FF003FE0FF0010D1FE0010D1FE0010D1 + FE003FE0FF0071EBF90099FDFE0099FDFE0071EBF90063E5FD0004B8EA000C7C + AC0085AFCB00000000000000000000000000000000000000000000000000CB9A + 8200ECEAEA00FDFAFA00FEF9F3007ACE7F00FEF0E200FEF0E200FEF0E200FEF0 + E200FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDD + BB00FED6C900986B6600000000000000000000000000DAB4A000C6B8AB0061C6 + FE0061C6FE004BAFFF004BAFFF00399CFE00399CFE004493ED00DFEFF900FDFA + FA00FEF9F300F8F3EC00F6EFE700F5EADF00F5EADF00EFE4D800F3E3D100F3E3 + D100ECDACC00ECDACC00BF989500F1E3E2000000000000000000000000000000 + 000000000000000000000000000000000000E2BDB300DAB4A000FDF6C600FDE8 + B700FDE8B700FEFED300FEFED300FEFFE100FEF9F300FFFDF800FEFEFE00FFFD + F800FEFFE100E5CDBE00BF9895000000000000000000F3F3F30066A6C3000C7C + AC0004B8EA0063E5FD0071EBF90063E5FD003FE0FF0010D1FE0010D1FE0010D1 + FE003FE0FF0063E5FD008DF3FE0099FDFE008DF3FE0071EBF9003FE0FF0010D1 + FE00059ACD000C7CAC00C0D9E60000000000000000000000000000000000CB9A + 8200EFEFEF00FFFDF800FEF9F3007ACE7F00BBE5B900FEF4E900FEF4E900FEF0 + E200029A0300029A0300029A0300029A0300029A0300FEE4CA00FEE4CA00FEE4 + CA00FED6C900986B6600000000000000000000000000C6B8AB0061C6FE0061C6 + FE0061C6FE0061C6FE004BAFFF004BAFFF00399CFE00399CFE004493ED00DFEF + F900FDFAFA00FEF9F300F8F3EC00F6EFE700F5EADF00F5EADF00EFE4D800F3E3 + D100EADBD400BF989500BF989500F1E3E2000000000000000000000000000000 + 0000000000000000000000000000ECEAEA00CDA6A000EDD9B700FDF6C600FED7 + AB00FDE8B700FEFED300FEFED300FEFFE100FFFDF800FFFDF800FFFDF800FEF9 + F300FEFFE100F0E4C700B4817600ECEAEA009BC3D8000C7CAC0004B8EA0010D1 + FE008DF3FE0099FDFE008DF3FE0071EBF9003FE0FF0010D1FE0010D1FE0010D1 + FE0010D1FE003FE0FF0071EBF90099FDFE0099FDFE008DF3FE003FE0FF0010D1 + FE0010D1FE0010D1FE000C7CAC0085AFCB00000000000000000000000000CB9A + 8200EFEFEF00F9FFFE00FEFAF700D0E2CE000EA31B00BBE5B900FEF4E900FEF0 + E200FEEBD70025A63D00029A0300029A0300029A0300FEEBD700FEE4CA00FEE4 + CA00FECFC200986B66000000000000000000ACDBF4004BAFFF005DB2FC0061C6 + FE0061C6FE0061C6FE0061C6FE005DB2FC004BAFFF00399CFE00399CFE005DB2 + FC00F0F6FD00F9F6F500F9F6F500F8F3EC00F6EFE700F5EADF00F5EADF00EFE4 + D800AB8FA3008D82A600DED7D300000000000000000000000000000000000000 + 0000000000000000000000000000F1E3E200CDA6A000FDF6C600FDE8B700FED7 + AB00FDE8B700FDF6C600FEFED300FEFFE100FEFFE100FFF8EE00FFF8EE00FEFF + E100FEFED300FDF6C600BF989500F1E3E2002783AC003FE0FF0063E5FD00ADFB + FE00C2FDFF00C2FDFF00D4FDFF00D4FDFF00D4FDFF00FCFEFE003FE0FF0010D1 + FE0010D1FE003FE0FF0063E5FD00E4FDFE00E4FDFE00D4FDFF00ADFBFE008DF3 + FE0063E5FD003FE0FF0063E5FD002783AC00000000000000000000000000CB9A + 8200F3F3F300FFFFFF00FFFEFF00FFFDF80049AA4900029A03007ACE7F00D8EB + CC00D8EBCC0049AA4900029A0300029A0300029A0300FEEBD700FEEBD700FEE4 + CA00FECFC200A47874000000000000000000DFEFF9004BAFFF004BAFFF005DB2 + FC0061C6FE0061C6FE0061C6FE0061C6FE005DB2FC004BAFFF00399CFE00399C + FE005DB2FC00F0F6FD00FEF9F300F9F6F500F6EFE700F6EFE700F5EADF008D82 + A6008D82A600D1CDE40000000000000000000000000000000000000000000000 + 0000000000000000000000000000F1E3E200CDA6A000FDF6C600FDE8B700FED7 + AB00FDE8B700FDF6C600FEFED300FEFED300FEFFE100FEFFE100FEFFE100FEFE + D300FEFED300FEFED300BF989500F1E3E200458EB60066A6C30085AFCB0066A6 + C30066A6C300458EB600458EB6002783AC002783AC0066A6C3007BDDFE0010D1 + FE0010D1FE003FE0FF0037B4E0002783AC002783AC002783AC00458EB60066A6 + C30066A6C30085AFCB0085AFCB002783AC00000000000000000000000000DCA8 + 8700F3F3F300FFFFFF00FEFEFE00FFFEFF00D8EBCC00029A0300029A0300029A + 0300029A0300029A0300029A0300029A0300029A0300FEEBD700FEEBD700FEEB + D700F3B9B500A4787400000000000000000000000000DFEFF9004BAFFF004BAF + FF005DB2FC0061C6FE0061C6FE0061C6FE0061C6FE005DB2FC004BAFFF004BAF + FF00399CFE004BAFFF00F0F6FD00FEF9F300F9F6F500F8F0F00085AFCB005D71 + AB00BEC6DC000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000F1E3E200CDA6A000FDF6C600FDF6C600FDE8 + B700FDE8B700FDE8B700FDF6C600FEFED300FEFED300FEFED300FEFED300FEFE + D300FEFED300FDE8B700BA8E8500E6E5E400F0F6FD009BC3D800C0D9E600C0D9 + E600C0D9E600F2FAF500000000000000000000000000458EB600ADFBFE0010D1 + FE0010D1FE0010D1FE00059ACD00C7DDE100000000000000000000000000C0D9 + E600C0D9E600C0D9E6009BC3D800DFEFF900000000000000000000000000DCA8 + 8700F3F3F300FFFFFF00FFFEFF00FFFFFF00FFFDF80091DEA900029A0300029A + 0300029A0300029A0300029A03000EA31B00029A0300FEEBD700F3B9B500FCA3 + A200FCA3A200A478740000000000000000000000000000000000DFEFF9004BAF + FF004BAFFF004BAFFF0061C6FE0061C6FE0061C6FE0061C6FE005DB2FC004BAF + FF004BAFFF00399CFE005DB2FC00F0F6FD00F0FEFE0085AFCB005D71AB00BEC6 + DC00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000F8F0F000DAB4A000EDD9B700FEFFE100FEE4 + CA00FDE8B700FED7AB00FDE8B700FDE8B700FDF6C600FDF6C600FDF6C600FDF6 + C600FEFED300FED7AB00B4817600F8F0F0000000000000000000000000000000 + 00000000000000000000000000000000000000000000458EB600D1EFF90010D1 + FE0010D1FE0010D1FE000C7CAC00000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000DCA8 + 8700F8F8F800FFFFFF00FEFEFE00FFFFFF00FFFEFF00FEFEFE00DDEADD007ACE + 7F0049AA490049AA49007ACE7F00FEEBD700029A0300E2BDB300D6A89400DCA8 + 8700CB9A8200A47874000000000000000000000000000000000000000000D1EF + F9004BAFFF004BAFFF004BAFFF0061C6FE0061C6FE0061C6FE0061C6FE0061C6 + FE004BAFFF004BAFFF00399CFE005DB2FC0098A9EF003A80E000C0D9E6000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000D6BCBB00E2BDB300FFF8EE00FEFF + FC00FEF9F300FEE4CA00FDE8B700FDE8B700FDE8B700FDE8B700FDE8B700FDF6 + C600FDF6C600D6A89400C8ABAB00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000085AFCB00AFCFDE003FE0 + FF0010D1FE0004B8EA00458EB600000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000DCA8 + 8700FAFAFA00FFFFFF00FCFEFE00FFFFFF00FFFFFF00FFFEFE00FEFAF700FEFA + F700FFF8EE00FFF8EE00FEF4E900FEF4E900FEF4E900B4817600B4817600B481 + 7600B4817600A478740000000000000000000000000000000000000000000000 + 0000D1EFF9005DB2FC004BAFFF004BAFFF0061C6FE0061C6FE0070D2FD0061C6 + FE0061C6FE004BAFFF004BAFFF00399CFE00399CFE006682F100000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000ECEAEA00CDA6A000ECDACC00FFFF + FF00FFFFFF00FEE4CA00FDE8B700FED7AB00F3D1A300FED7AB00FDF6C600FDF6 + C600EDBD9200B481760000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000C7DDE10066A6C30084E9 + FE0010D1FE0004B8EA0085AFCB00000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000E3B1 + 8E00FFFDF800FFFEFF00FFFFFF00FFFFFF00FFFEFF00FFFFFE00FFFEFF00FFFF + FF00FFFDF800FDFAFA00FEF9F300FEF9F300FFF8EE00B4817600FCB04C00DCA8 + 8700CB9A8200E4D1CD0000000000000000000000000000000000000000000000 + 000000000000000000005DB2FC004BAFFF004BAFFF005DB2FC0061C6FE0061C6 + FE0061C6FE0061C6FE004BAFFF004493ED003A80E0006682F100000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000DED7D300CDA6A000EADB + D400FCFEFE00FFF8EE00FDF6C600FDF6C600FDF6C600FEFED300FDE8B700EDBD + 9200BA8E8500DFDFDF0000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000002783AC00C2FD + FF0010D1FE00059ACD00C0D9E600000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000E3B1 + 8E00FEFEFE00FFFEFE00FFFFFE00FFFFFF00FFFFFF00FEFEFE00FFFFFE00FFFF + FE00FFFEFF00FFFDF800FFFDF800FEF9F300FEF9F300B4817600DCA88700CB9A + 8200ECDACC000000000000000000000000000000000000000000000000000000 + 00000000000000000000F0F6FD004BAFFF004BAFFF004BAFFF005DB2FC0070D2 + FD009AE3FF00D1EFF9007C7FCC0002019A000732DE006682F100000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000EADBD400BA8E + 8500D6A89400EDD9B700FDE8B700FDF6C600FDE8B700E3D3AA00D6A89400BF98 + 9500F1E3E2000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000458EB600DFEF + F9003FE0FF000C7CAC0000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000E3B1 + 8E00FFFFFE00FCFEFB00FFFCFF00F8FBFB00FAFAFA00FAFAFA00F9F6F500F9F6 + F500F3F3F300EFEFEF00EFEFEF00ECEAEA00ECEAEA00B4817600DCA88700EADB + D400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000F0FEFE00ACDBF400BEE6F500F0F6FD000000 + 000000000000000000007C7FCC0002019A00295AF7006682F100000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FAF3 + F200CABCB700BA8E8500B4817600BA8E8500BF989500CC9A9900D6BCBB000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000066A6C300AFCF + DE0060D4F000458EB60000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 + 8700DCA88700DCA88700DCA88700DCA88700DCA88700B4817600F3E3D1000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000BEC6DC008D82A6008D82A600D1CDE400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000002783 + AC000C7CAC00AFCFDE0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000D0E2CE00C0D5C200C7C7 + C700C0D5C200C0D5C200EFEFEF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000EFF9F000C0D5C200C7C7 + C700C0D5C200C0D5C200DDEADD00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000E1F1E1007DA97200267D27000450070005710A000571 + 0A0005710A000450070004500700255E2800A8A8A80000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000A1C79E00267D27000450070005710A000571 + 0A0005710A000450070004500700255E2800668E6700DDEADD00000000000000 + 000000000000000000000000000000000000000000000000000000000000A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 7400A47874008C5D5C000000000000000000CC670100CC670100CC670100CC67 + 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 + 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 + 0100CC670100CC670100CC670100000000000000000000000000000000000000 + 0000000000008DBC8B0005710A000F8319000EA31B0016B4320009B2190009B2 + 190009B2190009B21900029A03000F83190004500700255E2800D1D1D1000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000D0E2CE000F83190005710A0018992E0009B2190009B2190009B2 + 190009B2190009B2190009B21900029A030005710A0004500700879185000000 + 000000000000000000000000000000000000000000000000000000000000A478 + 7400E2BDB300F3B9B500F3B9B500F3B9B500F3B9B500F3B9B500F3B9B500F3B9 + B500F3B9B500F3B9B500F3B9B500E2BDB300F3B9B500D5B3AF00F3B9B500F3B9 + B500E3B18E008C5D5C000000000000000000CC670100FFFFFE00FFFFFF00FEFA + F700FEF9F300FFF8EE00FEF4E900FEF0E200FEF0E200FEEBD700FEEBD700FEEB + D700FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7 + AB00FED7AB00FED7AB00CC67010000000000000000000000000000000000EFF9 + F00049AA490005710A0016B4320016B4320016B4320016B4320016B4320009B2 + 190009B2190009B2190009B2190009B2190009B2190005710A0004500700A8A8 + A800000000000000000000000000000000000000000000000000000000000000 + 0000A1C79E0005710A0018992E0016B4320016B4320016B4320016B4320009B2 + 190009B2190009B2190009B2190009B2190009B21900029A030004500700668E + 670000000000000000000000000000000000000000000000000000000000A478 + 7400DED2CA00FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDD + BB00FEDDBB00FEDDBB00FEDDBB00FED0B700FED7AB00FED7AB00F3D1A300FECC + 9A00FECFC2008C5D5C000000000000000000CC670100FFFFFE00FFFFFF00FFFF + FF00FEF9F300FEF4E900FEF0E200FEF0E200FEF0E200FEEBD700FEE4CA00FEE4 + CA00FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FED7AB00FED7AB00FED7 + AB00FED7AB00FED0B700CC6701000000000000000000000000000000000068A7 + 62000F83190025BB4F0025BB4F0016B4320016B4320016B4320016B4320016B4 + 320016B4320009B2190009B2190009B2190009B2190009B21900029A03000450 + 0700B9B9B900000000000000000000000000000000000000000000000000A1C7 + 9E000F83190016B4320025BB4F0025BB4F0016B4320016B4320016B4320016B4 + 320016B4320009B2190009B2190009B2190009B2190009B21900029A03000450 + 0700668E6700000000000000000000000000000000000000000000000000A478 + 7400DAD9D900FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDD + BB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00F3D1 + A300FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFFFE00FFFF + FF00999697009996970099969700FEF4E900FEF4E900FEF0E200999697009996 + 970099969700FEE4CA00FEE4CA00FEE4CA00999697009996970099969700FED7 + AB00FEDDBB00FED7AB00CC6701000000000000000000000000008DBC8B000F83 + 190025BB4F0025BB4F0025BB4F0025BB4F0025BB4F0016B4320030C36900EFF9 + F000EFF9F00047CE710009B2190009B2190009B2190009B2190009B21900029A + 030004500700DDEADD0000000000000000000000000000000000E1F1E1000F83 + 190025A63D0025BB4F0025BB4F0025BB4F0025BB4F0016B4320047CE7100F2FA + F500F2FAF50039C3390016B4320009B2190009B2190009B2190009B219000EA3 + 1B00045007009F9F9F000000000000000000000000000000000000000000B481 + 7600DED7D300FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4 + CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7 + AB00FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFFFF00FFFF + FE00FFFFFF00FFFFFF00FFFDF800FEF9F300FFF8EE00FFF8EE00F6EFE700F6EF + E700F3E3D100FEE4CA00FEEBD700FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDD + BB00FEDDBB00FEDDBB00CC6701000000000000000000DDEADD000F83190025BB + 4F0030C3690025BB4F0025BB4F0025BB4F0025BB4F0047CE7100EFF9F000FFFF + FE00FEFEFE0091DEA90016B4320016B4320009B2190009B2190009B2190009B2 + 190005710A00668E67000000000000000000000000000000000049AA49001899 + 2E0030C3690030C3690025BB4F0025BB4F0025BB4F0025BB4F0091DEA900FEFE + FE00FFFFFF00F2FAF50030C3690016B4320009B2190009B2190009B2190009B2 + 19000EA31B0004500700F3F3F30000000000000000000000000000000000B481 + 7600DAD9D900FEF0E200FEEBD700FEEBD700FEEBD700FEEBD700FEE4CA00FEE4 + CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7 + AB00FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFEFF00FFFF + FF004571FA004571FA004571FA00FFFCFB00FEFAF700F6EFE700A23F0800A23F + 0800A23F0800FEEBD700FEEBD700FEE4CA00059ACD00059ACD00059ACD00FEDD + BB00FEDDBB00FEDDBB00CC67010000000000000000007ACE7F0018992E0030C3 + 690030C3690030C3690030C3690030C3690047CE7100F2FAF500FFFFFF00FCFE + FE00EFF9F00025BB4F0016B4320016B4320016B4320016B4320009B2190009B2 + 190009B2190004500700DDEADD000000000000000000D9F3E2000F83190030C3 + 690030C3690030C3690030C3690030C3690025BB4F0025BB4F0047CE7100EFF9 + F000FFFFFF00FCFEFE00F8F8F80039C3390016B4320016B4320009B2190009B2 + 190009B2190005710A007DA9720000000000000000000000000000000000B481 + 7600DFDFDF00FEF0E200FEF0E200FEEBD700FEEBD700A9ACD400EADBD400FEE4 + CA00FEE4CA00FEDDBB00CCC0CC00FEDDBB00FEDDBB00FED7AB00FEDDBB00FED7 + AB00FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFFFE00FFFF + FF004571FA006682F1004571FA00FFFFFF00FEFAF700FEF9F300A23F0800A23F + 0800A23F0800F3E3D100FEEBD700FEEBD700059ACD00059ACD00059ACD00FEDD + BB00FEDDBB00FEDDBB00CC670100000000000000000018992E0025BB4F0030C3 + 690030C3690030C3690030C3690047CE7100F8FBFB00FFFFFF00FEFFFC00F2FA + F50047CE710025BB4F0016B4320016B4320016B4320016B4320016B4320009B2 + 190009B2190005710A007DA9720000000000000000007ACE7F0018992E0030C3 + 690030C3690030C3690030C3690030C3690030C3690025BB4F0025BB4F0047CE + 7100F2FAF500FFFEFF00FFFFFF00EFF9F00030C3690016B4320016B4320009B2 + 190009B219000EA31B00255E280000000000000000000000000000000000B481 + 7600E1E0E000FEF4E900FEF0E200FEF0E20098A9EF000335FB00295AF700EADB + D400FEE4CA0098A9EF000335FB006682F100FED0B700FEDDBB00FEDDBB00FED7 + AB00FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFEFF00FFFF + FF004571FA004571FA004571FA00FFFFFF00FEFEFE00F8F8F800A23F0800A23F + 0800A23F0800FEF0E200FEF0E200FEEBD700059ACD00059ACD00059ACD00FEE4 + CA00FEE4CA00FEE4CA00CC67010000000000E1F1E100029A030030C3690030C3 + 690030C3690030C3690047CE7100F2FAF500FFFFFF00FFFFFF00F8FBFB0047CE + 710025BB4F0025BB4F0025BB4F0016B4320016B4320016B4320016B4320016B4 + 320016B432000F831900448A3E00000000000000000049AA490025BB4F0030C3 + 690030C3690030C3690030C3690030C3690030C3690030C3690030C3690030C3 + 690047CE7100F2FAF500FCFEFE00FFFFFE00F2FAF50030C3690016B4320016B4 + 320016B4320009B2190004500700DDEADD00000000000000000000000000BA8E + 8500E6E5E400FEF4E900FEF4E900E2D6E2000335FB000335FB000335FB00295A + F70098A9EF000335FB000335FB000335FB00A9ACD400FEDDBB00FEDDBB00FEDD + BB00FECFC2008C5D5C000000000000000000CC670100FFFFFF00FFFFFF00FFFF + FE00FFFEFF00FCFEFE00FEFFFC00FFFFFF00FFFEFF00FFFDF800FEF9F300FFF8 + EE00FEF4E900FEF0E200FEF0E200FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4 + CA00FEE4CA00FEE4CA00CC67010000000000BBE5B9000EA31B0030C3690030C3 + 690030C3690058E08700F9F6F500FCFEFE00FFFFFE00FFFFFE00AFE6BF0091DE + A90091DEA90091DEA90091DEA90091DEA90091DEA90091DEA90047CE710016B4 + 320016B432000EA31B0005710A0000000000000000000EA31B0025BB4F0030C3 + 690030C3690058E08700AFE6BF0091DEA90091DEA90091DEA90091DEA90091DE + A90091DEA900AFE6BF00FFFFFF00FFFEFF00FFFFFF00F2FAF50030C3690016B4 + 320016B4320016B4320005710A00C0D5C200000000000000000000000000BA8E + 8500E6E5E400FFF8EE00FEF4E900FEF4E90098A9EF000335FB000335FB000335 + FB000335FB000335FB000335FB006682F100FEDDBB00FEE4CA00FEDDBB00FEDD + BB00FED6C900986B66000000000000000000CC670100FFFFFF00FFFFFF00FFFF + FF00B5B3B300B5B3B300B5B3B300FFFFFE00FFFFFE00FFFFFF00B5B3B300B5B3 + B300AFAFAF00FFF8EE00FEF4E900FEF0E200AFAFAF00AFAFAF00B9AAA600FEE4 + CA00FEE4CA00FEE4CA00CC67010000000000BBE5B9000EA31B0030C3690030C3 + 690047CE7100F2FAF500FFFFFF00FFFFFE00FCFEFE00FFFFFF00FFFFFF00FFFE + FF00FFFFFF00FFFEFF00FCFEFE00FFFFFF00FFFEFF00FEFFFC0091DEA90016B4 + 320016B432000EA31B0005710A000000000000000000029A030030C3690030C3 + 690030C3690091DEA900FFFFFF00FFFEFF00FEFEFE00FFFFFF00FFFFFF00FEFE + FE00FFFFFF00FFFEFF00FFFFFF00FFFEFF00FFFFFF00FEFEFE00F2FAF50030C3 + 690025BB4F0016B4320005710A00C0D5C200000000000000000000000000BA8E + 8500E6E5E400FEF9F300FFF8EE00FEF4E900FEF4E900BEC6DC000335FB000335 + FB000335FB000335FB006682F100FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDD + BB00FECFC200986B66000000000000000000CC670100FFFFFF00FFFFFF00FFFF + FF00FEFEFE00FFFFFF00FFFFFE00FFFEFF00FFFFFF00FFFFFE00FFFFFF00FFFF + FF00FEF9F300FFF8EE00FFF8EE00FFF8EE00FEF4E900FEF4E900FEEBD700FEEB + D700FEEBD700FEEBD700CC67010000000000BBE5B9000EA31B0030C3690030C3 + 690058E08700F0F6FD00FFFFFF00FCFEFE00FFFEFF00FFFEFF00FFFEFF00FFFF + FF00FEFEFE00FFFEFF00F9FFFE00F9FFFE00FFFFFF00FFFFFF0091DEA90025BB + 4F0016B4320016B4320005710A000000000000000000029A030030C3690030C3 + 690030C3690091DEA900FBFBFC00FCFEFE00FFFFFF00F9FFFE00FCFEFE00FFFF + FF00FFFFFF00FFFFFF00FCFEFE00FFFEFF00FCFEFE00FFFFFF00D9F3E20025BB + 4F0016B4320016B432000F831900C0D5C200000000000000000000000000CB9A + 8200ECEAEA00FEFAF700FEF9F300FFF8EE00FFF8EE0098A9EF000335FB000335 + FB000335FB000335FB00295AF700EADBD400FEE4CA00FEE4CA00FEE4CA00FEDD + BB00FED6C900986B66000000000000000000CC670100FFFFFF00FFFFFF00FCFE + FE00CC9A9900CC9A9900CC9A9900FFFEFF00FEFFFC00FFFFFF00E27E0300E27E + 0300E27E0300FEF9F300FEFAF700FEF4E900029A0300029A0300029A0300FEEB + D700FEEBD700FEEBD700CC67010000000000BBE5B90009B2190030C3690030C3 + 690030C3690047CE7100F3F3F300FFFEFF00FFFFFF00FCFEFE00D9F3E20091DE + A90091DEA90091DEA900AFE6BF0091DEA90091DEA90091DEA90047CE710025BB + 4F0025BB4F0025A63D002A8C4300000000000000000016B4320030C3690030C3 + 690030C3690058E08700AFE6BF0091DEA90091DEA900AFE6BF0091DEA90091DE + A90091DEA900D9F3E200FFFFFF00FFFEFF00FFFFFF00D9F3E20030C3690025BB + 4F0025BB4F0025BB4F0005710A00C0D5C200000000000000000000000000CB9A + 8200EFEFEF00FFFDF800FEFAF700FEF9F30098A9EF000335FB000335FB000335 + FB000335FB000335FB000335FB00295AF700EADBD400FEE4CA00FEE4CA00FEE4 + CA00FED6C900986B66000000000000000000CC670100FFFFFF00FFFFFF00FFFF + FF00CC9A9900CC9A9900CC9A9900FFFFFF00FFFEFF00FCFEFE00E27E0300E27E + 0300E27E0300FBFBFC00FEFAF700FFF8EE00029A0300029A0300029A0300FEF0 + E200FEF0E200FEF0E200CC67010000000000EFF9F000029A030047CE710047CE + 710030C3690030C3690058E08700F0F6FD00FFFEFF00FFFFFF00FFFFFF0091DE + A90030C3690030C3690030C3690030C3690030C3690030C3690025BB4F0025BB + 4F0025BB4F0018992E0049AA4900000000000000000039C3390039C3390047CE + 710030C3690030C3690030C3690030C3690030C3690030C3690030C3690030C3 + 690091DEA900F9FFFE00FFFEFF00FEFEFE00D9F3E20030C3690030C3690025BB + 4F0025BB4F0025BB4F0005710A0000000000000000000000000000000000CB9A + 8200EFEFEF00FFFEFE00FDFAFA00DFEFF9000335FB000335FB000335FB006682 + F100D1CDE4000335FB000335FB000335FB0098A9EF00FEE4CA00FEE4CA00FEE4 + CA00FECFC200986B66000000000000000000CC670100FFFFFF00FFFFFF00FFFF + FE00CC9A9900CC9A9900CC9A9900FFFFFE00FFFFFF00FFFFFF00E27E0300E27E + 0300E27E0300FEFFFC00FFFEFF00FEFAF700029A0300029A0300029A0300FEF0 + E200FEF0E200FEF0E200CC670100000000000000000039C3390047CE71007ACE + 7F0047CE710030C3690030C3690047CE7100FCFEFB00FCFEFE00FFFFFF00FCFE + FE0091DEA90030C3690030C3690030C3690030C3690030C3690030C3690030C3 + 690025BB4F000F831900A1C79E00000000000000000091DEA90016B432007ACE + 7F0047CE710047CE710030C3690030C3690030C3690030C3690030C3690091DE + A900FFFFFE00FFFFFF00FCFEFE00D9F3E20030C3690030C3690030C3690030C3 + 690025BB4F0018992E0049AA490000000000000000000000000000000000CB9A + 8200F3F3F300FFFFFE00FEFEFE00FEFEFE0098A9EF000335FB006682F100FEF4 + E900FEF4E900D1CDE4000335FB006682F100FEEBD700FEEBD700FEEBD700FEE4 + CA00FECFC200986B66000000000000000000CC670100FFFFFF00FFFFFF00FFFF + FF00FEFEFE00FFFEFE00FFFFFF00FFFEFF00FFFFFE00FFFEFF00FFFEFF00FFFF + FE00FFFEFF00FFFFFF00FFFFFF00FDFAFA00FEFAF700FFF8EE00FEF4E900FEF0 + E200FEF0E200FEF0E200CC670100000000000000000091DEA90009B2190091DE + A9007ACE7F0058E0870047CE710030C3690051B49400F8FBFB00FFFCFF00FFFE + FF00FFFFFF0047CE710030C3690030C3690030C3690030C3690030C3690030C3 + 690025BB4F000F831900EFF9F0000000000000000000EFF9F00009B219007ACE + 7F0091DEA90058E0870047CE710030C3690030C3690030C3690058E08700FBFB + FC00FEFEFE00FFFEFF00D9F3E20047CE710030C3690030C3690030C3690030C3 + 690030C369000F831900AFD0B00000000000000000000000000000000000DCA8 + 8700F3F3F300FCFEFE00FFFEFF00FFFCFB00FEFAF700CED7FA00FFF8EE00FAF3 + F200FEF4E900FEF4E900E2D6E200FEF0E200FEEBD700FEEBD700FEEBD700FEEB + D700F3B9B500A47874000000000000000000CC670100FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FEFEFE00FFFFFF00FFFEFF00FFFFFF00FFFFFE00FFFF + FF00FFFFFF00FFFEFF00FEFFFC00FEFAF700FEF9F300FFF8EE00FEF4E900FEF0 + E200FEF0E200FEF0E200CC67010000000000000000000000000039C3390047CE + 710091DEA90091DEA9007ACE7F0058E0870030C3690058E08700F0FEFE00FFFF + FF00FBFBFC0058E0870030C3690030C3690030C3690030C3690030C3690030C3 + 69000F831900AFD0B000000000000000000000000000000000007ACE7F0016B4 + 320091DEA90091DEA90058E087007ACE7F0047CE710030C369007ACE7F00FFFE + FF00FEFEFE00D9F3E20047CE710030C3690030C3690030C3690030C3690030C3 + 690025A63D0049AA49000000000000000000000000000000000000000000DCA8 + 8700F9F6F500FFFFFF00FFFFFF00FFFFFF00FEFEFE00FFFDF800FEFAF700FFF8 + EE00FFF8EE00FEF4E900FEF4E900FEF0E200FEF0E200FEEBD700F3B9B500FCA3 + A200FCA3A200A47874000000000000000000CC670100E27E0300E27E0300E27E + 0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E + 0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E0300E27E + 0300E27E0300E27E0300CC670100000000000000000000000000D8EBCC0009B2 + 190091DEA90091DEA90091DEA9007ACE7F0058E0870047CE710051B49400AFE6 + BF00AFE6BF0030C3690030C3690030C3690030C3690030C3690030C369001899 + 2E0049AA490000000000000000000000000000000000000000000000000039C3 + 390039C33900AFE6BF0091DEA90091DEA90058E0870047CE710047CE710091DE + A900AFE6BF0047CE710030C3690030C3690030C3690030C3690030C3690025BB + 4F000F831900D9F3E2000000000000000000000000000000000000000000DCA8 + 8700F8F8F800FFFEFF00FFFFFF00FFFEFF00FFFFFF00FFFEFF00FFFDF800FEFA + F700FFF8EE00FFF8EE00FEF4E900FEF4E900FEF4E900E2BDB300D6A89400DCA8 + 8700CB9A8200A47874000000000000000000D3936400CC670100CC670100CC67 + 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 + 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 + 0100CC670100CC670100CC6701000000000000000000000000000000000091DE + A90009B2190091DEA900BBE5B90091DEA90091DEA9007ACE7F0047CE710047CE + 710030C3690030C3690030C3690030C3690030C3690030C369000EA31B0025A6 + 3D00EFF9F000000000000000000000000000000000000000000000000000EFF9 + F00039C3390039C33900BBE5B90091DEA90091DEA9007ACE7F0058E0870051B4 + 940030C3690030C3690030C3690030C3690030C3690030C3690025BB4F00029A + 0300A1C79E00000000000000000000000000000000000000000000000000E3B1 + 8E00FAFAFA00FFFFFF00FFFFFF00FFFEFE00FFFFFF00FFFFFF00FFFEFE00FFFD + F800FEFAF700FEF9F300FFF8EE00FEF4E900FEF4E900B4817600B4817600B481 + 7600B4817600A47874000000000000000000F3E3D100C56E2600CC670100CC67 + 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 + 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 + 0100CC670100CC670100EAC8A100000000000000000000000000000000000000 + 0000BBE5B90009B2190047CE7100BBE5B900AFE6BF0091DEA90091DEA90058E0 + 870047CE710030C3690030C3690030C3690025BB4F000EA31B0025A63D00EFF9 + F000000000000000000000000000000000000000000000000000000000000000 + 0000EFF9F00039C3390039C3390091DEA900BBE5B90091DEA90091DEA90058E0 + 870058E0870030C3690030C3690030C3690030C3690016B432000EA31B00AFD0 + B00000000000000000000000000000000000000000000000000000000000E3B1 + 8E00FBFBFC00FFFFFF00FFFEFF00FFFFFE00FFFEFF00FFFFFE00FFFFFF00FFFF + FF00FFFDF800FFFDF800FEFAF700FFF8EE00FFF8EE00B4817600FCB04C00DCA8 + 8700CB9A8200E4D1CD0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000E1F1E10047CE710009B2190039C339007ACE7F007ACE7F007ACE + 7F007ACE7F0030C3690025BB4F000EA31B000EA31B007ACE7F00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000007ACE7F0009B2190039C339007ACE7F007ACE7F007ACE + 7F007ACE7F0047CE710025BB4F0016B43200029A030047CE7100E1F1E1000000 + 000000000000000000000000000000000000000000000000000000000000E3B1 + 8E00FEFEFE00FFFFFF00FFFFFE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FEFE + FE00FFFFFF00FFFDF800FDFAFA00FEF9F300FEF9F300B4817600DCA88700CB9A + 8200EADBD4000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000D9F3E2007ACE7F0039C3390009B2190009B2 + 190009B2190039C3390039C3390091DEA900EFF9F00000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000EFF9F00091DEA90039C3390039C3390009B2 + 190009B2190009B2190039C3390091DEA900E1F1E10000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000E3B1 + 8E00FCFEFE00FCFEFE00FEFEFE00FBFBFC00FAFAFA00F8F8F800F8F8F800F3F3 + F300F3F3F300F3F3F300EFEFEF00ECEAEA00F6EFE700B4817600DCA88700EADB + D400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 + 8700DCA88700DCA88700DCA88700DCA88700DCA88700B4817600F3E3D1000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FAF3F200D6A89400D6A89400F1E3E20000000000000000000000 + 0000000000000000000000000000FAF3F200DAB4A000D6A89400FAF3F2000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000A4787400A4787400A4787400A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 7400A47874008C5D5C0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000F3F3F300A23F0800A23F0800AF4B0200A23F0800DAB4A000000000000000 + 00000000000000000000EADBD400A23F0800AF4B0200AF4B0200A23F0800EADB + D400000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000A4787400A4787400A4787400A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 7400A4787400A47874008C5D5C00000000000000000000000000000000000000 + 000000000000000000000000000000000000A4787400D8C5B500FECFC200FECF + C200FECFC200FECFC200FECFC200FECFC200FECFC200FECFC200FECFC200FECF + C200FECFC2008C5D5C0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000D3936400AF4B0200AF4B0200A23F0800AF4B0200A23F0800EADBD4000000 + 000000000000F5EADF00A23F0800AF4B0200A23F0800AF4B0200BD580100BD79 + 5800000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000B4817600DBC9C600FECFC200FECF + C200FECFC200FECFC200FECFC200FECFC200FECFC200FECFC200FECFC200FECF + C200FECFC200FECFC2008C5D5C00000000000000000000000000000000007ECB + E60041B3DA0041B3DA0041B3DA0041B3DA00A4787400DBC9C600F6EFE700F6EF + E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF + E700FEDDBB008C5D5C00000000000000000000000000059ACD00059ACD00D1EF + F900000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000B3664100BD580100CB9A8200F8F3EC00BD795800AF4B0200BD7958000000 + 000000000000B4817600AF4B0200BD79580000000000BD795800BD580100AB56 + 2900000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000B4817600D8C5B500F6EFE700F6EF + E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF + E700F6EFE700FEDDBB008C5D5C000000000000000000000000007ECBE6001DA6 + D50060D4F00071EBF90071EBF90071EBF900B4817600E5CDBE00F6EFE700FEDD + BB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00FED7AB00F6EF + E700FEDDBB00986B6600000000000000000000000000059ACD0064C1E1004BBD + E000059ACD0041B3DA007ECBE600BEE6F500F0F6FD0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000B3664100AF4B0200E2BDB30000000000F1E3E200AF4B0200AF4B02000000 + 000000000000AB562900AF4B02000000000000000000E2BDB300AF4B0200AB56 + 2900000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000B4817600E5CDBE00F6EFE700F6EF + E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF + E700F6EFE700FEDDBB008C5D5C0000000000000000000000000041B3DA008DF3 + FE0070D2FD0070D2FD0070D2FD0070D2FD00B4817600DED2CA00F6EFE700FECC + 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00F6EF + E700FEDDBB008C5D5C00000000000000000000000000059ACD004BBDE000D1EF + F90070D2FD0056C6F00037B4E0001DA6D500059ACD002EACD80064C1E100BEE6 + F500DFEFF9000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000BD795800BD580100BD79580000000000F8F3EC00AF4B0200AF4B02000000 + 000000000000AF4B0200AF4B02000000000000000000BD795800CC670100BD79 + 5800000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000BA8E8500E5CDBE00F6EFE700FEE4 + CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7 + AB00F6EFE700FEDDBB008C5D5C0000000000000000000000000041B3DA008DF3 + FE0070D2FD0070D2FD0070D2FD0070D2FD00BA8E8500DED2CA00F6EFE700F6EF + E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF + E700FEDDBB00986B6600000000000000000000000000059ACD00059ACD00F0F6 + FD007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE0056C6F0004BBDE0001DA6 + D500059ACD001DA6D50064C1E10090D1F100D1EFF90000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000E5CDBE00AF4B0200AF4B0200BD795800BD795800BD580100AF4B0200F1E3 + E20000000000A23F0800BD580100BD795800BD795800BD580100AF4B0200DAB4 + A000000000000000000000000000000000000000000000000000A4787400A478 + 7400A4787400A4787400A4787400A4787400BA8E8500DED2CA00F6EFE700FECC + 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC + 9A00F6EFE700FEDDBB008C5D5C0000000000000000000000000041B3DA008DF3 + FE007BDDFE007BDDFE007BDDFE007BDDFE00BA8E8500ECDACC00F6EFE700FEEB + D700FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00F6EF + E700FEDDBB00986B6600000000000000000000000000059ACD0056C6F0009EDE + EE009AE3FF007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE007BDDFE007BDD + FE0070D2FD003A80E00037B4E00037B4E000059ACD001DA6D500ACDBF4000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000BD795800AF4B0200CC670100CC670100CC670100AF4B0200DAB4 + A000E5CDBE00AF4B0200CC670100BD580100CC670100BD580100BD7958000000 + 0000000000000000000000000000000000000000000000000000A4787400FED6 + C900FED6C900FED6C900FED6C900FED6C900BA8E8500E4D1CD00F6EFE700F6EF + E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700FEF0E200F6EF + E700F6EFE700FEDDBB00986B660000000000000000000000000041B3DA0099FD + FE007BDDFE007BDDFE007BDDFE007BDDFE00CB9A8200EADBD400F6EFE700FECC + 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00F6EF + E700FEDDBB00986B6600000000000000000000000000059ACD0070D2FD004BBD + E000D4FDFF0084E9FE0084E9FE0084E9FE0084E9FE0084E9FE0071EBF9007BDD + FE00295AF7000335FB004493ED0084E9FE0084E9FE0056C6F00037B4E0000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000CB9A8200A23F0800A23F0800A23F0800A23F0800BD79 + 5800B4817600A23F0800A23F0800A23F0800A23F0800BA8E8500FAF3F2000000 + 0000000000000000000000000000000000000000000000000000A4787400F6EF + E700F6EFE700F6EFE700F6EFE700F6EFE700CB9A8200ECDACC00F6EFE700FED7 + AB00FED7AB00FED7AB00FED7AB00FED7AB00FED7AB00FED7AB00F3D1A300F3D1 + A300F6EFE700FEDDBB00986B660000000000000000000000000041B3DA0099FD + FE0084E9FE0084E9FE0084E9FE0084E9FE00CB9A8200EADBD400F6EFE700F6EF + E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF + E700FEDDBB00986B6600000000000000000000000000059ACD0090D1F1002EAC + D800F9FFFE0084E9FE008DF3FE008DF3FE008DF3FE0084E9FE008DF3FE004571 + FA000335FB000335FB00295AF7008DF3FE008DF3FE0061C6FE0060D4F000BEE6 + F500000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000B4817600AB562900826A + 5B00826A5B00B3664100BD795800000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000A4787400F6EF + E700F6EFE700F6EFE700F6EFE700F8F3EC00CB9A8200EADBD400F6EFE700FECC + 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC + 9A00F6EFE700FEDDBB00986B660000000000000000000000000041B3DA00ADFB + FE0084E9FE0084E9FE0084E9FE0084E9FE00CB9A8200EFE4D800F9F6F500FEDD + BB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00F6EF + E700FEDDBB00A4787400000000000000000000000000059ACD0070D2FD0037B4 + E000ACDBF400ADFBFE008DF3FE008DF3FE008DF3FE0099FDFE004571FA000335 + FB000335FB000335FB000335FB007BDDFE008DF3FE0061C6FE0099FDFE004BBD + E000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000F6EFE700826A5B00927D + 7000B1A09700826A5B00DED7D300000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000B4817600F6EF + E700FEDDBB00FEDDBB00FEDDBB00FED7AB00CB9A8200EFE4D800F6EFE700F6EF + E700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EFE700F6EF + E700F6EFE700FEDDBB00A478740000000000000000000000000041B3DA00ADFB + FE008DF3FE0084E9FE008DF3FE0084E9FE00DCA88700EFE4D800F9F6F500FECC + 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00F6EF + E700FEDDBB00A4787400000000000000000000000000059ACD009AE3FF0056C6 + F00064C1E100D4FDFF0099FDFE0099FDFE0099FDFE004571FA000335FB000335 + FB005DB2FC00295AF7000335FB005DB2FC0099FDFE0070D2FD00C2FDFF004BBD + E000DFEFF9000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000C3C2C200826A5B00F1E3 + E200C4C4C400826A5B00A4968E00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000B4817600F6EF + E700FECC9A00FECC9A00FECC9A00FECC9A00DCA88700EFE4D800F9F6F500FEDD + BB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDD + BB00F6EFE700FEDDBB00A478740000000000000000000000000041B3DA00ADFB + FE008DF3FE008DF3FE008DF3FE008DF3FE00DCA88700F5EADF00FFFEFE00FFFF + FF00FFFCFB00FEFAF700FFF8EE00FEF4E900FEF4E900FEF0E200FEEBD700FEE4 + CA00FED0B700A4787400000000000000000000000000059ACD009AE3FF0061C6 + FE0037B4E000F0FEFE0099FDFE00ADFBFE00399CFE000335FB000335FB005DB2 + FC0099FDFE004BAFFF000335FB004571FA0099FDFE0061C6FE00C2FDFF00ADFB + FE0064C1E1000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000ECEAEA00826A5B00CABCB700B1A0 + 9700826A5B00B9AAA600826A5B00DED7D3000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000B4817600F6EF + E700F6EFE700F6EFE700F6EFE700F6EFE700DCA88700EFE4D800F9F6F500FECC + 9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC9A00FECC + 9A00F6EFE700FEDDBB00A478740000000000000000000000000041B3DA00C2FD + FF008DF3FE0099FDFE008DF3FE0099FDFE00E3B18E00F5EADF00FFFFFF00FEFE + FE00FFFFFF00FFFCFF00FEF9F300FEF9F300FFF8EE00FEF0E200F3E3D100F3B9 + B500FCA3A200B48176000000000000000000000000001DA6D5009AE3FF0070D2 + FD004BBDE0009EDEEE00F0FEFE00D4FDFF0090D1F100295AF7005DB2FC00C2FD + FF00ADFBFE009AE3FF000335FB000335FB00ADFBFE0061C6FE00D4FDFF00D4FD + FF004BBDE000F0FEFE0000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000A4968E00B9AAA600B9B9B900826A + 5B00927D7000B9AAA600C8ABAB00927D70000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BA8E8500F8F3 + EC00FEDDBB00FEDDBB00FEDDBB00FEDDBB00DCA88700F5EADF00FFFFFF00FFFF + FE00FFFFFF00FDFAFA00FEFAF700FFF8EE00FEF4E900FEF4E900FEF0E200FEF0 + E200F6EFE700FEDDBB00A478740000000000000000000000000041B3DA00C2FD + FF0099FDFE0099FDFE0099FDFE0099FDFE00E3B18E00FEF0E200FFFEFF00FFFE + FF00FFFFFE00FFFFFF00FFFCFB00FEFAF700FFF8EE00FFF8EE00B4817600B481 + 7600B4817600B48176000000000000000000000000001DA6D5009AE3FF007BDD + FE007BDDFE004BBDE0004BBDE0004BBDE0004BBDE000ACDBF400D1EFF900F0FE + FE00C2FDFF00C2FDFF00295AF7000335FB005DB2FC0061C6FE00E4FDFE00E4FD + FE00BEE6F5007ECBE60000000000000000000000000000000000000000000000 + 0000000000000000000000000000ECEAEA00826A5B00CCCACA00A4968E00C6B8 + AB00DED7D300927D7000C0C0C000927D7000DED7D30000000000000000000000 + 0000000000000000000000000000000000000000000000000000BA8E8500F8F3 + EC00FECC9A00FECC9A00FECC9A00FECC9A00E3B18E00F5EADF00FFFEFF00FFFE + FF00FFFFFE00FFFEFF00FEFAF700FEF9F300FFF8EE00FEF4E900FEF4E900FEE4 + CA00F3B9B500FCA3A200B481760000000000000000000000000041B3DA00D4FD + FF0099FDFE0099FDFE0099FDFE0099FDFE00EDBD9200FEF0E200FFFFFE00FFFE + FF00FFFFFF00FFFFFE00FFFFFF00FCFEFE00FEFAF700FFF8EE00B4817600FCC4 + 7C00DCA88700E2BDB3000000000000000000000000001DA6D5009AE3FF0084E9 + FE0084E9FE0084E9FE0084E9FE0084E9FE007BDDFE0060D4F00037B4E00064C1 + E100F8FBFB00E4FDFE0098A9EF000335FB00295AF70070D2FD00F0FEFE00F0FE + FE00F0FEFE004BBDE00000000000000000000000000000000000000000000000 + 0000000000000000000000000000B9AAA600B9AAA600C7C7C700927D70000000 + 000000000000A18C8200B1A09700B9AAA600B1A0970000000000000000000000 + 0000000000000000000000000000000000000000000000000000CB9A8200F9F6 + F500FEF9F300FEF9F300FEF4E900FEF4E900E3B18E00F5EADF00FFFFFF00FCFE + FE00FFFFFF00FFFEFF00FEFFFC00FFFCFB00FEF9F300FFF8EE00FFF8EE00B481 + 7600B4817600B4817600B481760000000000000000000000000041B3DA00D4FD + FF0099FDFE00ADFBFE0099FDFE00ADFBFE00EDBD9200FEF4E900FFFFFE00FEFE + FE00FBFBFC00FBFBFC00FAFAFA00FAFAFA00F9F6F500F8F3EC00B4817600E3B1 + 8E00D8C5B500000000000000000000000000000000001DA6D500ADFBFE008DF3 + FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE008DF3FE0060D4 + F0004BBDE0009EDEEE00ACDBF4000335FB000335FB00ACDBF400FFFFFE00FFFE + FF00FFFCFB00BEE6F5004BBDE000000000000000000000000000000000000000 + 0000000000000000000000000000927D7000F3F3F300927D7000DED7D3000000 + 000000000000ECEAEA00927D7000E1E0E000826A5B0000000000000000000000 + 0000000000000000000000000000000000000000000000000000CB9A8200FAFA + FA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00EDBD9200FEF0E200FFFEFF00FFFF + FF00FFFFFE00FCFEFE00FFFFFF00FEFEFE00FFFDF800FEF9F300FEFAF700B481 + 7600FCC47C00CB9A8200E2BDB30000000000000000000000000041B3DA00D4FD + FF00ADFBFE00ADFBFE00ADFBFE00ADFBFE00EDBD9200DCA88700DCA88700DCA8 + 8700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700B4817600E5CD + BE0000000000000000000000000000000000000000001DA6D500ADFBFE0099FD + FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD + FE0099FDFE0071EBF90060D4F0004571FA000335FB00295AF7004BBDE0004BBD + E0004BBDE0004BBDE0004BBDE000000000000000000000000000000000000000 + 00000000000000000000E1E0E000A18C8200C6B8AB00B1A09700000000000000 + 00000000000000000000C6B8AB00B1A09700B9AAA600C3C2C200000000000000 + 0000000000000000000000000000000000000000000000000000DCA88700FBFB + FC00FECC9A00FECC9A00FECC9A00FECC9A00EDBD9200FEF0E200FCFEFB00FCFE + FB00F8FBFB00F9F6F500F9F6F500F3F3F300F3F3F300EFEFEF00EFEFEF00B481 + 7600E3B18E00D8C5B5000000000000000000000000000000000041B3DA00E4FD + FE00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FD + FF00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FDFF00C2FDFF0090D1F100059A + CD0000000000000000000000000000000000000000001DA6D500ADFBFE0099FD + FE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FDFE0099FD + FE0099FDFE0099FDFE0099FDFE0070D2FD000335FB000335FB00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000B1A09700B1A09700826A5B0000000000000000000000 + 0000000000000000000000000000927D7000B1A09700A18C8200000000000000 + 0000000000000000000000000000000000000000000000000000DCA88700FBFB + FC00FFFEFF00FFFFFF00FFFDF800FEF9F300EDBD9200DCA88700DCA88700DCA8 + 8700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700B481 + 7600E5CDBE00000000000000000000000000000000000000000041B3DA00E4FD + FE00D4FDFF00C2FDFF009EDEEE009EDEEE009EDEEE009AE3FF009EDEEE009AE3 + FF009EDEEE009AE3FF009EDEEE009EDEEE00D4FDFF00D4FDFF0090D1F100059A + CD0000000000000000000000000000000000000000001DA6D500E4FDFE0099FD + FE0099FDFE0099FDFE0099FDFE0099FDFE00F0FEFE00BEE6F500BEE6F500E4FD + FE00D4FDFF00C2FDFF00ADFBFE00ADFBFE00295AF7000335FB0098A9EF00F0F6 + FD00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000927D7000826A5B00DED2CA0000000000000000000000 + 0000000000000000000000000000E1E0E000826A5B00826A5B00000000000000 + 0000000000000000000000000000000000000000000000000000E3B18E00FBFB + FC00FFFFFF00FFFFFE00FEFEFE00FFFDF800FEFAF700FFF8EE00FEF4E900FEF0 + E200FEEBD700D6A89400D6A89400B48176000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000041B3DA00F0FE + FE00D4FDFF009BC3D800A18C8200A18C8200A18C8200A18C8200A18C8200A18C + 8200A18C8200A18C8200A18C8200A18C820090D1F100D4FDFF0090D1F100059A + CD0000000000000000000000000000000000000000002EACD80090D1F100D4FD + FF00D4FDFF00C2FDFF00ADFBFE00E4FDFE0064C1E1001DA6D5001DA6D5001DA6 + D5001DA6D5001DA6D5001DA6D5001DA6D5001DA6D5000335FB004571FA000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FAF3F200826A5B00927D70000000000000000000000000000000 + 000000000000000000000000000000000000B1A097006F5B4D00DED7D3000000 + 0000000000000000000000000000000000000000000000000000E3B18E00FFFE + FE00FFFFFE00FFFFFF00FFFFFF00FFFFFF00FFFCFB00FEFAF700FFF8EE00FFF8 + EE00B4817600B4817600B4817600B48176000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000041B3DA00F0FE + FE00E4FDFE00B1A09700DED7D300DED7D300DED7D300DED7D300DED7D300DED7 + D300DED7D300DED7D300DED7D3008C8988004BBDE000E4FDFE0090D1F100059A + CD000000000000000000000000000000000000000000000000001DA6D5007ECB + E6007ECBE6009EDEEE00BEE6F500ACDBF4001DA6D50000000000000000000000 + 00000000000000000000000000000000000000000000CED7FA00DFEFF9000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000DED7D3006F5B4D00ECEAEA000000000000000000000000000000 + 00000000000000000000000000000000000000000000826A5B00CABCB7000000 + 0000000000000000000000000000000000000000000000000000EDBD9200FFFE + FE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFEFE00FFFDF800FEFAF700FFF8 + EE00B4817600FCC47C00DCA88700E2BDB3000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007ECBE6002EAC + D80099FDFE009BC3D800A4968E00C6B8AB00FFFFFF00FFFFFF00FCFEFE00FFFE + FF00FFFFFE00DED7D300A4968E008791850041B3DA007ECBE600059ACD00DFEF + F900000000000000000000000000000000000000000000000000000000001DA6 + D5001DA6D5001DA6D5001DA6D5001DA6D5000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000ECEAEA00DBC9C600000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000DED7D300DED7D3000000 + 0000000000000000000000000000000000000000000000000000EDBD9200FCFE + FE00FFFCFF00FEFEFE00FCFEFB00FAFAFA00F8F8F800F8F8F800F9F6F500F8F3 + EC00B4817600E3B18E00D8C5B500000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000090D1 + F10041B3DA0041B3DA0041B3DA00A18C8200CABCB700CABCB700CABCB700CABC + B700CABCB700B9AAA60066A6C30041B3DA0041B3DA004BBDE000BEE6F5000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000EDBD9200DCA8 + 8700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 + 8700B4817600E5CDBE0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000A18C8200A18C8200A18C8200A18C8200A18C + 8200A18C8200A18C8200DBC9C600000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000CED7FA00295AF70098A9EF00000000000000000000000000000000000000 + 000000000000000000000000000000000000EADBD400D3936400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FAF3F200A23F0800DAB4A00000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 7400A4787400A4787400A4787400A4787400A4787400A4787400A4787400A478 + 74008C5D5C000000000000000000000000000000000000000000D0E3EC00D1CD + E400ECEAEA000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000CED7 + FA000732DE000732DE000732DE00000000000000000000000000000000000000 + 0000000000000000000000000000EADBD400A23F0800A23F0800D39364000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000AB562900BD580100A23F0800DAB4A000000000000000 + 000000000000000000000000000000000000000000000000000000000000A478 + 7400ECDACC00FED6C900FED6C900FED6C900FED6C900FED6C900FED6C900FED6 + C900FED0B700FECFC200FECFC200FED0B700FED0B700FED0B700FED0B700FED0 + B7008C5D5C0000000000000000000000000000000000F0F6FD000732DE000732 + DE000732DE00C7DDE10000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000D1CDE4000732 + DE000732DE000732DE00CED7FA00000000000000000000000000000000000000 + 00000000000000000000EADBD400AF4B0200CC670100CC670100A23F0800DAB4 + A000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000BD795800BD580100CC670100CC670100A23F0800DAB4A0000000 + 000000000000000000000000000000000000000000000000000000000000A478 + 7400F3E3D100FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDDBB00FEDD + BB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00FECC9A00FED0 + B7008C5D5C0000000000000000000000000000000000D1CDE4000732DE000732 + DE000732DE000732DE00CED7FA00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000098A9EF000732DE000732 + DE000732DE00CED7FA0000000000000000000000000000000000000000000000 + 000000000000EADBD400A23F0800BD580100CC670100CC670100AF4B0200D6A8 + 9400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000DAB4A000A23F0800CC670100CC670100CC670100A23F0800E5CD + BE0000000000000000000000000000000000000000000000000000000000A478 + 7400EFE4D800FEEBD700FEEBD700FEE4CA00FEE4CA00FEE4CA00FEE4CA00FEDD + BB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED7AB00FED0 + B7008C5D5C0000000000000000000000000000000000F0F6FD000732DE000732 + DE000732DE000732DE000732DE00BEC6DC000000000000000000000000000000 + 00000000000000000000000000000000000098A9EF000732DE000732DE000732 + DE00CED7FA000000000000000000000000000000000000000000000000000000 + 0000F8F0F000AB562900BD580100CC670100CC670100AF4B0200DAB4A0000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000DAB4A000A23F0800CC670100CC670100CC670100A23F + 0800FAF3F200000000000000000000000000000000000000000000000000A478 + 7400F1E3E200FEEBD700FEEBD700FEEBD700FEE4CA00FEE4CA00FED6C900FEDD + BB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FED7AB00FED0 + B7008C5D5C000000000000000000000000000000000000000000F3F3F300295A + F7000732DE000732DE000732DE000732DE0098A9EF0000000000000000000000 + 00000000000000000000000000006682F1000732DE000732DE000732DE00CED7 + FA00000000000000000000000000000000000000000000000000000000000000 + 0000D3936400AF4B0200CC670100CC670100AF4B0200BD795800000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000DAB4A000A23F0800CC670100CC670100BD58 + 0100B3664100000000000000000000000000000000000000000000000000B481 + 7600F5EADF00FEF0E200FEEBD700FEEBD700FEE4CA00F3E3D100CCC0CC0098A9 + EF00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED7AB00FECF + C2008C5D5C000000000000000000000000000000000000000000000000000000 + 00006682F1000732DE000732DE000732DE000732DE0098A9EF00000000000000 + 000000000000000000006682F1000732DE000732DE000732DE00CED7FA000000 + 000000000000000000000000000000000000000000000000000000000000E5CD + BE00A23F0800CC670100CC670100AF4B0200BD79580000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000CB9A8200AF4B0200CC670100CC67 + 0100A23F0800E2BDB3000000000000000000000000000000000000000000B481 + 7600F5EADF00FEF0E200FEF0E200FEEBD700EFE4D8006682F1000335FB000335 + FB00CFC4D600FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED7AB00FED0 + B7008C5D5C000000000000000000000000000000000000000000000000000000 + 00000000000098A9EF000732DE000732DE000732DE000732DE0098A9EF000000 + 0000F3F3F300295AF7000732DE000732DE000732DE00CED7FA00000000000000 + 000000000000000000000000000000000000000000000000000000000000B366 + 4100BD580100CC670100BD580100AB562900F8F0F00000000000ECDACC00A23F + 0800AF4B0200AF4B0200AF4B0200AF4B0200AF4B0200AF4B0200AF4B0200AF4B + 0200AF4B0200AF4B0200B3664100000000000000000000000000B3664100BD58 + 0100BD580100BD580100BD580100BD580100BD580100BD580100BD580100BD58 + 0100BD580100A23F0800E2BDB3000000000000000000B3664100BD580100CC67 + 0100CC670100AB5629000000000000000000000000000000000000000000B481 + 7600F6EFE700FEF4E900FEF0E20098A9EF000335FB000335FB000335FB000335 + FB00295AF700FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FED0 + B700986B66000000000000000000000000000000000000000000000000000000 + 00000000000000000000CED7FA00295AF7000732DE000732DE000732DE0098A9 + EF00295AF7000732DE000732DE000732DE00CED7FA0000000000000000000000 + 0000000000000000000000000000000000000000000000000000E5CDBE00AF4B + 0200CC670100CC670100A23F0800E5CDBE000000000000000000CB9A8200BD58 + 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 + 0100CC670100CC670100B3664100000000000000000000000000B3664100CC67 + 0100CC670100CC670100CC670100CC670100CC670100CC670100CC670100CC67 + 0100CC670100BD580100CB9A82000000000000000000F5EADF00A23F0800CC67 + 0100CC670100AF4B0200DAB4A00000000000000000000000000000000000B481 + 7600F8F3EC00FEF4E90098A9EF000335FB000335FB000335FB0098A9EF000335 + FB000335FB00A9ACD400FEE4CA00FEDDBB00FEDDBB00FEDDBB00FEDDBB00FECF + C200986B66000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000F0F6FD004571FA000732DE000335FB000732 + DE000732DE000732DE000732DE00CED7FA000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BD795800CC67 + 0100E27E0300BD580100BD795800000000000000000000000000D6A89400AF4B + 0200BD580100BD580100BD580100BD580100BD580100CC670100CC670100CC67 + 0100CC670100CC670100B3664100000000000000000000000000B3664100E27E + 0300E27E0300CC670100CC670100BD580100AF4B0200AF4B0200AF4B0200AF4B + 0200AF4B0200A23F0800ECDACC00000000000000000000000000B4817600BD58 + 0100CC670100BD580100BD79580000000000000000000000000000000000BA8E + 8500F8F3EC00FFF8EE00ECEAEA000335FB006682F100F1E3E200FEEBD7006682 + F1000335FB000335FB00FED6C900FEE4CA00FEDDBB00FEDDBB00FEDDBB00FED6 + C900986B66000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000006682F1000732DE000732 + DE000335FB000732DE00CED7FA00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000AF4B0200E27E + 0300E27E0300AF4B0200F5EADF0000000000000000000000000000000000D6A8 + 9400CB9A8200CB9A8200CB9A8200D3936400A23F0800BD580100CC670100CC67 + 0100CC670100CC670100B3664100000000000000000000000000B3664100E27E + 0300E27E0300E27E0300CC670100CC670100A23F0800D6A89400E5CDBE00E5CD + BE00E5CDBE00F1E3E20000000000000000000000000000000000F5EADF00AF4B + 0200CC670100CC670100A23F080000000000000000000000000000000000BA8E + 8500FAF3F200FEF9F300FFF8EE00FEF4E900FEF4E900FEF0E200FEF0E200EFE4 + D8000335FB000335FB006682F100FEE4CA00FEE4CA00FEE4CA00FEDDBB00FED6 + C900986B66000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000BEC6DC000732DE000335FB000732 + DE000732DE000335FB006682F100000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000ECDACC00BD580100FB9B + 0F00E27E0300AB56290000000000000000000000000000000000000000000000 + 00000000000000000000F8F0F000AB562900BD580100CC670100CC670100CC67 + 0100CC670100CC670100B3664100000000000000000000000000B3664100E27E + 0300E27E0300E27E0300E27E0300E27E0300CC670100A23F0800EADBD4000000 + 000000000000000000000000000000000000000000000000000000000000AB56 + 2900CC670100CC670100AF4B0200ECDACC00000000000000000000000000CB9A + 8200F9F6F500FFFCFB00FEF9F300FFF8EE00FEF4E900FEF4E900FEF0E200FEF0 + E20098A9EF000335FB000335FB00CFC4D600FEE4CA00FEE4CA00FEE4CA00FED6 + C900986B66000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000098A9EF000732DE000335FB000732DE000335 + FB00295AF7000335FB000732DE006682F1000000000000000000000000000000 + 00000000000000000000000000000000000000000000E5CDBE00CC670100FB9B + 0F00E27E0300BD79580000000000000000000000000000000000000000000000 + 000000000000FAF3F200AB562900BD580100CC670100CC670100BD580100AF4B + 0200CC670100CC670100B3664100000000000000000000000000B3664100FB9B + 0F00E27E0300AF4B0200AF4B0200E27E0300E27E0300CC670100A23F0800EADB + D40000000000000000000000000000000000000000000000000000000000B366 + 4100CC670100CC670100AF4B0200E5CDBE00000000000000000000000000CB9A + 8200FDFAFA00FFFDF800FEFAF700FEF9F300FFF8EE00FEF4E900FEF4E900FEF0 + E200F5EADF004571FA000335FB00295AF700FEEBD700FEE4CA00FEE4CA00FED6 + C900A47874000000000000000000000000000000000000000000000000000000 + 0000000000000000000098A9EF000335FB000335FB000732DE000335FB00CED7 + FA00F0F6FD006682F1000335FB000335FB006682F10000000000000000000000 + 00000000000000000000000000000000000000000000E5CDBE00CC670100FB9B + 0F00FB9B0F00B366410000000000000000000000000000000000000000000000 + 0000FAF3F200AB562900BD580100CC670100CC670100BD580100AB562900AF4B + 0200CC670100CC670100B3664100000000000000000000000000B3664100FB9B + 0F00FB9B0F00AF4B0200DAB4A000AF4B0200E27E0300E27E0300CC670100A23F + 0800E5CDBE00000000000000000000000000000000000000000000000000AB56 + 2900CC670100CC670100AF4B0200F1E3E200000000000000000000000000CB9A + 8200FAFAFA00FFFFFF00FFFCFB00FEFAF700FEF9F300FFF8EE00FEF4E900FEF4 + E900FEF0E200D1CDE4000335FB000335FB00CFC4D600FEE4CA00FEE4CA00FED6 + C900A47874000000000000000000000000000000000000000000000000000000 + 0000000000006682F1000335FB000732DE000335FB000335FB00CED7FA000000 + 0000000000000000000098A9EF000335FB000335FB006682F100000000000000 + 00000000000000000000000000000000000000000000F8F3EC00AF4B0200FCB0 + 4C00FB9B0F00AF4B0200F1E3E20000000000000000000000000000000000E5CD + BE00A23F0800BD580100CC670100CC670100BD580100BD795800E5CDBE00AF4B + 0200CC670100CC670100B3664100000000000000000000000000B3664100FB9B + 0F00FB9B0F00AF4B020000000000DAB4A000BD580100E27E0300E27E0300E27E + 0300A23F0800CB9A820000000000000000000000000000000000DAB4A000AF4B + 0200CC670100CC670100A23F080000000000000000000000000000000000DCA8 + 8700F8FBFB00FFFFFF00FFFFFF00FFFDF800FEFAF700FEF9F300FFF8EE00FEF4 + E900FEF0E200FEF0E20098A9EF00E2D6E200FEEBD700FEEBD700FEE4CA00FECF + C200A47874000000000000000000000000000000000000000000000000000000 + 00006682F1000335FB000335FB000335FB000335FB00CED7FA00000000000000 + 0000000000000000000000000000CED7FA00295AF7000335FB006682F1000000 + 0000000000000000000000000000000000000000000000000000AB562900FB9B + 0F00FCB04C00E27E0300AB562900F1E3E20000000000F5EADF00BD795800AF4B + 0200E27E0300E27E0300CC670100BD580100BD79580000000000E5CDBE00AF4B + 0200CC670100CC670100B3664100000000000000000000000000B3664100FCB0 + 4C00FB9B0F00AF4B02000000000000000000DAB4A000AF4B0200E27E0300E27E + 0300E27E0300BD580100AB562900D6A89400E5CDBE00CB9A8200A23F0800CC67 + 0100CC670100BD580100BD79580000000000000000000000000000000000DCA8 + 8700FBFBFC00FCFEFE00FFFFFE00FFFFFF00FFFCFB00FEFAF700FEF9F300FFF8 + EE00FEF4E900FEF4E900FEF0E200FEF0E200FEEBD700FED6C900FECFC200F3B9 + B500A47874000000000000000000000000000000000000000000F0F6FD00295A + F7000335FB000335FB000335FB000335FB00CED7FA0000000000000000000000 + 000000000000000000000000000000000000F0F6FD004571FA000335FB004571 + FA00000000000000000000000000000000000000000000000000DAB4A000C56E + 2600FCB04C00FCB04C00E27E0300BD580100AF4B0200BD580100CC670100E27E + 0300E27E0300E27E0300AF4B0200BD7958000000000000000000E5CDBE00AF4B + 0200CC670100CC670100B3664100000000000000000000000000B3664100FCB0 + 4C00FCB04C00AF4B0200000000000000000000000000DAB4A000AF4B0200E27E + 0300E27E0300E27E0300E27E0300BD580100BD580100BD580100CC670100CC67 + 0100CC670100A23F0800F5EADF0000000000000000000000000000000000DCA8 + 8700FCFEFE00FFFEFF00FFFEFF00FFFFFF00FFFEFE00FFFCFB00FEF9F300FFF8 + EE00FFF8EE00FEF4E900FEF4E900FEF0E200FED6C900F3B9B500FCA3A200FCA3 + A200B481760000000000000000000000000000000000F0F6FD00295AF7000335 + FB000335FB000335FB000335FB00CED7FA000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000098A9EF000335 + FB00CED7FA00000000000000000000000000000000000000000000000000B366 + 4100D3936400FCB04C00FCB04C00FCB04C00FB9B0F00FB9B0F00FB9B0F00FB9B + 0F00E27E0300A23F0800D6A89400000000000000000000000000E5CDBE00AF4B + 0200CC670100CC670100B3664100000000000000000000000000B3664100FCB0 + 4C00FCC47C00AF4B020000000000000000000000000000000000ECDACC00AB56 + 2900CC670100E27E0300E27E0300E27E0300E27E0300E27E0300CC670100CC67 + 0100A23F0800DAB4A0000000000000000000000000000000000000000000E3B1 + 8E00FCFEFB00FFFFFE00FFFEFF00FEFEFE00FFFFFE00FEFEFE00FFFDF800FEFA + F700FFF8EE00FFF8EE00FEF4E900B4817600B4817600B4817600B4817600B481 + 7600B4817600000000000000000000000000000000006682F1000335FB000335 + FB000335FB000335FB00CED7FA00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000F8F3 + EC00BD795800C56E2600FCB04C00FCB04C00FCB04C00FB9B0F00E27E0300BD58 + 0100AB562900ECDACC000000000000000000000000000000000000000000AB56 + 2900AF4B0200AF4B0200E2BDB300000000000000000000000000E5CDBE00AB56 + 2900AF4B0200CB9A82000000000000000000000000000000000000000000FAF3 + F200CB9A8200AF4B0200CC670100CC670100E27E0300CC670100BD580100A23F + 0800DAB4A000000000000000000000000000000000000000000000000000E3B1 + 8E00FFFEFE00FFFFFE00FFFFFF00FFFEFF00FEFEFE00FFFEFF00FFFEFF00FDFA + FA00FEFAF700FFF8EE00FFF8EE00B4817600E3B18E00FCB04C00FB9B0F00D393 + 6400CB9A8200000000000000000000000000000000006682F1000335FB000335 + FB000335FB00CED7FA0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000DAB4A000BD795800AF4B0200AB562900A23F0800BD795800E2BD + B30000000000000000000000000000000000000000000000000000000000F8F0 + F000DAB4A000ECDACC0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000F8F3EC00DAB4A000D3936400B3664100BD795800DAB4A000F8F3 + EC0000000000000000000000000000000000000000000000000000000000EDBD + 9200FFFCFF00FFFFFF00FFFFFF00FFFEFF00FFFFFE00FFFFFF00FFFFFF00FFFF + FE00FEFAF700FEFAF700FFF8EE00B4817600EAC8A100FCC47C00CB9A8200DCA8 + 8700F6EFE70000000000000000000000000000000000CED7FA004571FA004571 + FA00CED7FA000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200FFFFFE00FFFEFF00FFFFFF00FEFEFE00FFFFFF00FEFEFE00FFFFFF00FFFF + FE00FEFEFE00FEFAF700FEFAF700B4817600EAC8A100E3B18E00DCA88700F6EF + E700000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200FEF0E200FEF0E200F5EADF00F5EADF00EFE4D800EFE4D800EADBD400EADB + D400ECDACC00E4D1CD00DED2CA00B4817600DCA88700D6A89400F6EFE7000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000EDBD + 9200DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA88700DCA8 + 8700DCA88700DCA88700DCA88700B4817600DCA88700F6EFE700000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000060000000A80000000100010000000000E00700000000000000000000 + 000000000000000000000000FFFFFF00FF003FFFFFFFFFFFFF000000FC000FE0 + 0007E00007000000F00003E00007C00007000000E00000E00007C00007000000 + C00000E00007C00007000000800001E00007E00007000000800001E00007E000 + 07000000800001E00007E00007000000800001E00007E00007000000800001E0 + 0007E00007000000800001E00007E00007000000C00003E00007E00007000000 + E00003E00007E00007000000F80007E00007E00007000000F8001FE00007E000 + 07000000FC007FE00007E00007000000FC00FFE00007E00007000000F800FFE0 + 0007E00007000000F800FFE00007E00007000000F801FFE00007E00007000000 + F001FFE0000FE0000F000000F001FFE0001FE0001F000000E003FFE0003FE000 + 3F000000E003FFE0007FE0007F000000FFFFFFFFFFFFFFFFFFFFFFFFE7FFFFFF + FFFFC3FFFFC00003E07FFFF81FFFC03FFF800003E007FFF800FFC003FF800003 + 80007FF8000FC0007F80000380000F80000FC0007F800003800007800007C000 + 3F800003800007800007C0003F800003800007800003C0001F80000380000380 + 0003C0001F800003800003800001C0000F800003800001800001C0000F800003 + 800001800001C00007800003800000800001C0000780000380000080001FC000 + 0780000380000080001FC0000380000380001F80001FC0780180000380001F80 + 00FFE0FF0F800003E0001F8000FFFFFE0F800003E0007F8000FFFFFE0F800003 + FC00FF80FFFFFFF81F800003FC01FFC0FFFFFF803F800003FFFFFFFFFFFFFFC0 + FF800003FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF807FC0 + FFFFF0FFFFC3FEFFFE001FC00FFFF007FFC03E7FFC000FC000FFF0007FC0001F + F80007C0000FF0001FC0000FF00003C00003F0001FC00007E00001C00003F000 + 0FC00003C00001C00003F0000FC00001C00000C00003F00007C00001800000C0 + 0003F00007C00003000000C00003F00007C00003000000C00003F00003C00003 + C00000C00003F00003C00001C00000C00003F00003C00001E00000C00003F000 + 3FC00001E00001C00003F0003FC00001E00001C00003F0003FC0001FF00001E0 + 0003FF8003C0001FF00003F00003FF8007C0001FF80007FC0003FFC00FE000FF + FC000FFE000FFFE03FF801FFFF003FFF001FFFE07FF803FFFFC0FFFF807FFFF1 + FFFFFFFFFFFFFFFFC0FFFFFFFFFFFFFFFFFFFFFFFFFF8FFFFFFBFFCFE00003FE + 03FF07FFFFF0FF0FE00003FC003F03FFFFF07E07E00003F0000301FFFFF03C0F + E00003E0000180FFFFF0180FE00003C00001C07FFFF8000FE00003800001E03F + FFF8001FE00003800001F0301FF8001FE00003800001F8000FFC001FE0000380 + 0001FC0007FC003FE00003800001FE0003F8000FE00003800001FF0001E00007 + E00003800000FF0001800001E00003800000FE0000000000E00003000001FE00 + 00000000E00003000003FE0000000000E00003800007FE00000380E0E00003C0 + 000FFE0000FF81FFE00003E0001FFF0001FF81FFE00003F0003FFF0003FF81FF + E00003FC003FFF8003FFC1FFE00007FC003FFFC007FFC3FFE0000FFE1C3FFFE0 + 1FFFC3FFE0001FFFFC3FFFFFFFFFE3FFFFFFFFFF81FFFF81FFFFFFFFFFFFFFFC + 007FFE003FE00003000001F8001FF8001FE00003000001E0000FF0000FE00003 + 000001E00007E00007E00003000001C00003C00003E00003000001800003C000 + 01E00003000001800001800001E00003000001800001800001E0000300000100 + 0001800000E00003000001000001800000E00003000001000001800000E00003 + 000001000001800000E00003000001000001800000E000030000010000018000 + 01E00003000001800001800001E00003000001800001800001E00003000001C0 + 0003C00003E00003000001C00007E00003E00003000001E00007E00007E00003 + 000001F0000FF0000FE00003FFFFFFF8003FFC001FE00007FFFFFFFE007FFE00 + 7FE0000FFFFFFFFFFFFFFFFFFFE0001FF87E1FFFFFFFFF0003FFFFFFF03C0FFF + 0001FF0003FFFFFFF0180FFF0001E000038FFFFFF0188FFF0001C00003807FFF + F1198FFF0001C000038007FFF1198FFF0001C0000380007FF0080FC00001C000 + 0380001FF8001FC00001C0000380001FFC001FC00001C0000380000FFF81FFC0 + 0001C0000380000FFF81FFC00001C00003800007FF81FFC00001C00003800007 + FF00FFC00001C00003800003FF00FFC00001C00003800003FE007FC00001C000 + 03800003FE187FC00001C00007800001FE187FC00001C0000F800001FC3C3FC0 + 0003C0000F80003FFC7E3FC00007C0000F80000FFC7E3FC000FFC0000F80001F + F8FF1FC000FFC0000FC07F9FF8FF9FC000FFC0000FE0FFFFF9FF9FC001FFE000 + 1FFFFFFFFFFFFFC003FFFE01FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF1FF + 3FFFFFFC7FE00007C7FFE1FE1FFFFFFC3FE0000783FFC1FC0FFFFFF81FE00007 + 81FF83F80FFFFFF80FE0000780FF07F01FFFFFFC07E00007C07E0FF03FFFFFFE + 07E00007F03C1FE07FFFFFFF03E00007F8103FE04001C00183E00007FC007FC0 + C001C00181E00007FE00FFC1C001C001C1E00007FF81FFC1E001C003C1E00007 + FF01FF83FC01C01FE0E00007FE00FF83F801C00FE0E00007FC007F83F001C007 + E0E00007F81C3F81E001C203C1E00007F03E1FC08041C30001E00007C07F0FC0 + 00C1C38001E0000780FFC7E001C1C3C003E0000781FFFFE003E1C3E007E00007 + 83FFFFF80FE3FFF80FE0000787FFFFFFFFFFFFFFFFE0000FFFFFFFFFFFFFFFFF + FFE0001FFFFFFFFFFFFFFFFFFFE0003F00000000000000000000000000000000 + 000000000000} + end +end diff --git a/Demos/Interfaces/modelviewform.pas b/Demos/Interfaces/modelviewform.pas index 1d23b3f6b..ef10f3408 100644 --- a/Demos/Interfaces/modelviewform.pas +++ b/Demos/Interfaces/modelviewform.pas @@ -58,7 +58,9 @@ interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, - Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.StdCtrls, Vcl.ImgList, myevents; + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.StdCtrls, Vcl.ImgList, myevents, + System.ImageList, VirtualTrees.BaseAncestorVCL, VirtualTrees.BaseTree, + VirtualTrees.AncestorVCL; type TFormModelView = class(TForm) diff --git a/Demos/Interfaces/myevents.pas b/Demos/Interfaces/myevents.pas index 2efdd91b4..ca6c1ba8a 100644 --- a/Demos/Interfaces/myevents.pas +++ b/Demos/Interfaces/myevents.pas @@ -23,7 +23,7 @@ interface -uses Vcl.ImgList, VirtualTrees, System.Classes, Vcl.Controls; +uses Vcl.ImgList, VirtualTrees, System.Classes, System.UITypes, Vcl.Controls, VirtualTrees.Types; type IEventPresenter = interface @@ -103,9 +103,11 @@ procedure TEventPresenter.setup(aVST: TVirtualStringTree; anImageList: TImageLis //set up columns col := fVST.header.Columns.Add; col.Text := 'Star Event'; + col.Hint := 'Number of Stars'; col.Width := 120; col := fVST.header.Columns.Add; col.Text := 'Date'; + col.Hint := 'The date of the event'; col.Width := 100; col := fVST.header.Columns.Add; col.Text := 'Charity Event Name'; @@ -119,12 +121,12 @@ procedure TEventPresenter.setup(aVST: TVirtualStringTree; anImageList: TImageLis fVST.Header.AutoSizeIndex := -1; //If the form uses a larger font, the header should use the same fVST.Header.Font.Assign(fVST.font); - fVST.Header.Options := fVST.Header.Options + [hoVisible, hoHeaderClickAutoSort]; + fVST.Header.Options := fVST.Header.Options + [TVTHeaderOption.hoVisible, TVTHeaderOption.hoHeaderClickAutoSort]; fVST.TreeOptions.PaintOptions := fVST.TreeOptions.PaintOptions - - [toShowRoot, toShowTreeLines]; + - [TVTPaintOption.toShowRoot, TVTPaintOption.toShowTreeLines]; fVST.TreeOptions.SelectionOptions := fVST.TreeOptions.SelectionOptions - + [toFullRowSelect]; - fVST.TreeOptions.AutoOptions := fVST.TreeOptions.AutoOptions + [toAutoSort]; + + [TVTSelectionOption.toFullRowSelect]; + fVST.TreeOptions.AutoOptions := fVST.TreeOptions.AutoOptions + [TVTAutoOption.toAutoSort]; //generate 20 events as part of setup fVST.RootNodeCount := 20; diff --git a/Demos/Minimal/Main.pas b/Demos/Minimal/Main.pas index 2c3e41cca..57a3e87f7 100644 --- a/Demos/Minimal/Main.pas +++ b/Demos/Minimal/Main.pas @@ -6,8 +6,9 @@ interface uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - VirtualTrees, StdCtrls, ExtCtrls; + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.StdCtrls, Vcl.ExtCtrls, + VirtualTrees.BaseAncestorVCL, VirtualTrees.BaseTree, VirtualTrees.AncestorVCL; type TMainForm = class(TForm) diff --git a/Demos/Minimal/Minimal.dproj b/Demos/Minimal/Minimal.dproj index 406e5a8b8..c6ac5a90a 100644 --- a/Demos/Minimal/Minimal.dproj +++ b/Demos/Minimal/Minimal.dproj @@ -1,14 +1,15 @@  - {9ED56071-1730-40BE-A992-27309A7C55CB} - Minimal.dpr True - Debug - 1 Application + Debug VCL - 14.4 + Minimal.dpr Win32 + {9ED56071-1730-40BE-A992-27309A7C55CB} + 20.2 + 1 + Minimal true @@ -18,11 +19,6 @@ Base true - - true - Base - true - true Base @@ -33,43 +29,46 @@ Base true + + true + Cfg_2 + true + true + Minimal - 1 - false - 1031 - vcl;rtl;vclx;$(DCC_UsePackage) - false - 3 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 00400000 + 3 Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) - false - false + 1 ..\..\Source;$(DCC_UnitSearchPath) - true + vcl;rtl;vclx;$(DCC_UsePackage) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 1031 - true + PerMonitor true - 1033 - true - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) $(BDS)\bin\default_app.manifest - - - Minimal_Icon.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + true + 1033 - 0 - false + 0 RELEASE;$(DCC_Define) - false + false + 0 + DEBUG;$(DCC_Define) true false - DEBUG;$(DCC_Define) + + + Debug @@ -78,10 +77,6 @@
MainForm
 - - Cfg_2 - Base - Base @@ -89,6 +84,10 @@ Cfg_1 Base + + Cfg_2 + Base + Delphi.Personality.12 diff --git a/Demos/Multiselect/Multiselect.Main.dfm b/Demos/Multiselect/Multiselect.Main.dfm new file mode 100644 index 000000000..d4a3f89c6 --- /dev/null +++ b/Demos/Multiselect/Multiselect.Main.dfm @@ -0,0 +1,188 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Caption = 'Multiselect Demo' + ClientHeight = 776 + ClientWidth = 1104 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -27 + Font.Name = 'Segoe UI' + Font.Style = [] + OldCreateOrder = True + Position = poMainFormCenter + OnCreate = FormCreate + PixelsPerInch = 216 + TextHeight = 37 + object VirtualStringTree1: TVirtualStringTree + Left = 0 + Top = 0 + Width = 828 + Height = 776 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Align = alClient + DefaultNodeHeight = 46 + Header.AutoSizeIndex = 0 + Header.Height = 40 + Header.MaxHeight = 22500 + Header.MinHeight = 23 + Header.Options = [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible] + Indent = 41 + Margin = 9 + TabOrder = 0 + TextMargin = 9 + TreeOptions.SelectionOptions = [toExtendedFocus, toMultiSelect, toSelectNextNodeOnRemoval] + OnFreeNode = VirtualStringTree1FreeNode + OnGetText = VirtualStringTree1GetText + OnKeyPress = VirtualStringTree1KeyPress + Touch.InteractiveGestures = [igPan, igPressAndTap] + Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough] + Columns = < + item + MaxWidth = 9999 + MinWidth = 9 + Position = 0 + Spacing = 2 + Text = 'table_schema' + Width = 212 + end + item + MaxWidth = 9999 + MinWidth = 9 + Position = 1 + Spacing = 2 + Text = 'table_name' + Width = 191 + end + item + MaxWidth = 9999 + MinWidth = 9 + Position = 2 + Spacing = 2 + Text = 'table_type' + Width = 204 + end + item + MaxWidth = 9999 + MinWidth = 9 + Position = 3 + Spacing = 2 + Text = 'table_version' + Width = 183 + end> + end + object Panel1: TPanel + Left = 828 + Top = 0 + Width = 276 + Height = 776 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Align = alRight + Anchors = [] + BevelOuter = bvNone + Caption = 'Panel1' + TabOrder = 1 + DesignSize = ( + 276 + 776) + object btnSelect4CellsLeftToRight: TButton + Left = 44 + Top = 6 + Width = 216 + Height = 90 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Anchors = [akRight] + Caption = 'Select 4 cells'#13#10'left to right' + TabOrder = 0 + WordWrap = True + OnClick = btnSelect4CellsLeftToRightClick + end + object btnSelect4CellsRightToLeft: TButton + Left = 44 + Top = 110 + Width = 216 + Height = 90 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Anchors = [akRight] + Caption = 'Select 4 cells'#13#10'right to left' + TabOrder = 1 + WordWrap = True + OnClick = btnSelect4CellsRightToLeftClick + end + object btnClickRow2Col1: TButton + Left = 14 + Top = 293 + Width = 252 + Height = 56 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Anchors = [akRight] + Caption = 'Select row 2, cell 1' + TabOrder = 2 + OnClick = btnClickRow2Col1Click + end + object btnClickRow1Col1: TButton + Left = 14 + Top = 222 + Width = 252 + Height = 57 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Anchors = [akRight] + Caption = 'Select row 1, cell 1' + TabOrder = 3 + OnClick = btnClickRow1Col1Click + end + object btnSelectRow3Col1Row4Col2: TButton + Left = 14 + Top = 363 + Width = 252 + Height = 118 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Anchors = [akRight] + Caption = 'Select row 3, col 2, row 4, col 3'#13#10'Copy' + TabOrder = 4 + WordWrap = True + OnClick = btnSelectRow3Col1Row4Col2Click + end + object btnSelectRow2_3_Copy: TButton + Left = 14 + Top = 495 + Width = 252 + Height = 72 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Anchors = [akRight] + Caption = 'Select row 2-3, copy' + TabOrder = 5 + WordWrap = True + OnClick = btnSelectRow2_3_CopyClick + end + end +end diff --git a/Demos/Multiselect/Multiselect.Main.pas b/Demos/Multiselect/Multiselect.Main.pas new file mode 100644 index 000000000..e9c662cb0 --- /dev/null +++ b/Demos/Multiselect/Multiselect.Main.pas @@ -0,0 +1,333 @@ +unit Multiselect.Main; + +// Virtual Treeview sample form demonstrating following feature: +// - Multiple cell selection. +// Written by CheeWee Chua. + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, + System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, + VirtualTrees.BaseAncestorVCL, VirtualTrees.BaseTree, VirtualTrees.AncestorVCL, + VirtualTrees, Vcl.StdCtrls, Vcl.ExtCtrls; + +type + TForm1 = class(TForm) + VirtualStringTree1: TVirtualStringTree; + Panel1: TPanel; + btnSelect4CellsLeftToRight: TButton; + btnSelect4CellsRightToLeft: TButton; + btnClickRow2Col1: TButton; + btnClickRow1Col1: TButton; + btnSelectRow3Col1Row4Col2: TButton; + btnSelectRow2_3_Copy: TButton; + procedure FormCreate(Sender: TObject); + procedure VirtualStringTree1FreeNode(Sender: TBaseVirtualTree; + Node: PVirtualNode); + procedure VirtualStringTree1GetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: string); + procedure btnSelect4CellsLeftToRightClick(Sender: TObject); + procedure btnSelect4CellsRightToLeftClick(Sender: TObject); + procedure btnClickRow1Col1Click(Sender: TObject); + procedure btnClickRow2Col1Click(Sender: TObject); + procedure btnSelectRow3Col1Row4Col2Click(Sender: TObject); + procedure btnSelectRow2_3_CopyClick(Sender: TObject); + procedure VirtualStringTree1KeyPress(Sender: TObject; var Key: Char); + private + { Private declarations } + + procedure EnableMulticellSelection; + procedure EnableFullRowSelection; + + // These functions mimic human interaction with the user interface + procedure MouseClick(const ACursorPos: TPoint); overload; + procedure MouseClick(ANode: PVirtualNode; AColumn: TColumnIndex = 0); overload; + procedure ShiftMouseClick(ANode: PVirtualNode; AColumn: TColumnIndex = 0); overload; + procedure ShiftMouseClick(const ACell: TVTCell); overload; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +uses + VirtualTrees.Types, VirtualTrees.Clipboard; + +{$R *.dfm} + +type + TRowData = record + table_schema: string; + table_name: string; + table_type: string; + public + constructor Create(const ASchema, AName, AType: string); + procedure Clear; + class operator Finalize(var Self: TRowData); + end; + +{ TRowData } + +procedure TRowData.Clear; +begin + table_schema := ''; + table_name := ''; + table_type := ''; +end; + +constructor TRowData.Create(const ASchema, AName, AType: string); +begin + table_schema := ASchema; + table_name := AName; + table_type := AType; +end; + +class operator TRowData.Finalize(var Self: TRowData); +begin + Self.Clear; +end; + +const + colSchema = 0; + colName = 1; + colType = 2; + +procedure TForm1.btnClickRow1Col1Click(Sender: TObject); +begin + EnableMulticellSelection; + var LTree := VirtualStringTree1; + var LNode := LTree.GetFirstChild(LTree.RootNode); + MouseClick(LNode); +end; + +procedure TForm1.btnClickRow2Col1Click(Sender: TObject); +begin + EnableMulticellSelection; + var LTree := VirtualStringTree1; + var LNode := LTree.GetFirstChild(LTree.RootNode); + LNode := LTree.GetNext(LNode); + MouseClick(LNode); +end; + +procedure TForm1.btnSelect4CellsLeftToRightClick(Sender: TObject); +begin + EnableMulticellSelection; + var LTree := VirtualStringTree1; + LTree.ClearCellSelection; + + var LNode := LTree.GetFirstChild(LTree.RootNode); + for var I := 1 to 2 do + LNode := LTree.GetNext(LNode); + // We're on 3rd row now... + var L3rdRow := LNode; // 3rd row + var L4thRow := LTree.GetNext(L3rdRow); // 4th row + + // Select cells from left to right + LTree.SelectCells( + L3rdRow, 1, // Left aka Start + L4thRow, 2, // Right aka End + True); +end; + +procedure TForm1.btnSelect4CellsRightToLeftClick(Sender: TObject); +begin + EnableMulticellSelection; + var LTree := VirtualStringTree1; + + LTree.ClearCellSelection; + + var LNode := LTree.GetFirstChild(LTree.RootNode); + for var I := 1 to 2 do + LNode := LTree.GetNext(LNode); + // We're on 3rd row now... + var L3rdRow := LNode; + var L4thRow := LTree.GetNext(L3rdRow); // 4th row + LTree.SelectCells( + L4thRow, 2, // Right aka Start + L3rdRow, 1, // Left aka End + True); +end; + +procedure TForm1.btnSelectRow2_3_CopyClick(Sender: TObject); +begin + // RegisterVTClipboardFormat(CF_TEXT, TVirtualStringTree); + EnableFullRowSelection; + var LTree := VirtualStringTree1; + + var LNode1 := LTree.GetFirstVisible(); + var LNode2 := LTree.GetNextVisible(LNode1); + var LNode3 := LTree.GetNextVisible(LNode2); + LTree.Selected[LNode2] := True; + LTree.Selected[LNode3] := True; + + LTree.CopyToClipboard; +end; + +procedure TForm1.btnSelectRow3Col1Row4Col2Click(Sender: TObject); +begin + EnableMulticellSelection; + var LTree := VirtualStringTree1; + + var LNode := LTree.GetFirstChild(LTree.RootNode); + for var I := 1 to 2 do + LNode := LTree.GetNext(LNode); + // We're on 3rd row now... + var L3rdRow := LNode; // 3rd row + var L4thRow := LTree.GetNext(L3rdRow); // 4th row + + // column 1 in code is column 2 in human eyes... + MouseClick(L3rdRow, 1); + + // column 2 in code is column 3 in human eyes... + ShiftMouseClick(TVTCell.Create(L4thRow, 2)); + + LTree.CopyToClipboard; +end; + +procedure TForm1.EnableFullRowSelection; +begin + var LTree := VirtualStringTree1; + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions + + [toFullRowSelect]; +end; + +procedure TForm1.EnableMulticellSelection; +begin + var LTree := VirtualStringTree1; + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions + + [toMultiSelect, toExtendedFocus] - [toFullRowSelect]; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + var LTree := VirtualStringTree1; + + LTree.NodeDataSize := SizeOf(TRowData); + + var LNode1 := LTree.AddChild(LTree.RootNode); + var LNode2 := LTree.AddChild(LTree.RootNode); + var LNode3 := LTree.AddChild(LTree.RootNode); + var LNode4 := LTree.AddChild(LTree.RootNode); + var LNode5 := LTree.AddChild(LTree.RootNode); + var LNode6 := LTree.AddChild(LTree.RootNode); + var LNode7 := LTree.AddChild(LTree.RootNode); + var LNode8 := LTree.AddChild(LTree.RootNode); + + LNode1.SetData(TRowData.Create('pg_catalog', 'pg_user_info', 'VIEW')); + LNode2.SetData(TRowData.Create('pg_catalog', 'pg_stastic', 'BASE TABLE')); + LNode3.SetData(TRowData.Create('pg_catalog', 'pg_settings', 'VIEW1')); + LNode4.SetData(TRowData.Create('pg_catalog', 'pg_type', 'VIEW2')); + LNode5.SetData(TRowData.Create('pg_catalog', 'pg_attribute', 'BASE TABLE')); + LNode6.SetData(TRowData.Create('pg_catalog', 'pg_class', 'BASE TABLE')); + LNode7.SetData(TRowData.Create('pg_catalog', 'pg_tablespace', 'BASE TABLE')); + LNode8.SetData(TRowData.Create('pg_catalog', 'pg_inherits', 'BASE TABLE')); + + LTree.ClipboardFormats.Add(GetVTClipboardFormatDescription(CF_TEXT)); + LTree.ClipboardFormats.Add(GetVTClipboardFormatDescription(CF_UNICODETEXT)); + LTree.ClipboardFormats.Add(GetVTClipboardFormatDescription(CF_VRTF)); + LTree.ClipboardFormats.Add(GetVTClipboardFormatDescription(CF_HTML)); +end; + +procedure TForm1.VirtualStringTree1FreeNode(Sender: TBaseVirtualTree; + Node: PVirtualNode); +begin + var LData := Node.GetData; + LData.Clear; +end; + +procedure TForm1.VirtualStringTree1GetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: string); +begin + if not Assigned(Node) then + Exit; + var LData := Node.GetData; + case Column of + colSchema: begin + CellText := LData.table_schema; + end; + colName: begin + CellText := LData.table_name; + end; + colType: begin + CellText := LData.table_type; + end; + // column 4 is deliberately left empty + end; +end; + +procedure TForm1.MouseClick(const ACursorPos: TPoint); +const + KEYDOWN = Byte(1 shl 7); +var + LKeyboardState: TKeyboardState; +begin + // Click a new cell on the tree... + var LTree := VirtualStringTree1; + var LCursorPos := Mouse.CursorPos; + try + Mouse.CursorPos := ACursorPos; + var LWPARAM: WPARAM := MK_LBUTTON; + if GetKeyboardState(LKeyboardState) then + begin + if (LKeyboardState[VK_SHIFT] and KEYDOWN <> 0) or + (LKeyboardState[VK_LSHIFT] and KEYDOWN <> 0) or + (LKeyboardState[VK_RSHIFT] and KEYDOWN <> 0) then + LWPARAM := LWPARAM or MK_SHIFT; + if (LKeyboardState[VK_CONTROL] and KEYDOWN <> 0) or + (LKeyboardState[VK_LCONTROL] and KEYDOWN <> 0) or + (LKeyboardState[VK_RCONTROL] and KEYDOWN <> 0) then + LWPARAM := LWPARAM or MK_CONTROL; + end; + var LPos := MakeLParam(ACursorPos.X, ACursorPos.Y); + LTree.Perform(WM_LBUTTONDOWN, LWPARAM, LPos); + LTree.Perform(WM_LBUTTONUP, LWPARAM, LPos); + finally + Mouse.CursorPos := LCursorPos; + end; +end; + +procedure TForm1.MouseClick(ANode: PVirtualNode; AColumn: TColumnIndex); +begin + var LTree := VirtualStringTree1; + var LClientRect := LTree.GetDisplayRect(ANode, AColumn, True); + MouseClick(LClientRect.TopLeft); +end; + +procedure TForm1.ShiftMouseClick(const ACell: TVTCell); +begin + ShiftMouseClick(ACell.Node, ACell.Column); +end; + +procedure TForm1.ShiftMouseClick(ANode: PVirtualNode; AColumn: TColumnIndex = 0); +const + KEYDOWN = Byte(1 shl 7); +var + LOrigKBState, LNewKBState: TKeyboardState; +begin + GetKeyboardState(LOrigKBState); + LNewKBState := LOrigKBState; + LNewKBState[VK_SHIFT] := LOrigKBState[VK_SHIFT] or KEYDOWN; + SetKeyboardState(LNewKBState); + try + MouseClick(ANode, AColumn); + finally + SetKeyboardState(LOrigKBState); + end; +end; + +procedure TForm1.VirtualStringTree1KeyPress(Sender: TObject; var Key: Char); +begin + // Press Ctrl+C to copy to clipboard + if Key = ^C then + begin + VirtualStringTree1.CopyToClipboard; + end; +end; + +end. diff --git a/Demos/Multiselect/Multiselect.dpr b/Demos/Multiselect/Multiselect.dpr new file mode 100644 index 000000000..3efa63ebd --- /dev/null +++ b/Demos/Multiselect/Multiselect.dpr @@ -0,0 +1,14 @@ +program Multiselect; + +uses + Vcl.Forms, + Multiselect.Main in 'Multiselect.Main.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Demos/Multiselect/Multiselect.dproj b/Demos/Multiselect/Multiselect.dproj new file mode 100644 index 000000000..dae5eb97b --- /dev/null +++ b/Demos/Multiselect/Multiselect.dproj @@ -0,0 +1,166 @@ + + + {B90F6CEF-381E-4531-ACD8-5F0D652EC358} + 19.2 + VCL + True + Debug + Win32 + Multiselect + 3 + Application + Multiselect.dpr + + + 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 + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + Multiselect + ..\..\Source;$(DCC_UnitSearchPath) + 1031 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=Multiselect;LegalCopyright=© 2026, CheeWee Chua;LegalTrademarks=;OriginalFilename=Multiselect;ProgramID=cx.ath.journeyman.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=Multiselect demo by CheeWee Chua, https://github.com/chuacw + + + vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;IndyProtocols;vclx;Skia.Package.RTL;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;soapmidas;vclactnband;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;fmxase;vcltouch;DBXOdbcDriver;dbrtl;FireDACDBXDriver;Skia.Package.FMX;FireDACOracleDriver;fmxdae;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;Skia.Package.VCL;vcldb;VirtualTreesR;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;soapmidas;vclactnband;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;fmxase;vcltouch;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;Skia.Package.VCL;vcldb;VirtualTreesR;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DEBUG;$(DCC_Define) + true + false + true + true + true + true + true + + + false + PerMonitorV2 + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=Multiselect;LegalCopyright=© 2026, CheeWee Chua;LegalTrademarks=;OriginalFilename=Multiselect;ProgramID=cx.ath.journeyman.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=Multiselect demo by CheeWee Chua, https://github.com/chuacw + + + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + PerMonitorV2 + + + PerMonitorV2 + + + + MainSource + + +
Form1
+ dfm + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + Multiselect.dpr + + + + + True + True + + + 12 + + + + + diff --git a/Demos/OLE/Main.dfm b/Demos/OLE/Main.dfm index 37bf8269d..c6c751f12 100644 --- a/Demos/OLE/Main.dfm +++ b/Demos/OLE/Main.dfm @@ -124,11 +124,6 @@ object MainForm: TMainForm Font.Name = 'Lucida Sans Unicode' Font.Style = [] Header.AutoSizeIndex = 0 - Header.Font.Charset = DEFAULT_CHARSET - Header.Font.Color = clWindowText - Header.Font.Height = -11 - Header.Font.Name = 'Tahoma' - Header.Font.Style = [] Header.MainColumn = -1 Header.Options = [hoColumnResize, hoDrag] HintMode = hmTooltip @@ -144,9 +139,12 @@ object MainForm: TMainForm OnDragAllowed = Tree2DragAllowed OnDragOver = TreeDragOver OnDragDrop = TreeDragDrop + OnFreeNode = TreeFreeNode OnGetText = Tree1GetText OnInitNode = TreeInitNode OnNewText = Tree1NewText + Touch.InteractiveGestures = [igPan, igPressAndTap] + Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough] Columns = <> end object Tree1: TVirtualStringTree @@ -173,11 +171,6 @@ object MainForm: TMainForm Font.Name = 'Verdana' Font.Style = [] Header.AutoSizeIndex = 0 - Header.Font.Charset = DEFAULT_CHARSET - Header.Font.Color = clWindowText - Header.Font.Height = -11 - Header.Font.Name = 'Tahoma' - Header.Font.Style = [] Header.MainColumn = -1 Header.Options = [hoColumnResize, hoDrag] HintMode = hmTooltip @@ -192,9 +185,12 @@ object MainForm: TMainForm TreeOptions.SelectionOptions = [toMultiSelect] OnDragOver = TreeDragOver OnDragDrop = TreeDragDrop + OnFreeNode = TreeFreeNode OnGetText = Tree1GetText OnInitNode = TreeInitNode OnNewText = Tree1NewText + Touch.InteractiveGestures = [igPan, igPressAndTap] + Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough] Columns = <> end object PageControl1: TPageControl @@ -208,10 +204,6 @@ object MainForm: TMainForm object RichTextTabSheet: TTabSheet Caption = 'Rich text' ImageIndex = 1 - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 DesignSize = ( 677 215) @@ -237,14 +229,11 @@ object MainForm: TMainForm ScrollBars = ssBoth TabOrder = 0 WordWrap = False + Zoom = 100 end end object LogTabSheet: TTabSheet Caption = 'Drag'#39'n drop operation log' - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 DesignSize = ( 677 215) @@ -287,10 +276,6 @@ object MainForm: TMainForm object TabSheet2: TTabSheet Caption = 'More info' ImageIndex = 3 - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object Label4: TLabel Left = 12 Top = 52 @@ -393,7 +378,7 @@ object MainForm: TMainForm Left = 706 Top = 212 Bitmap = { - 494C0101120013000C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010112001300040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000005000000001002000000000000050 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 diff --git a/Demos/OLE/Main.pas b/Demos/OLE/Main.pas index 90d18c40b..5db4b7a08 100644 --- a/Demos/OLE/Main.pas +++ b/Demos/OLE/Main.pas @@ -1,672 +1,687 @@ -unit Main; - -// Virtual Treeview sample application demonstrating clipboard and drag'n drop operations. -// The treeview uses OLE for these operations but can also issue and accept VCL drag'n drop. -// Written by Mike Lischke. - -interface - -uses - Windows, Messages, ActiveX, SysUtils, Forms, Dialogs, Graphics, - VirtualTrees, ActnList, ComCtrls, ExtCtrls, StdCtrls, Controls, Classes, - ImgList, System.Actions; - -type - TMainForm = class(TForm) - ActionList1: TActionList; - CutAction: TAction; - CopyAction: TAction; - PasteAction: TAction; - FontDialog: TFontDialog; - Panel3: TPanel; - Label6: TLabel; - Button1: TButton; - Button3: TButton; - Tree2: TVirtualStringTree; - Label1: TLabel; - Tree1: TVirtualStringTree; - Label2: TLabel; - PageControl1: TPageControl; - LogTabSheet: TTabSheet; - RichTextTabSheet: TTabSheet; - LogListBox: TListBox; - RichEdit1: TRichEdit; - Label3: TLabel; - Label7: TLabel; - Button2: TButton; - TabSheet1: TTabSheet; - Label8: TLabel; - TabSheet2: TTabSheet; - Label4: TLabel; - Label5: TLabel; - Label9: TLabel; - Label10: TLabel; - TreeImages: TImageList; - procedure Button1Click(Sender: TObject); - procedure CutActionExecute(Sender: TObject); - procedure CopyActionExecute(Sender: TObject); - procedure PasteActionExecute(Sender: TObject); - procedure Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: string); - procedure FormCreate(Sender: TObject); - procedure TreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; - Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); - procedure Button2Click(Sender: TObject); - procedure TreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; - var InitialStates: TVirtualNodeInitStates); - procedure Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: string); - procedure Button3Click(Sender: TObject); - procedure Tree2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); - procedure TreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; - Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean); - procedure Tree2BeforeItemErase(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; - var ItemColor: TColor; var EraseAction: TItemEraseAction); - private - procedure AddUnicodeText(DataObject: IDataObject; Target: TVirtualStringTree; Mode: TVTNodeAttachMode); - procedure AddVCLText(Target: TVirtualStringTree; const Text: UnicodeString; Mode: TVTNodeAttachMode); - function FindCPFormatDescription(CPFormat: Word): string; - procedure InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray; Effect: Integer; - Mode: TVTNodeAttachMode); - end; - -var - MainForm: TMainForm; - -//---------------------------------------------------------------------------------------------------------------------- - -implementation - -uses - TypInfo, ShlObj, UrlMon, VirtualTrees.ClipBoard; - -{$R *.DFM} -{$R Res\Extra.res} // Contains a little rich text for the rich edit control and a XP manifest. - -type - PNodeData = ^TNodeData; - TNodeData = record - Caption: UnicodeString; - end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.Button1Click(Sender: TObject); - -begin - Close; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.CutActionExecute(Sender: TObject); - -begin - if ActiveControl = Tree1 then - Tree1.CutToClipboard - else - if ActiveControl = Tree2 then - Tree2.CutToClipboard - else - if ActiveControl = RichEdit1 then - RichEdit1.CutToClipboard; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.CopyActionExecute(Sender: TObject); - -begin - if ActiveControl = Tree1 then - Tree1.CopyToClipboard - else - if ActiveControl = Tree2 then - Tree2.CopyToClipboard - else - if ActiveControl = RichEdit1 then - RichEdit1.CopyToClipboard; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.PasteActionExecute(Sender: TObject); - -var - DataObject: IDataObject; - EnumFormat: IEnumFormatEtc; - Format: TFormatEtc; - Formats: TFormatArray; - Fetched: Integer; - Tree: TVirtualStringTree; - -begin - if ActiveControl is TVirtualStringTree then - begin - Tree := ActiveControl as TVirtualStringTree; - - if LogListBox.Items.Count > 0 then - LogListBox.Items.Add(''); - if ActiveControl = Tree1 then - LogListBox.Items.Add('----- Tree 1') - else - LogListBox.Items.Add('----- Tree 2'); - - if Tree.PasteFromClipboard then - LogListBox.Items.Add('Native tree data pasted.') - else - begin - LogListBox.Items.Add('Other data pasted.'); - // Some other data was pasted. Enumerate the available formats and try to add the data. - // 1) Get a data object for the data. - OLEGetClipboard(DataObject); - // 2) Enumerate all offered formats and create a format array from it which can be used in InsertData. - if Succeeded(DataObject.EnumFormatEtc(DATADIR_GET, EnumFormat)) then - begin - EnumFormat.Reset; - while EnumFormat.Next(1, Format, @Fetched) = S_OK do - begin - SetLength(Formats, Length(Formats) + 1); - Formats[High(Formats)] := Format.cfFormat; - end; - - InsertData(Tree, DataObject, Formats, DROPEFFECT_COPY, Tree.DefaultPasteMode); - end; - end; - end - else - if ActiveControl = RichEdit1 then - RichEdit1.PasteFromClipboard; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: string); - -var - Data: PNodeData; - -begin - if TextType = ttNormal then - begin - Data := Sender.GetNodeData(Node); - CellText := Data.Caption; - end - else - Text := ''; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.FormCreate(Sender: TObject); - -var - Stream: TResourceStream; - -begin - Tree1.NodeDataSize := SizeOf(TNodeData); - Tree1.RootNodeCount := 30; - Tree2.NodeDataSize := SizeOf(TNodeData); - Tree2.RootNodeCount := 30; - - // There is a small RTF text stored in the resource to have something to display in the rich edit control. - Stream := TResourceStream.Create(HInstance, 'RTF', 'RCDATA'); - try - RichEdit1.Lines.LoadFromStream(Stream); - finally - Stream.Free; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.AddUnicodeText(DataObject: IDataObject; Target: TVirtualStringTree; Mode: TVTNodeAttachMode); - -// This method is called when the drop handler gets called with Unicode text as only -// understandable clipboard format. This text is retrieved and splitted in lines. -// Every line is then added as new node. - -var - FormatEtc: TFormatEtc; - Medium: TStgMedium; - OLEData, - Head, Tail: PWideChar; - TargetNode, - Node: PVirtualNode; - Data: PNodeData; - -begin - if Mode <> amNowhere then - begin - // fill the structure used to get the Unicode string - with FormatEtc do - begin - cfFormat := CF_UNICODETEXT; - // no specific target device - ptd := nil; - // normal content to render - dwAspect := DVASPECT_CONTENT; - // no specific page of multipage data - lindex := -1; - // pass the data via memory - tymed := TYMED_HGLOBAL; - end; - - // Check if we can get the Unicode text data. - if DataObject.QueryGetData(FormatEtc) = S_OK then - begin - // Data is accessible so finally get a pointer to it - if DataObject.GetData(FormatEtc, Medium) = S_OK then - begin - OLEData := GlobalLock(Medium.hGlobal); - if Assigned(OLEData) then - begin - Target.BeginUpdate; - TargetNode := Target.DropTargetNode; - if TargetNode = nil then - TargetNode := Target.FocusedNode; - - Head := OLEData; - try - while Head^ <> #0 do - begin - Tail := Head; - while not CharInSet(Tail^, [WideChar(#0), WideChar(#13), WideChar(#10), WideChar(#9)]) do - Inc(Tail); - if Head <> Tail then - begin - // add a new node if we got a non-empty caption - Node := Target.InsertNode(TargetNode, Mode); - Data := Target.GetNodeData(Node); - SetString(Data.Caption, Head, Tail - Head); - end; - // Skip any tab. - if Tail^ = #9 then - Inc(Tail); - // skip line separators - if Tail^ = #13 then - Inc(Tail); - if Tail^ = #10 then - Inc(Tail); - Head := Tail; - end; - finally - GlobalUnlock(Medium.hGlobal); - Target.EndUpdate; - end; - end; - // never forget to free the storage medium - ReleaseStgMedium(Medium); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.AddVCLText(Target: TVirtualStringTree; const Text: UnicodeString; Mode: TVTNodeAttachMode); - -// This method is called when the drop handler gets called with a VCL drag source. -// The given text is retrieved and splitted in lines. - -var - Head, Tail: PWideChar; - TargetNode, - Node: PVirtualNode; - Data: PNodeData; - -begin - if Mode <> amNowhere then - begin - Target.BeginUpdate; - try - TargetNode := Target.DropTargetNode; - if TargetNode = nil then - TargetNode := Target.FocusedNode; - - Head := PWideChar(Text); - while Head^ <> #0 do - begin - Tail := Head; - while not CharInSet(Tail^, [WideChar(#0), WideChar(#13), WideChar(#10)]) do - Inc(Tail); - if Head <> Tail then - begin - // add a new node if we got a non-empty caption - Node := Target.InsertNode(TargetNode, Mode); - Data := Target.GetNodeData(Node); - SetString(Data.Caption, Head, Tail - Head); - end; - // skip line separators - if Tail^ = #13 then - Inc(Tail); - if Tail^ = #10 then - Inc(Tail); - Head := Tail; - end; - finally - Target.EndUpdate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TMainForm.FindCPFormatDescription(CPFormat: Word): string; - -var - Buffer: array[0..2048] of Char; - -begin - // Try the formats support the by Virtual Treeview first. - Result := GetVTClipboardFormatDescription(CPFormat); - - // Retrieve additional formats from system. - if Length(Result) = 0 then - begin - if GetClipboardFormatName(CPFormat, @Buffer, 2048) > 0 then - Result := ' - ' + Buffer - else - Result := Format(' - unknown format (%d)', [CPFormat]); - end - else - Result := ' - ' + Result; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.TreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; - Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); - - //--------------- local function -------------------------------------------- - - procedure DetermineEffect; - - // Determine the drop effect to use if the source is a Virtual Treeview. - - begin - // In the case the source is a Virtual Treeview we know 'move' is the default if dragging within - // the same tree and copy if dragging to another tree. Set Effect accordingly. - if Shift = [] then - begin - // No modifier key, so use standard action. - if Source = Sender then - Effect := DROPEFFECT_MOVE - else - Effect := DROPEFFECT_COPY; - end - else - begin - // A modifier key is pressed, hence use this to determine action. - if (Shift = [ssAlt]) or (Shift = [ssCtrl, ssAlt]) then - Effect := DROPEFFECT_LINK - else - if Shift = [ssCtrl] then - Effect := DROPEFFECT_COPY - else - Effect := DROPEFFECT_MOVE; - end; - end; - - //--------------- end local function ---------------------------------------- - -var - S: string; - Attachmode: TVTNodeAttachMode; - Nodes: TNodeArray; - I: Integer; - -begin - Nodes := nil; - - if LogListBox.Items.Count > 0 then - LogListBox.Items.Add(''); - if Sender = Tree1 then - LogListBox.Items.Add('----- Tree 1') - else - LogListBox.Items.Add('----- Tree 2'); - - if DataObject = nil then - LogListBox.Items.Add('VCL drop arrived') - else - LogListBox.Items.Add('OLE drop arrived'); - - S := 'Drop actions allowed:'; - if Boolean(DROPEFFECT_COPY and Effect) then - S := S + ' copy'; - if Boolean(DROPEFFECT_MOVE and Effect) then - S := S + ' move'; - if Boolean(DROPEFFECT_LINK and Effect) then - S := S + ' link'; - LogListBox.Items.Add(S); - - S := 'Drop mode: ' + GetEnumName(TypeInfo(TDropMode), Ord(Mode)); - LogListBox.Items.Add(S); - - // Translate the drop position into an node attach mode. - case Mode of - dmAbove: - AttachMode := amInsertBefore; - dmOnNode: - AttachMode := amAddChildLast; - dmBelow: - AttachMode := amInsertAfter; - else - AttachMode := amNowhere; - end; - - if DataObject = nil then - begin - // VCL drag'n drop. Handling this requires detailed knowledge about the sender and its data. This is one reason - // why it was a bad decision by Borland to implement something own instead using the system's way. - // In this demo we have two known sources of VCL dd data: Tree2 and LogListBox. - if Source = Tree2 then - begin - // Since we know this is a Virtual Treeview we can ignore the drop event entirely and use VT mechanisms. - DetermineEffect; - Nodes := Tree2.GetSortedSelection(True); - if Effect = DROPEFFECT_COPY then - begin - for I := 0 to High(Nodes) do - Tree2.CopyTo(Nodes[I], Sender.DropTargetNode, AttachMode, False); - end - else - for I := 0 to High(Nodes) do - Tree2.MoveTo(Nodes[I], Sender.DropTargetNode, AttachMode, False); - end - else - begin - // One long string (one node) is added, containing all text currently in the list box. - AddVCLText(Sender as TVirtualStringTree, LogListBox.Items.CommaText, AttachMode); - LogListBox.Items.Add('List box data accepted as string.'); - end; - end - else - begin - // OLE drag'n drop. Perform full processing. - - LogListBox.Items.Add('There are ' + IntToStr(Length(Formats)) + ' formats available:'); - - // Determine action in advance even if we don't use the dropped data. - // Note: The Effect parameter is a variable which must be set to the action we - // will actually take, to notify the sender of the drag operation about remaining actions. - // This value determines what the caller will do after the method returns, - // e.g. if DROPEFFECT_MOVE is returned then the source data will be deleted. - if Source is TBaseVirtualTree then - begin - DetermineEffect; - end - else - // Prefer copy if allowed for every other drag source. Alone from Effect you cannot determine the standard action - // of the sender, but we assume if copy is allowed then it is also the standard action - // (e.g. as in TRichEdit). - if Boolean(Effect and DROPEFFECT_COPY) then - Effect := DROPEFFECT_COPY - else - Effect := DROPEFFECT_MOVE; - - InsertData(Sender as TVirtualStringTree, DataObject, Formats, Effect, AttachMode); - end; - - // scroll last added entry into view - LogListBox.ItemIndex := LogListBox.Items.Count - 1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.Button2Click(Sender: TObject); - -begin - LogListBox.Clear; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.TreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; - var InitialStates: TVirtualNodeInitStates); - -var - Data: PNodeData; - -begin - Data := Sender.GetNodeData(Node); - // set a generic caption only if there is not already one (e.g. from drag operations) - if Length(Data.Caption) = 0 then - Data.Caption := Format('Node Index %d', [Node.Index]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: string); - -var - Data: PNodeData; - -// Tree1 as well as Tree2 use the soSaveCaptions StringOption which enables automatic caption store action -// when tree data is serialized into memory (e.g. for drag'n drop). Restoring the caption is done by triggering -// this event for each loaded node. -// This mechanism frees us from implementing a SaveNode and LoadNode event since we have only the caption to store. - -begin - Data := Sender.GetNodeData(Node); - Data.Caption := NewText; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.Button3Click(Sender: TObject); - -begin - with FontDialog do - begin - Font := Tree1.Font; - if Execute then - begin - Tree1.Font := Font; - Tree2.Font := Font; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.Tree2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); - -// Tree 2 uses manual drag start to tell which node might be dragged. - -begin - Allowed := Odd(Node.Index); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.TreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; - Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean); - -begin - Accept := True; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.Tree2BeforeItemErase(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; - var ItemColor: TColor; var EraseAction: TItemEraseAction); - -// The second tree uses manual drag and we want to show the lines which are allowed to start a drag operation by -// a colored background. - -begin - if Odd(Node.Index) then - begin - ItemColor := $FFEEEE; - EraseAction := eaColor; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TMainForm.InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray; - Effect: Integer; Mode: TVTNodeAttachMode); - -var - FormatAccepted: Boolean; - I: Integer; - -begin - // Go through each available format and see if we can make sense of it. - FormatAccepted := False; - for I := 0 to High(Formats) do - begin - case Formats[I] of - // standard clipboard formats - CF_UNICODETEXT: - begin - LogListBox.Items.Add(' - Unicode text'); - - // As demonstration for non-tree data here an implementation for Unicode text. - // Formats are placed in preferred order in the formats parameter. Hence if - // there is native tree data involved in this drop operation then it has been - // caught earlier in the loop and FormatAccepted is already True. - if not FormatAccepted then - begin - // Unicode text data was dropped (e.g. from RichEdit1) add this line by line - // as new nodes. - AddUnicodeText(DataObject, Sender as TVirtualStringTree, Mode); - LogListBox.Items.Add('+ Unicode accepted'); - FormatAccepted := True; - end; - end; - else - if Formats[I] = CF_VIRTUALTREE then - begin - // this is our native tree format - LogListBox.Items.Add(' - native Virtual Treeview data'); - - if not FormatAccepted then - begin - Sender.ProcessDrop(DataObject, Sender.DropTargetNode, Effect, Mode); - LogListBox.Items.Add('+ native Virtual Treeview data accepted'); - // Indicate that we found a format we accepted so the data is not used twice. - FormatAccepted := True; - end; - end - else - if Formats[I] = CF_VTREFERENCE then - LogListBox.Items.Add(' - Virtual Treeview reference') - else - begin - // Predefined, shell specific, MIME specific or application specific clipboard data. - LogListBox.Items.Add(FindCPFormatDescription(Formats[I])); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -end. - - - - - - +unit Main; + +// Virtual Treeview sample application demonstrating clipboard and drag'n drop operations. +// The treeview uses OLE for these operations but can also issue and accept VCL drag'n drop. +// Written by Mike Lischke. + +interface + +uses + Winapi.Windows, Winapi.Messages, Winapi.ActiveX, System.SysUtils, Vcl.Forms, + Vcl.Dialogs, Vcl.Graphics, VirtualTrees, Vcl.ActnList, Vcl.ComCtrls, + Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Controls, System.Classes, Vcl.ImgList, + System.Actions, System.ImageList, VirtualTrees.BaseAncestorVCL, + VirtualTrees.BaseTree, VirtualTrees.AncestorVCL, VirtualTrees.Types; + +type + TMainForm = class(TForm) + ActionList1: TActionList; + CutAction: TAction; + CopyAction: TAction; + PasteAction: TAction; + FontDialog: TFontDialog; + Panel3: TPanel; + Label6: TLabel; + Button1: TButton; + Button3: TButton; + Tree2: TVirtualStringTree; + Label1: TLabel; + Tree1: TVirtualStringTree; + Label2: TLabel; + PageControl1: TPageControl; + LogTabSheet: TTabSheet; + RichTextTabSheet: TTabSheet; + LogListBox: TListBox; + RichEdit1: TRichEdit; + Label3: TLabel; + Label7: TLabel; + Button2: TButton; + TabSheet1: TTabSheet; + Label8: TLabel; + TabSheet2: TTabSheet; + Label4: TLabel; + Label5: TLabel; + Label9: TLabel; + Label10: TLabel; + TreeImages: TImageList; + procedure Button1Click(Sender: TObject); + procedure CutActionExecute(Sender: TObject); + procedure CopyActionExecute(Sender: TObject); + procedure PasteActionExecute(Sender: TObject); + procedure Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: string); + procedure FormCreate(Sender: TObject); + procedure TreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: TVTDragDataObject; + Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); + procedure Button2Click(Sender: TObject); + procedure TreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates); + procedure TreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: string); + procedure Button3Click(Sender: TObject); + procedure Tree2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); + procedure TreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; + Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean); + procedure Tree2BeforeItemErase(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; + var ItemColor: TColor; var EraseAction: TItemEraseAction); + private + procedure AddUnicodeText(DataObject: IDataObject; Target: TVirtualStringTree; Mode: TVTNodeAttachMode); + procedure AddVCLText(Target: TVirtualStringTree; const Text: UnicodeString; Mode: TVTNodeAttachMode); + function FindCPFormatDescription(CPFormat: Word): string; + procedure InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray; Effect: Integer; + Mode: TVTNodeAttachMode); + end; + +var + MainForm: TMainForm; + +//---------------------------------------------------------------------------------------------------------------------- + +implementation + +uses + TypInfo, ShlObj, UrlMon, VirtualTrees.ClipBoard; + +{$R *.DFM} +{$R Res\Extra.res} // Contains a little rich text for the rich edit control and a XP manifest. + +type + PNodeData = ^TNodeData; + TNodeData = record + Caption: UnicodeString; + end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.Button1Click(Sender: TObject); + +begin + Close; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.CutActionExecute(Sender: TObject); + +begin + if ActiveControl = Tree1 then + Tree1.CutToClipboard + else + if ActiveControl = Tree2 then + Tree2.CutToClipboard + else + if ActiveControl = RichEdit1 then + RichEdit1.CutToClipboard; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.CopyActionExecute(Sender: TObject); + +begin + if ActiveControl = Tree1 then + Tree1.CopyToClipboard + else + if ActiveControl = Tree2 then + Tree2.CopyToClipboard + else + if ActiveControl = RichEdit1 then + RichEdit1.CopyToClipboard; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.PasteActionExecute(Sender: TObject); + +var + DataObject: IDataObject; + EnumFormat: IEnumFormatEtc; + Format: TFormatEtc; + Formats: TFormatArray; + Fetched: Integer; + Tree: TVirtualStringTree; + +begin + if ActiveControl is TVirtualStringTree then + begin + Tree := ActiveControl as TVirtualStringTree; + + if LogListBox.Items.Count > 0 then + LogListBox.Items.Add(''); + if ActiveControl = Tree1 then + LogListBox.Items.Add('----- Tree 1') + else + LogListBox.Items.Add('----- Tree 2'); + + if Tree.PasteFromClipboard then + LogListBox.Items.Add('Native tree data pasted.') + else + begin + LogListBox.Items.Add('Other data pasted.'); + // Some other data was pasted. Enumerate the available formats and try to add the data. + // 1) Get a data object for the data. + OLEGetClipboard(DataObject); + // 2) Enumerate all offered formats and create a format array from it which can be used in InsertData. + if Succeeded(DataObject.EnumFormatEtc(DATADIR_GET, EnumFormat)) then + begin + EnumFormat.Reset; + while EnumFormat.Next(1, Format, @Fetched) = S_OK do + begin + SetLength(Formats, Length(Formats) + 1); + Formats[High(Formats)] := Format.cfFormat; + end; + + InsertData(Tree, DataObject, Formats, DROPEFFECT_COPY, Tree.DefaultPasteMode); + end; + end; + end + else + if ActiveControl = RichEdit1 then + RichEdit1.PasteFromClipboard; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: string); + +var + Data: PNodeData; + +begin + if TextType = ttNormal then + begin + Data := Sender.GetNodeData(Node); + CellText := Data.Caption; + end + else + Text := ''; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.FormCreate(Sender: TObject); + +var + Stream: TResourceStream; + +begin + Tree1.NodeDataSize := SizeOf(TNodeData); + Tree1.RootNodeCount := 30; + Tree2.NodeDataSize := SizeOf(TNodeData); + Tree2.RootNodeCount := 30; + + ReportMemoryLeaksOnShutdown := True; + // There is a small RTF text stored in the resource to have something to display in the rich edit control. + Stream := TResourceStream.Create(HInstance, 'RTF', 'RCDATA'); + try + RichEdit1.Lines.LoadFromStream(Stream); + finally + Stream.Free; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.AddUnicodeText(DataObject: IDataObject; Target: TVirtualStringTree; Mode: TVTNodeAttachMode); + +// This method is called when the drop handler gets called with Unicode text as only +// understandable clipboard format. This text is retrieved and splitted in lines. +// Every line is then added as new node. + +var + FormatEtc: TFormatEtc; + Medium: TStgMedium; + OLEData, + Head, Tail: PWideChar; + TargetNode, + Node: PVirtualNode; + Data: PNodeData; + +begin + if Mode <> amNowhere then + begin + // fill the structure used to get the Unicode string + with FormatEtc do + begin + cfFormat := CF_UNICODETEXT; + // no specific target device + ptd := nil; + // normal content to render + dwAspect := DVASPECT_CONTENT; + // no specific page of multipage data + lindex := -1; + // pass the data via memory + tymed := TYMED_HGLOBAL; + end; + + // Check if we can get the Unicode text data. + if DataObject.QueryGetData(FormatEtc) = S_OK then + begin + // Data is accessible so finally get a pointer to it + if DataObject.GetData(FormatEtc, Medium) = S_OK then + begin + OLEData := GlobalLock(Medium.hGlobal); + if Assigned(OLEData) then + begin + Target.BeginUpdate; + TargetNode := Target.DropTargetNode; + if TargetNode = nil then + TargetNode := Target.FocusedNode; + + Head := OLEData; + try + while Head^ <> #0 do + begin + Tail := Head; + while not CharInSet(Tail^, [WideChar(#0), WideChar(#13), WideChar(#10), WideChar(#9)]) do + Inc(Tail); + if Head <> Tail then + begin + // add a new node if we got a non-empty caption + Node := Target.InsertNode(TargetNode, Mode); + Data := Target.GetNodeData(Node); + SetString(Data.Caption, Head, Tail - Head); + end; + // Skip any tab. + if Tail^ = #9 then + Inc(Tail); + // skip line separators + if Tail^ = #13 then + Inc(Tail); + if Tail^ = #10 then + Inc(Tail); + Head := Tail; + end; + finally + GlobalUnlock(Medium.hGlobal); + Target.EndUpdate; + end; + end; + // never forget to free the storage medium + ReleaseStgMedium(Medium); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.AddVCLText(Target: TVirtualStringTree; const Text: UnicodeString; Mode: TVTNodeAttachMode); + +// This method is called when the drop handler gets called with a VCL drag source. +// The given text is retrieved and splitted in lines. + +var + Head, Tail: PWideChar; + TargetNode, + Node: PVirtualNode; + Data: PNodeData; + +begin + if Mode <> amNowhere then + begin + Target.BeginUpdate; + try + TargetNode := Target.DropTargetNode; + if TargetNode = nil then + TargetNode := Target.FocusedNode; + + Head := PWideChar(Text); + while Head^ <> #0 do + begin + Tail := Head; + while not CharInSet(Tail^, [WideChar(#0), WideChar(#13), WideChar(#10)]) do + Inc(Tail); + if Head <> Tail then + begin + // add a new node if we got a non-empty caption + Node := Target.InsertNode(TargetNode, Mode); + Data := Target.GetNodeData(Node); + SetString(Data.Caption, Head, Tail - Head); + end; + // skip line separators + if Tail^ = #13 then + Inc(Tail); + if Tail^ = #10 then + Inc(Tail); + Head := Tail; + end; + finally + Target.EndUpdate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TMainForm.FindCPFormatDescription(CPFormat: Word): string; + +var + Buffer: array[0..2048] of Char; + +begin + // Try the formats support the by Virtual Treeview first. + Result := GetVTClipboardFormatDescription(CPFormat); + + // Retrieve additional formats from system. + if Length(Result) = 0 then + begin + if GetClipboardFormatName(CPFormat, @Buffer, 2048) > 0 then + Result := ' - ' + Buffer + else + Result := Format(' - unknown format (%d)', [CPFormat]); + end + else + Result := ' - ' + Result; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.TreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: TVTDragDataObject; + Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); + + //--------------- local function -------------------------------------------- + + procedure DetermineEffect; + + // Determine the drop effect to use if the source is a Virtual Treeview. + + begin + // In the case the source is a Virtual Treeview we know 'move' is the default if dragging within + // the same tree and copy if dragging to another tree. Set Effect accordingly. + if Shift = [] then + begin + // No modifier key, so use standard action. + if Source = Sender then + Effect := DROPEFFECT_MOVE + else + Effect := DROPEFFECT_COPY; + end + else + begin + // A modifier key is pressed, hence use this to determine action. + if (Shift = [ssAlt]) or (Shift = [ssCtrl, ssAlt]) then + Effect := DROPEFFECT_LINK + else + if Shift = [ssCtrl] then + Effect := DROPEFFECT_COPY + else + Effect := DROPEFFECT_MOVE; + end; + end; + + //--------------- end local function ---------------------------------------- + +var + S: string; + Attachmode: TVTNodeAttachMode; + Nodes: TNodeArray; + I: Integer; + +begin + Nodes := nil; + + if LogListBox.Items.Count > 0 then + LogListBox.Items.Add(''); + if Sender = Tree1 then + LogListBox.Items.Add('----- Tree 1') + else + LogListBox.Items.Add('----- Tree 2'); + + if DataObject = nil then + LogListBox.Items.Add('VCL drop arrived') + else + LogListBox.Items.Add('OLE drop arrived'); + + S := 'Drop actions allowed:'; + if Boolean(DROPEFFECT_COPY and Effect) then + S := S + ' copy'; + if Boolean(DROPEFFECT_MOVE and Effect) then + S := S + ' move'; + if Boolean(DROPEFFECT_LINK and Effect) then + S := S + ' link'; + LogListBox.Items.Add(S); + + S := 'Drop mode: ' + GetEnumName(TypeInfo(TDropMode), Ord(Mode)); + LogListBox.Items.Add(S); + + // Translate the drop position into an node attach mode. + case Mode of + dmAbove: + AttachMode := amInsertBefore; + dmOnNode: + AttachMode := amAddChildLast; + dmBelow: + AttachMode := amInsertAfter; + else + AttachMode := amNowhere; + end; + + if DataObject = nil then + begin + // VCL drag'n drop. Handling this requires detailed knowledge about the sender and its data. This is one reason + // why it was a bad decision by Borland to implement something own instead using the system's way. + // In this demo we have two known sources of VCL dd data: Tree2 and LogListBox. + if Source = Tree2 then + begin + // Since we know this is a Virtual Treeview we can ignore the drop event entirely and use VT mechanisms. + DetermineEffect; + Nodes := Tree2.GetSortedSelection(True); + if Effect = DROPEFFECT_COPY then + begin + for I := 0 to High(Nodes) do + Tree2.CopyTo(Nodes[I], Sender.DropTargetNode, AttachMode, False); + end + else + for I := 0 to High(Nodes) do + Tree2.MoveTo(Nodes[I], Sender.DropTargetNode, AttachMode, False); + end + else + begin + // One long string (one node) is added, containing all text currently in the list box. + AddVCLText(Sender as TVirtualStringTree, LogListBox.Items.CommaText, AttachMode); + LogListBox.Items.Add('List box data accepted as string.'); + end; + end + else + begin + // OLE drag'n drop. Perform full processing. + + LogListBox.Items.Add('There are ' + IntToStr(Length(Formats)) + ' formats available:'); + + // Determine action in advance even if we don't use the dropped data. + // Note: The Effect parameter is a variable which must be set to the action we + // will actually take, to notify the sender of the drag operation about remaining actions. + // This value determines what the caller will do after the method returns, + // e.g. if DROPEFFECT_MOVE is returned then the source data will be deleted. + if Source is TBaseVirtualTree then + begin + DetermineEffect; + end + else + // Prefer copy if allowed for every other drag source. Alone from Effect you cannot determine the standard action + // of the sender, but we assume if copy is allowed then it is also the standard action + // (e.g. as in TRichEdit). + if Boolean(Effect and DROPEFFECT_COPY) then + Effect := DROPEFFECT_COPY + else + Effect := DROPEFFECT_MOVE; + + InsertData(Sender as TVirtualStringTree, DataObject, Formats, Effect, AttachMode); + end; + + // scroll last added entry into view + LogListBox.ItemIndex := LogListBox.Items.Count - 1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.Button2Click(Sender: TObject); + +begin + LogListBox.Clear; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.TreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates); + +var + Data: PNodeData; + +begin + Data := Sender.GetNodeData(Node); + // set a generic caption only if there is not already one (e.g. from drag operations) + if Length(Data.Caption) = 0 then + Data.Caption := Format('Node Index %d', [Node.Index]); +end; + +//---------------------------------------------------------------------------------------------------------------------- +procedure TMainForm.TreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + +var + Data: PNodeData; + +begin + Data := Sender.GetNodeData(Node); + Data.Caption := ''; // Removes the caption, otherwise, memory leak. +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: string); + +var + Data: PNodeData; + +// Tree1 as well as Tree2 use the soSaveCaptions StringOption which enables automatic caption store action +// when tree data is serialized into memory (e.g. for drag'n drop). Restoring the caption is done by triggering +// this event for each loaded node. +// This mechanism frees us from implementing a SaveNode and LoadNode event since we have only the caption to store. + +begin + Data := Sender.GetNodeData(Node); + Data.Caption := NewText; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.Button3Click(Sender: TObject); + +begin + with FontDialog do + begin + Font := Tree1.Font; + if Execute then + begin + Tree1.Font := Font; + Tree2.Font := Font; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.Tree2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); + +// Tree 2 uses manual drag start to tell which node might be dragged. + +begin + Allowed := Odd(Node.Index); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.TreeDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; + Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean); + +begin + Accept := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.Tree2BeforeItemErase(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; + var ItemColor: TColor; var EraseAction: TItemEraseAction); + +// The second tree uses manual drag and we want to show the lines which are allowed to start a drag operation by +// a colored background. + +begin + if Odd(Node.Index) then + begin + ItemColor := $FFEEEE; + EraseAction := eaColor; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TMainForm.InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray; + Effect: Integer; Mode: TVTNodeAttachMode); + +var + FormatAccepted: Boolean; + I: Integer; + +begin + // Go through each available format and see if we can make sense of it. + FormatAccepted := False; + for I := 0 to High(Formats) do + begin + case Formats[I] of + // standard clipboard formats + CF_UNICODETEXT: + begin + LogListBox.Items.Add(' - Unicode text'); + + // As demonstration for non-tree data here an implementation for Unicode text. + // Formats are placed in preferred order in the formats parameter. Hence if + // there is native tree data involved in this drop operation then it has been + // caught earlier in the loop and FormatAccepted is already True. + if not FormatAccepted then + begin + // Unicode text data was dropped (e.g. from RichEdit1) add this line by line + // as new nodes. + AddUnicodeText(DataObject, Sender as TVirtualStringTree, Mode); + LogListBox.Items.Add('+ Unicode accepted'); + FormatAccepted := True; + end; + end; + else + if Formats[I] = CF_VIRTUALTREE then + begin + // this is our native tree format + LogListBox.Items.Add(' - native Virtual Treeview data'); + + if not FormatAccepted then + begin + Sender.ProcessDrop(DataObject, Sender.DropTargetNode, Effect, Mode); + LogListBox.Items.Add('+ native Virtual Treeview data accepted'); + // Indicate that we found a format we accepted so the data is not used twice. + FormatAccepted := True; + end; + end + else + if Formats[I] = CF_VTREFERENCE then + LogListBox.Items.Add(' - Virtual Treeview reference') + else + begin + // Predefined, shell specific, MIME specific or application specific clipboard data. + LogListBox.Items.Add(FindCPFormatDescription(Formats[I])); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +end. + + + + + + diff --git a/Demos/OLE/OLE.dproj b/Demos/OLE/OLE.dproj index 60b5bde2a..772b60813 100644 --- a/Demos/OLE/OLE.dproj +++ b/Demos/OLE/OLE.dproj @@ -1,14 +1,15 @@  - {3C00F0E3-8F50-46FC-A49D-A7B9DC7DF0A7} - OLE.dpr True - Debug - 1 Application + Debug VCL - 16.0 + OLE.dpr Win32 + {3C00F0E3-8F50-46FC-A49D-A7B9DC7DF0A7} + 20.2 + 1 + OLE true @@ -18,11 +19,6 @@ Base true - - true - Base - true - true Base @@ -33,41 +29,45 @@ Base true + + true + Cfg_2 + true + true + OLE - 1 - false - 1031 - vcl;rtl;vclx;$(DCC_UsePackage) - false - 3 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 00400000 + 3 Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) - false - false + 1 ..\..\Source;$(DCC_UnitSearchPath) - true + vcl;rtl;vclx;$(DCC_UsePackage) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 1031 - 1033 - true + true System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) $(BDS)\bin\default_app.manifest - - - OLE_Icon.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + true + 1033 - 0 - false - RELEASE;$(DCC_Define) 0 + RELEASE;$(DCC_Define) + false + 0 + DEBUG;$(DCC_Define) true false - DEBUG;$(DCC_Define) + + + Debug @@ -76,10 +76,6 @@
MainForm
 - - Cfg_2 - Base - Base @@ -87,6 +83,10 @@ Cfg_1 Base + + Cfg_2 + Base + Delphi.Personality.12 diff --git a/Demos/Objects/MVCDemo.dproj b/Demos/Objects/MVCDemo.dproj index 7f1bdc9dc..dfc5c6ff2 100644 --- a/Demos/Objects/MVCDemo.dproj +++ b/Demos/Objects/MVCDemo.dproj @@ -4,11 +4,12 @@ MVCDemo.dpr True Debug - 1 + 3 Application VCL - 14.4 + 20.2 Win32 + MVCDemo true @@ -33,6 +34,18 @@ Base true + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + 1 false @@ -47,28 +60,41 @@ false ..\..\Source;$(DCC_UnitSearchPath) true + MVCDemo 1033 true - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) $(BDS)\bin\default_app.manifest - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png MVCDemo_Icon.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 0 false RELEASE;$(DCC_Define) - false + 0 true false DEBUG;$(DCC_Define) + + Debug + + + Debug + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\default_app.manifest + PerMonitorV2 + MainSource @@ -77,10 +103,6 @@
fmMVCDemo
- - Cfg_2 - Base - Base @@ -88,6 +110,10 @@ Cfg_1 Base + + Cfg_2 + Base + Delphi.Personality.12 @@ -124,10 +150,14 @@ 1.0.0.0 + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + True - False + True 12 diff --git a/Demos/Objects/MVCDemoMain.pas b/Demos/Objects/MVCDemoMain.pas index 80f27d6a8..5fdee2ff8 100644 --- a/Demos/Objects/MVCDemoMain.pas +++ b/Demos/Objects/MVCDemoMain.pas @@ -15,7 +15,7 @@ interface uses Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs, MVCTypes,MVCPanel,StdCtrls,ExtCtrls,ImgList,VirtualTrees,ComCtrls, - Buttons; + Buttons, System.ImageList; type TfmMVCDemo=class(TForm) pnlControls:TPanel; diff --git a/Demos/Objects/MVCPanel.pas b/Demos/Objects/MVCPanel.pas index 5f2773524..8b09cd108 100644 --- a/Demos/Objects/MVCPanel.pas +++ b/Demos/Objects/MVCPanel.pas @@ -24,7 +24,7 @@ interface uses Windows,Controls,Graphics,SysUtils,Classes,ExtCtrls,StdCtrls, - MVCTypes,VirtualTrees; + MVCTypes,VirtualTrees, VirtualTrees.BaseTree; type TMVCPanel=class(TCustomPanel) private @@ -85,24 +85,24 @@ procedure TMVCPanel.CreateWnd; with FtrvItems, TreeOptions do begin - PaintOptions:=PaintOptions+[toShowButtons, // display collapse/expand - toShowHorzGridLines, // display horizontal lines - toShowRoot, // show lines also at root level - toShowTreeLines, // display tree lines to show - // hierarchy of nodes - // buttons left to a node - toShowVertGridLines]; // display vertical lines - // (depending on columns) to - // simulate a grid - MiscOptions := MiscOptions+[toEditable]; - SelectionOptions := SelectionOptions+[toExtendedFocus]; + PaintOptions:=PaintOptions+[TVTPaintOption.toShowButtons, // display collapse/expand + TVTPaintOption.toShowHorzGridLines, // display horizontal lines + TVTPaintOption.toShowRoot, // show lines also at root level + TVTPaintOption.toShowTreeLines, // display tree lines to show + // hierarchy of nodes + // buttons left to a node + TVTPaintOption.toShowVertGridLines]; // display vertical lines + // (depending on columns) to + // simulate a grid + MiscOptions := MiscOptions + [TVTMiscOption.toEditable]; + SelectionOptions := SelectionOptions + [TVTSelectionOption.toExtendedFocus]; // to simulate a grid with Header do begin - Height:=18; - Options:=Options+[hoVisible]; - Background:=clBtnFace; - AutoSize:=True; + Height := 18; + Options := Options + [TVTHeaderOption.hoVisible]; + Background := clBtnFace; + AutoSize := True; with Columns.Add do begin Text:='Caption'; diff --git a/Demos/Objects/MVCTypes.pas b/Demos/Objects/MVCTypes.pas index 20df93d71..bb39264e8 100644 --- a/Demos/Objects/MVCTypes.pas +++ b/Demos/Objects/MVCTypes.pas @@ -55,7 +55,7 @@ interface uses Windows,Messages,SysUtils,Graphics,VirtualTrees,Classes,StdCtrls, - Controls,Forms,ImgList, + Controls,Forms,ImgList, VirtualTrees.Types, VirtualTrees.BaseTree, System.Types, System.UITypes; type { TMVCNode is the encapsulation of a single Node in the structure. @@ -191,7 +191,7 @@ TMVCTree=class the functionality that is moved to our code, should you be happy with any of the predeclared descendants use of them. } TMVCEditLink=class; - TMVCTreeView=class(TBaseVirtualTree) + TMVCTreeView=class(TVTAncestor) private { This is a pointer to the structure associated with this viewer. } @@ -627,7 +627,7 @@ procedure TMVCTreeView.DoPaintNode(var PaintInfo: TVTPaintInfo); { Some shuffling of feet and rectangles. Try for yourself what happens here be adding offsets, changing colors etc.. } - if (toHotTrack in Self.TreeOptions.PaintOptions) and + if (TVTPaintOption.toHotTrack in Self.TreeOptions.PaintOptions) and (Node=HotNode) then Font.Style:=Font.Style+[fsUnderline] else Font.Style:=Font.Style-[fsUnderline]; @@ -669,7 +669,7 @@ procedure TMVCTreeView.DoPaintNode(var PaintInfo: TVTPaintInfo); if Focused and (FocusedNode=Node) and - not(toFullRowSelect in Self.TreeOptions.SelectionOptions) + not (TVTSelectionOption.toFullRowSelect in Self.TreeOptions.SelectionOptions) then begin if Self.Color=clGray diff --git a/Demos/VirtualTreeview.bdsgroup b/Demos/VirtualTreeview.bdsgroup deleted file mode 100644 index 6650fbaf1..000000000 --- a/Demos/VirtualTreeview.bdsgroup +++ /dev/null @@ -1,21 +0,0 @@ - - - - - - - - - - - ..\..\Library\VirtualTreeview\Packages\BDS 2006\VirtualTreesR.bdsproj - ..\..\Library\VirtualTreeview\Packages\BDS 2006\VirtualTreesD.bdsproj - Advanced\Advanced.bdsproj - VirtualTreesR.bpl VirtualTreesD.bpl Advanced.exe - - - - - - diff --git a/Demos/VirtualTreeview.bpg b/Demos/VirtualTreeview.bpg deleted file mode 100644 index 34034afa7..000000000 --- a/Demos/VirtualTreeview.bpg +++ /dev/null @@ -1,35 +0,0 @@ -#------------------------------------------------------------------------------ -VERSION = BWS.01 -#------------------------------------------------------------------------------ -!ifndef ROOT -ROOT = $(MAKEDIR)\.. -!endif -#------------------------------------------------------------------------------ -MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** -DCC = $(ROOT)\bin\dcc32.exe $** -BRCC = $(ROOT)\bin\brcc32.exe $** -#------------------------------------------------------------------------------ -PROJECTS = VirtualTreesD7.bpl VirtualTreesD7D.bpl Minimal.exe MVCDemo.exe OLE.exe Advanced.exe -#------------------------------------------------------------------------------ -default: $(PROJECTS) -#------------------------------------------------------------------------------ - -Advanced.exe: Advanced\Advanced.dpr - $(DCC) - -Minimal.exe: Minimal\Minimal.dpr - $(DCC) - -MVCDemo.exe: Objects\MVCDemo.dpr - $(DCC) - -VirtualTreesD7.bpl: ..\..\Library\VirtualTreeview\Delphi\VirtualTreesD7.dpk - $(DCC) - -VirtualTreesD7D.bpl: ..\..\Library\VirtualTreeview\Delphi\VirtualTreesD7D.dpk - $(DCC) - -OLE.exe: OLE\OLE.dpr - $(DCC) - - diff --git a/Design/VirtualTreesReg.pas b/Design/VirtualTreesReg.pas index 094fe6351..af421246d 100644 --- a/Design/VirtualTreesReg.pas +++ b/Design/VirtualTreesReg.pas @@ -1,400 +1,523 @@ -unit VirtualTreesReg; - -// This unit is an addendum to VirtualTrees.pas and contains code of design time editors as well as -// for theirs and the tree's registration. - -interface - -// For some things to work we need code, which is classified as being unsafe for .NET. -{$warn UNSAFE_TYPE off} -{$warn UNSAFE_CAST off} -{$warn UNSAFE_CODE off} - -uses - Windows, Classes, DesignIntf, DesignEditors, VCLEditors, PropertyCategories, - ColnEdit, VirtualTrees, VirtualTrees.HeaderPopup; - -type - TVirtualTreeEditor = class (TDefaultEditor) - public - procedure Edit; override; - end; - -procedure Register; - -//---------------------------------------------------------------------------------------------------------------------- - -implementation - -uses - StrEdit, Dialogs, TypInfo, SysUtils, Graphics, CommCtrl, ImgList, Controls, - VirtualTrees.ClipBoard, VirtualTrees.Actions; - -type - // The usual trick to make a protected property accessible in the ShowCollectionEditor call below. - TVirtualTreeCast = class(TBaseVirtualTree); - - TClipboardElement = class(TNestedProperty, ICustomPropertyDrawing) - private - FElement: string; - protected - constructor Create(Parent: TPropertyEditor; AElement: string); reintroduce; - public - function AllEqual: Boolean; override; - function GetAttributes: TPropertyAttributes; override; - function GetName: string; override; - function GetValue: string; override; - procedure GetValues(Proc: TGetStrProc); override; - procedure SetValue(const Value: string); override; - - procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); - procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); - end; - - // This is a special property editor to make the strings in the clipboard format string list - // being shown as subproperties in the object inspector. This way it is shown what formats are actually available - // and the user can pick them with a simple yes/no choice. - - TGetPropEditProc = TGetPropProc; - - TClipboardFormatsProperty = class(TStringListProperty, ICustomPropertyDrawing) - public - function GetAttributes: TPropertyAttributes; override; - procedure GetProperties(Proc: TGetPropEditProc); override; - procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); - procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); - end; - - resourcestring - sVTHeaderCategoryName = 'Header'; - sVTPaintingCategoryName = 'Custom painting'; - sVTIncremenalCategoryName = 'Incremental search'; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeEditor.Edit; - -begin - ShowCollectionEditor(Designer, Component, TVirtualTreeCast(Component).Header.Columns, 'Columns'); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -constructor TClipboardElement.Create(Parent: TPropertyEditor; AElement: string); - -begin - inherited Create(Parent); - FElement := AElement; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TClipboardElement.AllEqual: Boolean; - -// Determines if this element is included or excluded in all selected components it belongs to. - -var - I, Index: Integer; - List: TClipboardFormats; - V: Boolean; - -begin - Result := False; - if PropCount > 1 then - begin - List := TClipboardFormats(GetOrdValue); - V := List.Find(FElement, Index); - for I := 1 to PropCount - 1 do - begin - List := TClipboardFormats(GetOrdValue); - if List.Find(FElement, Index) <> V then - Exit; - end; - end; - Result := True; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TClipboardElement.GetAttributes: TPropertyAttributes; - -begin - Result := [paMultiSelect, paValueList, paSortList]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TClipboardElement.GetName: string; - -begin - Result := FElement; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TClipboardElement.GetValue: string; - -var - List: TClipboardFormats; - -begin - List := TClipboardFormats(GetOrdValue); - Result := BooleanIdents[List.IndexOf(FElement) > -1]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TClipboardElement.GetValues(Proc: TGetStrProc); - -begin - Proc(BooleanIdents[False]); - Proc(BooleanIdents[True]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TClipboardElement.SetValue(const Value: string); - -var - List: TClipboardFormats; - I, Index: Integer; - -begin - if CompareText(Value, 'True') = 0 then - begin - for I := 0 to PropCount - 1 do - begin - List := TClipboardFormats(GetOrdValueAt(I)); - List.Add(FElement); - end; - end - else - begin - for I := 0 to PropCount - 1 do - begin - List := TClipboardFormats(GetOrdValueAt(I)); - if List.Find(FElement, Index) then - List.Delete(Index); - end; - end; - Modified; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure DrawBoolean(Checked: Boolean; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); - -var - BoxSize, - EntryWidth: Integer; - R: TRect; - State: Cardinal; - -begin - with ACanvas do - begin - FillRect(ARect); - - BoxSize := ARect.Bottom - ARect.Top; - EntryWidth := ARect.Right - ARect.Left; - - R := Rect(ARect.Left + (EntryWidth - BoxSize) div 2, ARect.Top, ARect.Left + (EntryWidth + BoxSize) div 2, - ARect.Bottom); - InflateRect(R, -1, -1); - State := DFCS_BUTTONCHECK; - if Checked then - State := State or DFCS_CHECKED; - DrawFrameControl(Handle, R, DFC_BUTTON, State); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TClipboardElement.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); - -begin - DefaultPropertyDrawName(Self, ACanvas, ARect); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TClipboardElement.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); - -begin - DrawBoolean(CompareText(GetVisualValue, 'True') = 0, ACanvas, ARect, ASelected); -end; - -//----------------- TClipboardFormatsProperty -------------------------------------------------------------------------- - -function TClipboardFormatsProperty.GetAttributes: TPropertyAttributes; - -begin - Result := inherited GetAttributes + [paSubProperties, paFullWidthName]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TClipboardFormatsProperty.GetProperties(Proc: TGetPropEditProc); - -var - List: TStringList; - I: Integer; - Tree: TBaseVirtualTree; - -begin - List := TStringList.Create; - Tree := TClipboardFormats(GetOrdValue).Owner; - EnumerateVTClipboardFormats(TVirtualTreeClass(Tree.ClassType), List); - for I := 0 to List.Count - 1 do - Proc(TClipboardElement.Create(Self, List[I])); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TClipboardFormatsProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); - -var - S: string; - Width: Integer; - R: TRect; - -begin - with ACanvas do - begin - Font.Name := 'Arial'; - R := ARect; - Font.Color := clBlack; - S := GetName; - Width := TextWidth(S); - TextRect(R, R.Left + 1, R.Top + 1, S); - - Inc(R.Left, Width + 8); - Font.Height := 14; - Font.Color := clBtnHighlight; - S := '(OLE drag and clipboard)'; - SetBkMode(Handle, TRANSPARENT); - ExtTextOut(Handle, R.Left + 1, R.Top + 1, ETO_CLIPPED, @R, PChar(S), Length(S), nil); - Font.Color := clBtnShadow; - ExtTextOut(Handle, R.Left, R.Top, ETO_CLIPPED, @R, PChar(S), Length(S), nil); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TClipboardFormatsProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); - -begin - // Nothing to do here. -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure Register; - -begin - RegisterComponents('Virtual Controls', [TVirtualStringTree, TVirtualDrawTree, TVTHeaderPopupMenu]); - RegisterComponentEditor(TVirtualStringTree, TVirtualTreeEditor); - RegisterComponentEditor(TVirtualDrawTree, TVirtualTreeEditor); - RegisterPropertyEditor(TypeInfo(TClipboardFormats), nil, '', TClipboardFormatsProperty); - - // Categories: - RegisterPropertiesInCategory(sActionCategoryName, TBaseVirtualTree, ['ChangeDelay', 'EditDelay']); - - RegisterPropertiesInCategory(sDataCategoryName, - TBaseVirtualTree, - ['NodeDataSize', - 'RootNodeCount', - 'OnCompareNodes', - 'OnGetNodeDataSize', - 'OnInitNode', - 'OnInitChildren', - 'OnFreeNode', - 'OnGetNodeWidth', - 'OnGetPopupMenu', - 'OnLoadNode', - 'OnSaveNode', - 'OnResetNode', - 'OnNodeMov*', - 'OnStructureChange', - 'OnUpdating', - 'OnGetText', - 'OnNewText', - 'OnShortenString']); - - RegisterPropertiesInCategory(slayoutCategoryName, - TBaseVirtualTree, - ['AnimationDuration', - 'AutoExpandDelay', - 'AutoScroll*', - 'ButtonStyle', - 'DefaultNodeHeight', - '*Images*', 'OnGetImageIndex', 'OnGetImageText', - 'Header', - 'Indent', - 'LineStyle', 'OnGetLineStyle', - 'CheckImageKind', - 'Options', - 'Margin', - 'NodeAlignment', - 'ScrollBarOptions', - 'SelectionCurveRadius', - 'TextMargin']); - - RegisterPropertiesInCategory(sVisualCategoryName, - TBaseVirtualTree, - ['Background*', - 'ButtonFillMode', - 'CustomCheckimages', - 'Colors', - 'LineMode']); - - RegisterPropertiesInCategory(sHelpCategoryName, - TBaseVirtualTree, - ['AccessibleName', 'Hint*', 'On*Hint*', 'On*Help*']); - - RegisterPropertiesInCategory(sDragNDropCategoryName, - TBaseVirtualTree, - ['ClipboardFormats', - 'DefaultPasteMode', - 'OnCreateDataObject', - 'OnCreateDragManager', - 'OnGetUserClipboardFormats', - 'OnNodeCop*', - 'OnDragAllowed', - 'OnRenderOLEData']); - - RegisterPropertiesInCategory(sInputCategoryName, - TBaseVirtualTree, - ['DefaultText', - 'DrawSelectionMode', - 'WantTabs', - 'OnChang*', - 'OnCollaps*', - 'OnExpand*', - 'OnCheck*', - 'OnEdit*', - 'On*Click', - 'OnFocus*', - 'OnCreateEditor', - 'OnScroll', - 'OnNodeHeightTracking', - 'OnHotChange']); - - RegisterPropertiesInCategory(sVTHeaderCategoryName, - TBaseVirtualTree, - ['OnHeader*', 'OnGetHeader*']); - - RegisterPropertiesInCategory(sVTPaintingCategoryName, - TBaseVirtualTree, - ['On*Paint*', - 'OnDraw*', - 'On*Erase*']); - - RegisterPropertiesInCategory(sVTIncremenalCategoryName, - TBaseVirtualTree, - ['*Incremental*']); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -end. +unit VirtualTreesReg; + +// This unit is an addendum to VirtualTrees.pas and contains code of design time editors as well as +// for theirs and the tree's registration. + +interface + +// For some things to work we need code, which is classified as being unsafe for .NET. +{$warn UNSAFE_TYPE off} +{$warn UNSAFE_CAST off} +{$warn UNSAFE_CODE off} + +uses + DesignEditors; + +type + TVirtualTreeEditor = class (TDefaultEditor) + public + procedure Edit; override; + end; + +procedure Register; + +//---------------------------------------------------------------------------------------------------------------------- + +implementation + +uses + WinApi.Windows, WinApi.CommCtrl, + System.TypInfo, System.SysUtils, System.Classes, + StrEdit,DesignIntf, VCLEditors, PropertyCategories, ColnEdit, + Vcl.Dialogs, Vcl.Graphics, Vcl.ImgList, Vcl.Controls, + VirtualTrees.ClipBoard, VirtualTrees.Actions, VirtualTrees, VirtualTrees.DrawTree, + VirtualTrees.HeaderPopup, VirtualTrees.BaseTree; + +type + // The usual trick to make a protected property accessible in the ShowCollectionEditor call below. + TVirtualTreeCast = class(TBaseVirtualTree); + + TClipboardElement = class(TNestedProperty, ICustomPropertyDrawing) + private + FElement: string; + protected + constructor Create(Parent: TPropertyEditor; AElement: string); reintroduce; + public + function AllEqual: Boolean; override; + function GetAttributes: TPropertyAttributes; override; + function GetName: string; override; + function GetValue: string; override; + procedure GetValues(Proc: TGetStrProc); override; + procedure SetValue(const Value: string); override; + + procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); + procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); + end; + + // This is a special property editor to make the strings in the clipboard format string list + // being shown as subproperties in the object inspector. This way it is shown what formats are actually available + // and the user can pick them with a simple yes/no choice. + + TGetPropEditProc = TGetPropProc; + + TClipboardFormatsProperty = class(TStringListProperty, ICustomPropertyDrawing) + public + function GetAttributes: TPropertyAttributes; override; + procedure GetProperties(Proc: TGetPropEditProc); override; + procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); + procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); + end; + + TColumnOptionsProperty = class(VCLEditors.TSetProperty) + public + procedure GetProperties(Proc: TGetPropProc); override; + function GetValue: string; override; + end; + + TVTColumnOptionsElementsProperty = class(VCLEditors.TSetElementProperty, + ICustomPropertyMessage + ) + private + FBit: TBit; + FPropList: TArray; + protected + constructor Create(Parent: TPropertyEditor; AElement: Integer); reintroduce; + procedure UpdateOrdValue; + public + // ICustomPropertyMessage + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer; + InNameRect: Boolean; const ItemRect: TRect; var Handled: Boolean); + end; + + resourcestring + sVTHeaderCategoryName = 'Header'; + sVTPaintingCategoryName = 'Custom painting'; + sVTIncremenalCategoryName = 'Incremental search'; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeEditor.Edit; + +begin + ShowCollectionEditor(Designer, Component, TVirtualTreeCast(Component).Header.Columns, 'Columns'); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +constructor TClipboardElement.Create(Parent: TPropertyEditor; AElement: string); + +begin + inherited Create(Parent); + FElement := AElement; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TClipboardElement.AllEqual: Boolean; + +// Determines if this element is included or excluded in all selected components it belongs to. + +var + I, Index: Integer; + List: TClipboardFormats; + V: Boolean; + +begin + Result := False; + if PropCount > 1 then + begin + List := TClipboardFormats(GetOrdValue); + V := List.Find(FElement, Index); + for I := 1 to PropCount - 1 do + begin + List := TClipboardFormats(GetOrdValue); + if List.Find(FElement, Index) <> V then + Exit; + end; + end; + Result := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TClipboardElement.GetAttributes: TPropertyAttributes; + +begin + Result := [paMultiSelect, paValueList, paSortList]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TClipboardElement.GetName: string; + +begin + Result := FElement; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TClipboardElement.GetValue: string; + +var + List: TClipboardFormats; + +begin + List := TClipboardFormats(GetOrdValue); + Result := BooleanIdents[List.IndexOf(FElement) > -1]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TClipboardElement.GetValues(Proc: TGetStrProc); + +begin + Proc(BooleanIdents[False]); + Proc(BooleanIdents[True]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TClipboardElement.SetValue(const Value: string); + +var + List: TClipboardFormats; + I, Index: Integer; + +begin + if CompareText(Value, 'True') = 0 then + begin + for I := 0 to PropCount - 1 do + begin + List := TClipboardFormats(GetOrdValueAt(I)); + List.Add(FElement); + end; + end + else + begin + for I := 0 to PropCount - 1 do + begin + List := TClipboardFormats(GetOrdValueAt(I)); + if List.Find(FElement, Index) then + List.Delete(Index); + end; + end; + Modified; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure DrawBoolean(Checked: Boolean; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); + +var + BoxSize, + EntryWidth: Integer; + R: TRect; + State: Cardinal; + +begin + with ACanvas do + begin + FillRect(ARect); + + BoxSize := ARect.Bottom - ARect.Top; + EntryWidth := ARect.Right - ARect.Left; + + R := Rect(ARect.Left + (EntryWidth - BoxSize) div 2, ARect.Top, ARect.Left + (EntryWidth + BoxSize) div 2, + ARect.Bottom); + InflateRect(R, -1, -1); + State := DFCS_BUTTONCHECK; + if Checked then + State := State or DFCS_CHECKED; + DrawFrameControl(Handle, R, DFC_BUTTON, State); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TClipboardElement.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); + +begin + DefaultPropertyDrawName(Self, ACanvas, ARect); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TClipboardElement.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); + +begin + DrawBoolean(CompareText(GetVisualValue, 'True') = 0, ACanvas, ARect, ASelected); +end; + +//----------------- TClipboardFormatsProperty -------------------------------------------------------------------------- + +function TClipboardFormatsProperty.GetAttributes: TPropertyAttributes; + +begin + Result := inherited GetAttributes + [paSubProperties, paFullWidthName]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TClipboardFormatsProperty.GetProperties(Proc: TGetPropEditProc); + +var + List: TStringList; + I: Integer; + Tree: TBaseVirtualTree; + +begin + List := TStringList.Create; + Tree := TClipboardFormats(GetOrdValue).Owner; + EnumerateVTClipboardFormats(TVirtualTreeClass(Tree.ClassType), List); + for I := 0 to List.Count - 1 do + Proc(TClipboardElement.Create(Self, List[I])); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TClipboardFormatsProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); + +var + S: string; + Width: Integer; + R: TRect; + +begin + with ACanvas do + begin + Font.Name := 'Arial'; + R := ARect; + Font.Color := clBlack; + S := GetName; + Width := TextWidth(S); + TextRect(R, R.Left + 1, R.Top + 1, S); + + Inc(R.Left, Width + 8); + Font.Height := 14; + Font.Color := clBtnHighlight; + S := '(OLE drag and clipboard)'; + SetBkMode(Handle, TRANSPARENT); + ExtTextOut(Handle, R.Left + 1, R.Top + 1, ETO_CLIPPED, @R, PChar(S), Length(S), nil); + Font.Color := clBtnShadow; + ExtTextOut(Handle, R.Left, R.Top, ETO_CLIPPED, @R, PChar(S), Length(S), nil); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TClipboardFormatsProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); + +begin + // Nothing to do here. +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TColumnOptionsProperty.GetProperties(Proc: TGetPropProc); +var + I: integer; + E: IProperty; +begin + with GetTypeData(GetTypeData(GetPropType)^.CompType^)^ do + begin + for I := MinValue to MaxValue do + begin + E := TVTColumnOptionsElementsProperty.Create(Self, I); + Proc(E); + E := nil; + end; + end; +end; + +function TColumnOptionsProperty.GetValue: string; +var + I : integer; + S: TIntegerSet; +begin + Integer(S) := GetOrdValue; + Result := ''; + for I := 0 to SizeOf(Integer) * 8 - 1 do + if I in S then + Result := Result + GetEnumName(TypeInfo(TVTColumnOption), I) + ','; + if Result.EndsWith(',') then + Delete(Result, Length(Result), 1); + Result := '[' + Result + ']'; +end; + +type + TPropertyEditorHack = class(TBasePropertyEditor) + protected + FDesigner: IDesigner; + FPropList: PInstPropList; + FPropCount: Integer; + end; + +constructor TVTColumnOptionsElementsProperty.Create(Parent: TPropertyEditor; AElement: Integer); +var + MinValue: integer; + I: Integer; +begin + inherited Create(Parent, AElement); + MinValue := GetTypeData(GetTypeData(GetPropType).CompType^).MinValue; + FBit := AElement - MinValue; + SetLength(FPropList, Parent.PropCount); + for I := 0 to High(FPropList) do + FPropList[I] := TPropertyEditorHack(Parent).FPropList^[I]; +end; + +procedure TVTColumnOptionsElementsProperty.UpdateOrdValue; +var + S: TIntegerSet; + I: Integer; +begin + // Changes only the specific bit in the set + for I := 0 to TPropertyEditorHack(Self).FPropCount - 1 do + begin + Integer(S) := GetOrdProp(FPropList[I].Instance, FPropList[I].PropInfo); + if FBit in S then + Exclude(S, FBit) + else + Include(S, FBit); + SetOrdProp(FPropList[I].Instance, FPropList[I].PropInfo, NativeInt(Integer(S))); + end; + Modified; +end; + +procedure TVTColumnOptionsElementsProperty.MouseUp(Button: TMouseButton; + Shift: TShiftState; X, Y: Integer; InNameRect: Boolean; const ItemRect: TRect; + var Handled: Boolean); +begin + Handled := False; + if paReadOnly in GetAttributes then + Exit; + if PtInRect(CBRect(ItemRect), Point(x,y)) then + begin + UpdateOrdValue; + Handled := True; + end; +end; + +// for sets, the VCLDesigner code always makes the property editor back to the +// standard set property editor: VclEditors.TSetProperty, so we need to make +// OUR set property's map to our editor implementation and not the standard +// set property editor. +function SetColumnOptionsPropertyMapper(Obj: TPersistent; PropInfo: PPropInfo): TPropertyEditorClass; +begin + Result := nil; + if Assigned(Obj) and (Obj.ClassType <> TVirtualTreeColumn) then + Exit; + if (PropInfo.PropType^.Kind = tkSet) and (PropInfo.PropType^ = TypeInfo(TVTColumnOptions)) then + Result := TColumnOptionsProperty; +end; + +//---------------------------------------------------------------------------------------------------------------------- +procedure Register; + +begin + RegisterComponents('Virtual Controls', [TVirtualStringTree, TVirtualDrawTree, TVTHeaderPopupMenu]); + RegisterPropertyMapper(SetColumnOptionsPropertyMapper); + RegisterComponentEditor(TVirtualStringTree, TVirtualTreeEditor); + RegisterComponentEditor(TVirtualDrawTree, TVirtualTreeEditor); + RegisterPropertyEditor(TypeInfo(TClipboardFormats), nil, '', TClipboardFormatsProperty); + + // Categories: + RegisterPropertiesInCategory(sActionCategoryName, TBaseVirtualTree, ['ChangeDelay', 'EditDelay']); + + RegisterPropertiesInCategory(sDataCategoryName, + TBaseVirtualTree, + ['NodeDataSize', + 'RootNodeCount', + 'OnCompareNodes', + 'OnGetNodeDataSize', + 'OnInitNode', + 'OnInitChildren', + 'OnFreeNode', + 'OnGetNodeWidth', + 'OnGetPopupMenu', + 'OnLoadNode', + 'OnSaveNode', + 'OnResetNode', + 'OnNodeMov*', + 'OnStructureChange', + 'OnUpdating', + 'OnGetText', + 'OnNewText', + 'OnShortenString']); + + RegisterPropertiesInCategory(slayoutCategoryName, + TBaseVirtualTree, + ['AnimationDuration', + 'AutoExpandDelay', + 'AutoScroll*', + 'ButtonStyle', + 'DefaultNodeHeight', + '*Images*', 'OnGetImageIndex', 'OnGetImageText', + 'Header', + 'Indent', + 'LineStyle', 'OnGetLineStyle', + 'CheckImageKind', + 'Options', + 'Margin', + 'NodeAlignment', + 'ScrollBarOptions', + 'SelectionCurveRadius', + 'TextMargin']); + + RegisterPropertiesInCategory(sVisualCategoryName, + TBaseVirtualTree, + ['Background*', + 'ButtonFillMode', + 'CustomCheckimages', + 'Colors', + 'LineMode']); + + RegisterPropertiesInCategory(sHelpCategoryName, + TBaseVirtualTree, + ['AccessibleName', 'Hint*', 'On*Hint*', 'On*Help*']); + + RegisterPropertiesInCategory(sDragNDropCategoryName, + TBaseVirtualTree, + ['ClipboardFormats', + 'DefaultPasteMode', + 'OnCreateDataObject', + 'OnCreateDragManager', + 'OnGetUserClipboardFormats', + 'OnNodeCop*', + 'OnDragAllowed', + 'OnRenderOLEData']); + + RegisterPropertiesInCategory(sInputCategoryName, + TBaseVirtualTree, + ['DefaultText', + 'DrawSelectionMode', + 'WantTabs', + 'OnChang*', + 'OnCollaps*', + 'OnExpand*', + 'OnCheck*', + 'OnEdit*', + 'On*Click', + 'OnFocus*', + 'OnCreateEditor', + 'OnScroll', + 'OnNodeHeightTracking', + 'OnHotChange']); + + RegisterPropertiesInCategory(sVTHeaderCategoryName, + TBaseVirtualTree, + ['OnHeader*', 'OnGetHeader*']); + + RegisterPropertiesInCategory(sVTPaintingCategoryName, + TBaseVirtualTree, + ['On*Paint*', + 'OnDraw*', + 'On*Erase*']); + + RegisterPropertiesInCategory(sVTIncremenalCategoryName, + TBaseVirtualTree, + ['*Incremental*']); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +end. diff --git a/Doc/Class inheritance.txt b/Doc/Class inheritance.txt new file mode 100644 index 000000000..66a1927c5 --- /dev/null +++ b/Doc/Class inheritance.txt @@ -0,0 +1,13 @@ +TCustomControl TRectangle Base class of framework. + | | +TVTBaseAncestorVcl TVTBaseAncestorFMX Base class for VCL/FMX that adds some basic platform-specific stuff. + | | +TVTBaseAncestor TVTBaseAncestor Alias dependant on platform. + | | +TBaseVirtualTree TBaseVirtualTree Base class of Virtual TreeView that that does not include concrete drawing. + | | +TVTAncestorVcl TVTAncestorFMX Intermediate class that add platform specififc code which consumes methods of TBaseVirtualTree. + | | +TVTAncestor TVTAncestor Alias dependant on platform. + | | +TCustomVirtualStringTree TCustomVirtualStringTree Final control that is used. diff --git a/INSTALL.txt b/INSTALL.txt index 22f3b1790..162fac3d9 100644 --- a/INSTALL.txt +++ b/INSTALL.txt @@ -1,50 +1,71 @@ -Supported Delphi version: RAD Studio XE3 and higher -Supported Windows Versions: Windows XP and higher +Supported Delphi version: RAD Studio 10.0 and higher +Supported Windows Versions: Windows 8 and higher - -The former installer of V4 is no longer maintained, but installation is quite easy: 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 root element "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 XE3 and higher Installation +Delphi / RAD Studio 10.3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1. Open the project group "Packages\RAD Studio XE*\VirtualTreeView.groupproj" +1. Open the project group "Packages\RAD Studio 10.3\VirtualTreeView.groupproj" +2. Right click on "VirtualTreesD270.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 platforms, 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". + + +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" 3. Go to "Tools > Options > Environment Options > Delphi Options > Library > Library Path > [...]" - Browse to the "Source" folder of VirtualTreeView, press "OK", "Add", "OK", "OK" + Browse to the "Source" folder of VirtualTreeView, press "OK", "Add", "OK" + Do this for both Win32 and Win64 platforms, which you can choose in the dropdown box. 4. C++ Builder users only: - Go to "Tools > Options > Environment Options > C++ Options > Paths and Directories" - a) Click "Library Path > [...]" + 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", "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 "OK". Troubleshooting ~~~~~~~~~~~~~~~ In case you experience any problems, try to delete all these files from your disk and then start over: - Virtualtrees.* - - VTAccessibility.* + - VTAccessibility.* - VTHeaderPopup.* - - VirtualTreesD.* + - VirtualTreesD.* - VirtualTreesR.* -I recommand 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. +I recommend using UltraSearch for this task: http://www.jam-software.de/ultrasearch/ -C++ Builder XE3 and higher Installation -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1. Open the project group "Packages\CBullder 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/MAKEFILE b/MAKEFILE index 9df6db19a..4c89b54b1 100644 --- a/MAKEFILE +++ b/MAKEFILE @@ -1,29 +1,59 @@ +# Program files folder +PROGRAMFILESX64 = $(PROGRAMFILES) +!IF EXIST("C:\Program Files (x86)") +PROGRAMFILES = C:\Program Files (x86) +PROGRAMFILESX64 = C:\Program Files +!ENDIF + +# Default MS Build version +!IF EXIST("$(PROGRAMFILESX64)\Microsoft Visual Studio\2022\Enterprise\MSBuild\Current\Bin\msbuild.exe") +BUILDEXE = "$(PROGRAMFILESX64)\Microsoft Visual Studio\2022\Enterprise\MSBuild\Current\Bin\msbuild.exe" +!ELSE IF EXIST("$(PROGRAMFILESX64)\Microsoft Visual Studio\2022\Professional\MSBuild\Current\Bin\msbuild.exe") +BUILDEXE = "$(PROGRAMFILESX64)\Microsoft Visual Studio\2022\Professional\MSBuild\Current\Bin\msbuild.exe" +!ELSE IF EXIST("$(PROGRAMFILESX64)\Microsoft Visual Studio\2019\Enterprise\MSBuild\Current\Bin\msbuild.exe") +BUILDEXE = "$(PROGRAMFILESX64)\Microsoft Visual Studio\2019\Enterprise\MSBuild\Current\Bin\msbuild.exe" +!ELSE IF EXIST("$(PROGRAMFILESX64)\Microsoft Visual Studio\2019\Professional\MSBuild\Current\Bin\msbuild.exe") +BUILDEXE = "$(PROGRAMFILESX64)\Microsoft Visual Studio\2019\Professional\MSBuild\Current\Bin\msbuild.exe" +!ELSE IF EXIST("$(PROGRAMFILESX64)\Microsoft Visual Studio\2017\BuildTools\MSBuild\15.0\Bin\msbuild.exe") +BUILDEXE = "$(PROGRAMFILESX64)\Microsoft Visual Studio\2017\BuildTools\MSBuild\15.0\Bin\msbuild.exe" +!ELSE +BUILDEXE = "msbuild.exe" +!ENDIF + PROJECT = VirtualTrees EMBARCADERO = $(PROGRAMFILES)\Embarcadero\RAD Studio STUDIO = $(PROGRAMFILES)\Embarcadero\Studio BDSCOMMONDIRMAIN = %PUBLIC%\Documents\Embarcadero\Studio -BUILDEXE = "$(PROGRAMFILES)\Microsoft Visual Studio\2017\Enterprise\MSBuild\15.0\Bin\msbuild.exe" + BUILD = $(BUILDEXE) /t:Rebuild clean: - ECHO Project: $(PROJECT) $(EMBARCADERO) + ECHO Project: $(PROJECT) $(EMBARCADERO) DEL /S /Q .\*.HPP DEL /S /Q .\*.DCU #TODO: Add demos and package folders -_XE8: Lib\*.pas "Package\RAD Studio XE8\$(PROJECT)R.dpk" "Package\RAD Studio XE8\$(PROJECT)R.dproj" "Package\RAD Studio XE8\$(PROJECT)D.dpk" "Package\RAD Studio XE8\$(PROJECT)D.dproj" - SET BDS=$(STUDIO)\16.0 - $(BUILD) "Package\RAD Studio XE8\$(PROJECT)R.dproj" - $(BUILD) "Package\RAD Studio XE8\$(PROJECT)D.dproj" - $(BUILD) /property:Platform=Win64 "Package\RAD Studio XE8\$(PROJECT)R.dproj" +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 - -# build all packahes for Delphi 10.2 -10_2: Source\*.pas "Packages\RAD Studio 10.2\$(PROJECT)R.dpk" "Packages\RAD Studio 10.2\$(PROJECT)R.dproj" "Packages\RAD Studio 10.2\$(PROJECT)D.dpk" "Packages\RAD Studio 10.2\$(PROJECT)D.dproj" - SET BDS=$(STUDIO)\19.0 - $(BUILD) "Packages\RAD Studio 10.2\$(PROJECT)R.dproj" - $(BUILD) "Packages\RAD Studio 10.2\$(PROJECT)D.dproj" - $(BUILD) /property:Platform=Win64 "Packages\RAD Studio 10.2\$(PROJECT)R.dproj" + +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" + $(BUILD) "Packages\RAD Studio 10.4+\$(PROJECT)D.dproj" + $(BUILD) /property:Platform=Win64 "Packages\RAD Studio 10.4+\$(PROJECT)R.dproj" + $(MAKE) _samples + +# build all packages for Delphi 10.4. Note: The variable $@ is expanded to the build target name +10.1 10.2 10.3 10.4+: Source\*.pas "Packages\RAD Studio $@\$(PROJECT)R.dpk" "Packages\RAD Studio $@\$(PROJECT)R.dproj" "Packages\RAD Studio $@\$(PROJECT)D.dpk" "Packages\RAD Studio $@\$(PROJECT)D.dproj" + SET BDS=$(STUDIO)\21.0 + $(BUILD) "Packages\RAD Studio $@\$(PROJECT)R.dproj" + $(BUILD) "Packages\RAD Studio $@\$(PROJECT)D.dproj" + $(BUILD) /property:Platform=Win64 "Packages\RAD Studio $@\$(PROJECT)R.dproj" $(MAKE) _samples "Demos\Advanced\Advanced.exe": "Demos\Advanced\*.dproj" "Demos\Advanced\*.dpr" "Demos\Advanced\*.pas" @@ -40,7 +70,7 @@ _XE8: Lib\*.pas "Package\RAD Studio XE8\$(PROJECT)R.dpk" "Package\RAD Studio XE8 _samples: "Demos\Advanced\Advanced.exe" "Demos\Minimal\Minimal.exe" "Demos\Objects\Objects.exe" "Demos\OLE\OLE.exe" -_continuousbuilds: clean 10_2 +_continuousbuilds: clean 12.3 _release: #This small batch file is intended to create a source code release file of the VirtualTreeView as ZIP archive @@ -48,6 +78,6 @@ _release: #Download e.g. from: ftp://ftp.info-zip.org/pub/infozip/win32/ ZIP -9 -r .\VirtualTreeView.zip INSTALL.txt Changes.txt Source Design Packages Demos Contributions Help\VirtualTreeview.chm -i *.pas -i *.dpk -i *.groupproj -i *.dproj -i *.cbproj -i *.hlp -i *.rc -i *.res -i *.cfg -i *.dpr -i *.dof -i *.bpr -i *.dfm -i *.cpp -i *.inc -i *.dcr -i *.chm -i *.png -i *.js -i *.txt -i *.bmp -i *.uni ECHO Source code zip archive "VirtualTreeView.zip" created. - ECHO !!!Please ensure that the const TVTVersion is correct!!! - ECHO !!!Please add version number to ZIP file name!!! - ECHO !!!Please create release at: https://github.com/Virtual-TreeView/Virtual-TreeView/releases + ECHO !!! Please add version number to ZIP file name!!! + ECHO !!! Please create release at: https://github.com/Virtual-TreeView/Virtual-TreeView/releases + ECHO !!! Let JAM web-team upload the file to our server at https://www.jam-software.com/virtual-treeview \ No newline at end of file diff --git a/MakeRelease.Bat b/MakeRelease.Bat deleted file mode 100644 index b016c9356..000000000 --- a/MakeRelease.Bat +++ /dev/null @@ -1,3 +0,0 @@ -@ECHO OFF -nmake _release -pause \ No newline at end of file diff --git a/Packages/CBuilder 10.1/VirtualTreesCD.cbproj b/Packages/CBuilder 10.1/VirtualTreesCD.cbproj index 1db5fd5f0..7a9a8af02 100644 --- a/Packages/CBuilder 10.1/VirtualTreesCD.cbproj +++ b/Packages/CBuilder 10.1/VirtualTreesCD.cbproj @@ -2,9 +2,9 @@ {DE1FB54C-6852-4F59-B4A5-7718E6069FE8} VirtualTreesCD.cpp - 18.2 + 18.4 Release - None + VCL True Win32 1 @@ -51,7 +51,7 @@ $(BDSCOMMONDIR)\hpp\$(Platform)\ VirtualTreesCD true - ..\..\source;$(DCC_UnitSearchPath) + ..\..\Source;$(DCC_UnitSearchPath) 4108 System;Xml;Data;Datasnap;Web;Soap;Vcl;$(DCC_Namespace) true @@ -67,11 +67,11 @@ All true ..\..\Source\;..\..\Design\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\..\Design\;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;..\..\source;$(ILINK_LibraryPath) + ..\..\Design\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;..\..\Source;$(ILINK_LibraryPath) false true true - 128 + 128 true @@ -85,19 +85,16 @@ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug\;$(IncludePath) false true false true false - Debug None DEBUG true true true - $(BDS)\lib\debug;$(ILINK_LibraryPath) true Full true @@ -106,9 +103,6 @@ _DEBUG;$(Defines) - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) None @@ -131,21 +125,12 @@ 4 - - 7 - - - 8 - 0 9 - - 6 - Cfg_2 Base @@ -237,12 +222,7 @@ True False - - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - + False True diff --git a/Packages/CBuilder 10.1/VirtualTreesCR.cbproj b/Packages/CBuilder 10.1/VirtualTreesCR.cbproj index 6545bb08e..39a3aab6c 100644 --- a/Packages/CBuilder 10.1/VirtualTreesCR.cbproj +++ b/Packages/CBuilder 10.1/VirtualTreesCR.cbproj @@ -2,11 +2,11 @@ {FE6B0D67-74B6-4E30-8AED-CB2B3E77A51F} VirtualTreesCR.cpp - 18.2 + 18.4 Release VCL True - Win32 + Win64 3 Package @@ -57,7 +57,7 @@ VirtualTree CBuilder runtime package $(BDSCOMMONDIR)\hpp\$(Platform) VirtualTreesCR - Shell32.dll;$(ILINK_DelayLoadDll) + Shell32.dll;uxtheme.dll;$(ILINK_DelayLoadDll) $(BDS)\lib;$(BDS)\lib\$(Platform);$(BDS)\lib\$(Platform)\$(Config);$(DCC_UnitSearchPath) true 4108 @@ -73,17 +73,18 @@ All true ..\..\Source\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(platform);$(BDS)\lib\$(Platform)\$(Config);$(ILINK_LibraryPath) + ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;$(ILINK_LibraryPath) false true true 128 + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) $(BDS)\Bin\BDS.EXE true $(BDSINCLUDE)\windows\vcl;$(IncludePath) - C:\Program Files (x86)\Embarcadero\DelphiXE5\lib\win32\release\psdk\;$(ILINK_LibraryPath) true $(BDS)\bin\default_app.manifest 1033 @@ -95,19 +96,16 @@ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug\;$(IncludePath) false true false true false - Debug None DEBUG true true true - $(BDS)\lib\debug;$(ILINK_LibraryPath) true Full true @@ -116,9 +114,6 @@ _DEBUG;$(Defines) - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) None @@ -129,61 +124,97 @@ 1033 - - 1 - 9 true + + 9 + true + + + 3 + 4 - - 7 - - - 8 - 0 - - 6 - + + 0 + + + 1 + - 16 + 2 + + + 3 + + + 4 + + + 5 - 16 + 6 - 16 + 7 + + + 8 + + + 9 + + + 10 + + + 11 + + + 12 + + + 13 - 17 + 14 + + + 15 + + + 16 17 - 17 + 18 + + + 19 - 17 + 20 - 17 - - - 17 - - - 17 - - - 17 + 21 + + 18 + true + + + 18 + true + Cfg_2 Base @@ -275,12 +306,7 @@ True False - - Embarcadero C++Builder-Package für Office 2000-Server - Embarcadero C++Builder-Package für Office XP-Server - 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 @@ -292,485 +318,8 @@ True True - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - VirtualTreesCR.bpl - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - 0 - .dll;.bpl - - - 1 - .dylib - - - - - Contents\Resources - 1 - - - - - classes - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - Contents\MacOS - 0 - - - 1 - - - - - library\lib\mips - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 0 - - - 1 - - - 1 - - - library\lib\armeabi-v7a - 1 - - - 1 - - - - - 0 - - - 1 - .framework - - - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - library\lib\armeabi - 1 - - - - - 0 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-normal - 1 - - - - - res\drawable-xhdpi - 1 - - - - - res\drawable-large - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable-hdpi - 1 - - - - - - - Assets - 1 - - - Assets - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\values - 1 - - - - - res\drawable-small - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - - - res\drawable - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-ldpi - 1 - - - - - - - - - - - - 12 - diff --git a/Packages/CBuilder 10.2/VirtualTreesCD.cbproj b/Packages/CBuilder 10.2/VirtualTreesCD.cbproj index d1573f0a6..5f2ea197f 100644 --- a/Packages/CBuilder 10.2/VirtualTreesCD.cbproj +++ b/Packages/CBuilder 10.2/VirtualTreesCD.cbproj @@ -4,7 +4,7 @@ VirtualTreesCD.cpp 18.4 Release - None + VCL True Win32 1 @@ -46,12 +46,12 @@ true - 240 + 250 VirtualTree CBuilder designtime package $(BDSCOMMONDIR)\hpp\$(Platform)\ VirtualTreesCD true - ..\..\source;$(DCC_UnitSearchPath) + ..\..\Source;$(DCC_UnitSearchPath) 4108 System;Xml;Data;Datasnap;Web;Soap;Vcl;$(DCC_Namespace) true @@ -67,15 +67,18 @@ All true ..\..\Source\;..\..\Design\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\..\Design\;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;..\..\source;$(ILINK_LibraryPath) + ..\..\Design\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;..\..\Source;$(ILINK_LibraryPath) false true true 128 + None + .\$(Platform)\$(Config) + true + .\$(Platform)\$(Config) true - true $(BDS)\bin\default_app.manifest 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) @@ -85,30 +88,25 @@ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug\;$(IncludePath) false true false true false - Debug None DEBUG true true true - $(BDS)\lib\debug;$(ILINK_LibraryPath) true Full true _DEBUG;$(Defines) + 1033 - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) None @@ -131,21 +129,12 @@ 4 - - 7 - - - 8 - 0 9 - - 6 - Cfg_2 Base @@ -237,12 +226,7 @@ True False - - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - + False True diff --git a/Packages/CBuilder 10.2/VirtualTreesCR.cbproj b/Packages/CBuilder 10.2/VirtualTreesCR.cbproj index 66402b8c0..fe6cd5d19 100644 --- a/Packages/CBuilder 10.2/VirtualTreesCR.cbproj +++ b/Packages/CBuilder 10.2/VirtualTreesCR.cbproj @@ -6,7 +6,7 @@ Release VCL True - Win64 + Win32 3 Package @@ -34,6 +34,12 @@ true true + + true + Cfg_1 + true + true + true Base @@ -52,12 +58,12 @@ true - 240 + 250 true VirtualTree CBuilder runtime package $(BDSCOMMONDIR)\hpp\$(Platform) VirtualTreesCR - Shell32.dll;$(ILINK_DelayLoadDll) + Shell32.dll;uxtheme.dll;$(ILINK_DelayLoadDll) $(BDS)\lib;$(BDS)\lib\$(Platform);$(BDS)\lib\$(Platform)\$(Config);$(DCC_UnitSearchPath) true 4108 @@ -73,54 +79,52 @@ All true ..\..\Source\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(platform);$(BDS)\lib\$(Platform)\$(Config);$(ILINK_LibraryPath) + ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;$(ILINK_LibraryPath) false true true 128 + None + .\$(Platform)\$(Config) + true + .\$(Platform)\$(Config) $(BDS)\Bin\BDS.EXE true $(BDSINCLUDE)\windows\vcl;$(IncludePath) - C:\Program Files (x86)\Embarcadero\DelphiXE5\lib\win32\release\psdk\;$(ILINK_LibraryPath) - true $(BDS)\bin\default_app.manifest 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - vclwinx;$(PackageImports) $(BDSINCLUDE)\windows\vcl;$(IncludePath) 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - vclwinx;$(PackageImports) - Debug\;$(IncludePath) false true false true false - Debug None DEBUG true true true - $(BDS)\lib\debug;$(ILINK_LibraryPath) true Full true _DEBUG;$(Defines) + 1033 + + + 1033 - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) None @@ -131,43 +135,78 @@ 1033 - + + 3 + + 9 true - + 9 true - - 3 - + + 18 + true + + + 18 + true + 4 - - 8 - 0 - 14 + 0 - 15 + 1 - 16 + 2 + + + 3 + + + 4 + + + 5 - 16 + 6 - 16 + 7 + + + 8 + + + 9 + + + 10 + + + 11 + + + 12 + + + 13 - 17 + 14 + + + 15 16 @@ -176,13 +215,16 @@ 17 - 17 + 18 + + + 19 - 17 + 20 - 17 + 21 Cfg_2 @@ -275,12 +317,7 @@ True False - - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - + False True @@ -292,515 +329,8 @@ True True - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - VirtualTreesCR.bpl - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - - - library\lib\mips - 1 - - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - - - res\values - 1 - - - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - - - 1 - - - 1 - - - 0 - - - - - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - - - - 1 - - - 1 - - - 1 - - - - - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - 0 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - 12 - diff --git a/Packages/CBuilder XE7/VirtualTreeView.groupproj b/Packages/CBuilder 10.3/VirtualTreeView.groupproj similarity index 93% rename from Packages/CBuilder XE7/VirtualTreeView.groupproj rename to Packages/CBuilder 10.3/VirtualTreeView.groupproj index d45ca9e06..8214df0fc 100644 --- a/Packages/CBuilder XE7/VirtualTreeView.groupproj +++ b/Packages/CBuilder 10.3/VirtualTreeView.groupproj @@ -1,6 +1,6 @@  - {90943296-FDFA-4C80-A99D-237F570C4F54} + {85AC5363-0DD3-4B39-8709-5987A7DA817E} diff --git a/Packages/CBuilder 10.3/VirtualTreesCD.cbproj b/Packages/CBuilder 10.3/VirtualTreesCD.cbproj new file mode 100644 index 000000000..7b272d440 --- /dev/null +++ b/Packages/CBuilder 10.3/VirtualTreesCD.cbproj @@ -0,0 +1,245 @@ + + + {DE1FB54C-6852-4F59-B4A5-7718E6069FE8} + VirtualTreesCD.cpp + 18.5 + Release + VCL + True + Win32 + 1 + Package + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + 260 + VirtualTree CBuilder designtime package + $(BDSCOMMONDIR)\hpp\$(Platform)\ + VirtualTreesCD + true + ..\..\Source;$(DCC_UnitSearchPath) + 4108 + System;Xml;Data;Datasnap;Web;Soap;Vcl;$(DCC_Namespace) + true + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 6 + -LUDesignIDE + true + bpl + CppPackage + true + true + true + All + true + ..\..\Source\;..\..\Design\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) + ..\..\Design\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;..\..\Source;$(ILINK_LibraryPath) + false + true + true + 128 + None + .\$(Platform)\$(Config) + true + .\$(Platform)\$(Config) + + + true + $(BDS)\bin\default_app.manifest + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + + + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + + + false + true + false + true + false + None + DEBUG + true + true + true + true + Full + true + + + _DEBUG;$(Defines) + 1033 + + + None + + + 1033 + NDEBUG;$(Defines) + + + + 3 + + + 10 + + + 5 + + + 1 + + + 4 + + + 0 + + + 9 + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + + CPlusPlusBuilder.Personality.12 + CppPackage + + + + VirtualTreesCD.cpp + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 4108 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + False + + + + + + + False + + False + + True + False + + + + False + True + True + False + + + + True + False + + + 12 + + + diff --git a/Packages/CBuilder XE5/VirtualTreesCD.cpp b/Packages/CBuilder 10.3/VirtualTreesCD.cpp similarity index 100% rename from Packages/CBuilder XE5/VirtualTreesCD.cpp rename to Packages/CBuilder 10.3/VirtualTreesCD.cpp diff --git a/Packages/CBuilder 10.3/VirtualTreesCR.cbproj b/Packages/CBuilder 10.3/VirtualTreesCR.cbproj new file mode 100644 index 000000000..67e7d02c3 --- /dev/null +++ b/Packages/CBuilder 10.3/VirtualTreesCR.cbproj @@ -0,0 +1,336 @@ + + + {FE6B0D67-74B6-4E30-8AED-CB2B3E77A51F} + VirtualTreesCR.cpp + 18.5 + Release + VCL + True + Win32 + 3 + Package + + + 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 + + + 260 + true + VirtualTree CBuilder runtime package + $(BDSCOMMONDIR)\hpp\$(Platform) + VirtualTreesCR + Shell32.dll;uxtheme.dll;$(ILINK_DelayLoadDll) + $(BDS)\lib;$(BDS)\lib\$(Platform);$(BDS)\lib\$(Platform)\$(Config);$(DCC_UnitSearchPath) + true + 4108 + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + true + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 6 + bpl + CppPackage + true + true + true + All + true + ..\..\Source\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) + ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;$(ILINK_LibraryPath) + false + true + true + 128 + None + .\$(Platform)\$(Config) + true + .\$(Platform)\$(Config) + + + $(BDS)\Bin\BDS.EXE + true + $(BDSINCLUDE)\windows\vcl;$(IncludePath) + $(BDS)\bin\default_app.manifest + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + + + $(BDSINCLUDE)\windows\vcl;$(IncludePath) + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + + + false + true + false + true + false + None + DEBUG + true + true + true + true + Full + true + + + _DEBUG;$(Defines) + 1033 + + + 1033 + + + None + + + 1033 + NDEBUG;$(Defines) + + + 1033 + + + + 3 + + + 9 + true + + + 9 + true + + + 18 + true + + + 18 + true + + + 4 + + + 0 + + + 0 + + + 1 + + + 2 + + + 3 + + + 4 + + + 5 + + + 6 + + + 7 + + + 8 + + + 9 + + + 10 + + + 11 + + + 12 + + + 13 + + + 14 + + + 15 + + + 16 + + + 17 + + + 18 + + + 19 + + + 20 + + + 21 + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + + CPlusPlusBuilder.Personality.12 + CppPackage + + + + VirtualTreesCR.cpp + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 4108 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + False + + + + + + + False + + False + + True + False + + + + False + True + True + False + + + + True + True + + + 12 + + + diff --git a/Packages/CBuilder XE5/VirtualTreesCR.cpp b/Packages/CBuilder 10.3/VirtualTreesCR.cpp similarity index 100% rename from Packages/CBuilder XE5/VirtualTreesCR.cpp rename to Packages/CBuilder 10.3/VirtualTreesCR.cpp diff --git a/Packages/CBuilder XE8/VirtualTreeView.groupproj b/Packages/CBuilder 10.4/VirtualTreeView.groupproj similarity index 93% rename from Packages/CBuilder XE8/VirtualTreeView.groupproj rename to Packages/CBuilder 10.4/VirtualTreeView.groupproj index d45ca9e06..1250e4780 100644 --- a/Packages/CBuilder XE8/VirtualTreeView.groupproj +++ b/Packages/CBuilder 10.4/VirtualTreeView.groupproj @@ -1,48 +1,48 @@ - - - {90943296-FDFA-4C80-A99D-237F570C4F54} - - - - - - - - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + {85AC5363-0DD3-4B39-8709-5987A7DA817E} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Packages/CBuilder 10.4/VirtualTreesCD.cbproj b/Packages/CBuilder 10.4/VirtualTreesCD.cbproj new file mode 100644 index 000000000..5c42f5b91 --- /dev/null +++ b/Packages/CBuilder 10.4/VirtualTreesCD.cbproj @@ -0,0 +1,245 @@ + + + {DE1FB54C-6852-4F59-B4A5-7718E6069FE8} + VirtualTreesCD.cpp + 19.2 + Release + VCL + True + Win32 + 1 + Package + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + 270 + VirtualTree CBuilder designtime package + $(BDSCOMMONDIR)\hpp\$(Platform)\ + VirtualTreesCD + true + ..\..\Source;$(DCC_UnitSearchPath) + 4108 + System;Xml;Data;Datasnap;Web;Soap;Vcl;$(DCC_Namespace) + true + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 6 + -LUDesignIDE + true + bpl + CppPackage + true + true + true + All + true + ..\..\Source\;..\..\Design\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) + ..\..\Design\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;..\..\Source;$(ILINK_LibraryPath) + false + true + true + 128 + None + .\$(Platform)\$(Config) + true + .\$(Platform)\$(Config) + + + true + $(BDS)\bin\default_app.manifest + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + + + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + + + false + true + false + true + false + None + DEBUG + true + true + true + true + Full + true + + + _DEBUG;$(Defines) + 1033 + + + None + + + 1033 + NDEBUG;$(Defines) + + + + 0 + + + 10 + + + 5 + + + 1 + + + 4 + + + 0 + + + 9 + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + + CPlusPlusBuilder.Personality.12 + CppPackage + + + + VirtualTreesCD.cpp + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 4108 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + False + + + + + + + False + + False + + True + False + + + + False + True + True + False + + + + True + False + + + 12 + + + diff --git a/Packages/CBuilder XE7/VirtualTreesCD.cpp b/Packages/CBuilder 10.4/VirtualTreesCD.cpp similarity index 100% rename from Packages/CBuilder XE7/VirtualTreesCD.cpp rename to Packages/CBuilder 10.4/VirtualTreesCD.cpp diff --git a/Packages/CBuilder 10.4/VirtualTreesCR.cbproj b/Packages/CBuilder 10.4/VirtualTreesCR.cbproj new file mode 100644 index 000000000..9ec0d8d3c --- /dev/null +++ b/Packages/CBuilder 10.4/VirtualTreesCR.cbproj @@ -0,0 +1,336 @@ + + + {FE6B0D67-74B6-4E30-8AED-CB2B3E77A51F} + VirtualTreesCR.cpp + 19.2 + Release + VCL + True + Win32 + 3 + Package + + + 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 + + + 270 + true + VirtualTree CBuilder runtime package + $(BDSCOMMONDIR)\hpp\$(Platform) + VirtualTreesCR + Shell32.dll;uxtheme.dll;$(ILINK_DelayLoadDll) + $(BDS)\lib;$(BDS)\lib\$(Platform);$(BDS)\lib\$(Platform)\$(Config);$(DCC_UnitSearchPath) + true + 4108 + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + true + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 6 + bpl + CppPackage + true + true + true + All + true + ..\..\Source\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) + ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;$(ILINK_LibraryPath) + false + true + true + 128 + None + .\$(Platform)\$(Config) + true + .\$(Platform)\$(Config) + + + $(BDS)\Bin\BDS.EXE + true + $(BDSINCLUDE)\windows\vcl;$(IncludePath) + $(BDS)\bin\default_app.manifest + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + + + $(BDSINCLUDE)\windows\vcl;$(IncludePath) + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + + + false + true + false + true + false + None + DEBUG + true + true + true + true + Full + true + + + _DEBUG;$(Defines) + 1033 + + + 1033 + + + None + + + 1033 + NDEBUG;$(Defines) + + + 1033 + + + + 3 + + + 9 + true + + + 9 + true + + + 18 + true + + + 18 + true + + + 4 + + + 0 + + + 0 + + + 1 + + + 2 + + + 3 + + + 4 + + + 5 + + + 6 + + + 7 + + + 8 + + + 9 + + + 10 + + + 11 + + + 12 + + + 13 + + + 14 + + + 15 + + + 16 + + + 17 + + + 18 + + + 19 + + + 20 + + + 21 + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + + CPlusPlusBuilder.Personality.12 + CppPackage + + + + VirtualTreesCR.cpp + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 4108 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + False + + + + + + + False + + False + + True + False + + + + False + True + True + False + + + + True + True + + + 12 + + + diff --git a/Packages/CBuilder XE7/VirtualTreesCR.cpp b/Packages/CBuilder 10.4/VirtualTreesCR.cpp similarity index 100% rename from Packages/CBuilder XE7/VirtualTreesCR.cpp rename to Packages/CBuilder 10.4/VirtualTreesCR.cpp diff --git a/Packages/CBuilder 10/VirtualTreesCD.cbproj b/Packages/CBuilder 10/VirtualTreesCD.cbproj index d05aaceff..c4a8b5eb7 100644 --- a/Packages/CBuilder 10/VirtualTreesCD.cbproj +++ b/Packages/CBuilder 10/VirtualTreesCD.cbproj @@ -4,7 +4,7 @@ VirtualTreesCD.cpp 18.0 Release - None + VCL True Win32 1 @@ -13,21 +13,6 @@ true - - true - Base - true - - - true - Base - true - - - true - Base - true - true Base @@ -43,18 +28,6 @@ Base true - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - true Cfg_1 @@ -66,18 +39,6 @@ Base true - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - true Cfg_2 @@ -87,10 +48,10 @@ 230 VirtualTree CBuilder designtime package - ..\..\source\hpp\$(Platform)\$(Config) + $(BDSCOMMONDIR)\hpp\$(Platform)\ VirtualTreesCD true - ..\..\source;$(DCC_UnitSearchPath) + ..\..\Source;$(DCC_UnitSearchPath) 4108 System;Xml;Data;Datasnap;Web;Soap;Vcl;$(DCC_Namespace) true @@ -106,29 +67,11 @@ All true ..\..\Source\;..\..\Design\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\RAD Studio XE5\;..\..\Design\;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;..\..\source;$(ILINK_LibraryPath) + ..\..\Design\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;..\..\Source;$(ILINK_LibraryPath) false true true - - android-support-v4.dex.jar;apk-expansion.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar - Debug - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=preferExternal;largeHeap=False;theme=TitleBar;hardwareAccelerated=true - false - - - $(MSBuildProjectName) - iPhoneAndiPad - CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user - Debug - - - $(MSBuildProjectName) - iPhoneAndiPad - CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user - Debug - true true @@ -141,44 +84,26 @@ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug\;$(IncludePath) false true false true false - Debug None DEBUG true true true - $(BDS)\lib\debug;$(ILINK_LibraryPath) true Full true - - true - - - true - _DEBUG;$(Defines) - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) None - - true - - - true - 1033 NDEBUG;$(Defines) @@ -199,21 +124,12 @@ 4 - - 7 - - - 8 - 0 9 - - 6 - Cfg_2 Base @@ -305,12 +221,7 @@ True False - - Embarcadero C++Builder-Package für Office 2000-Server - Embarcadero C++Builder-Package für Office XP-Server - 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 @@ -319,10 +230,6 @@ - False - False - False - False True False diff --git a/Packages/CBuilder 10/VirtualTreesCD.cpp b/Packages/CBuilder 10/VirtualTreesCD.cpp index d4fbb1610..37aacb559 100644 --- a/Packages/CBuilder 10/VirtualTreesCD.cpp +++ b/Packages/CBuilder 10/VirtualTreesCD.cpp @@ -1,7 +1,7 @@ //--------------------------------------------------------------------------- -#pragma hdrstop #include +#pragma hdrstop #pragma package(smart_init) //--------------------------------------------------------------------------- diff --git a/Packages/CBuilder 10/VirtualTreesCR.cbproj b/Packages/CBuilder 10/VirtualTreesCR.cbproj index 44d09d510..a3828c321 100644 --- a/Packages/CBuilder 10/VirtualTreesCR.cbproj +++ b/Packages/CBuilder 10/VirtualTreesCR.cbproj @@ -13,21 +13,6 @@ true - - true - Base - true - - - true - Base - true - - - true - Base - true - true Base @@ -43,18 +28,6 @@ Base true - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - true Cfg_1 @@ -66,18 +39,6 @@ Base true - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - true Cfg_2 @@ -112,33 +73,16 @@ All true ..\..\Source\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(platform);$(BDS)\lib\$(Platform)\$(Config);$(ILINK_LibraryPath) + ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;$(ILINK_LibraryPath) false true true - - - android-support-v4.dex.jar;apk-expansion.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar - Debug - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=preferExternal;largeHeap=False;theme=TitleBar;hardwareAccelerated=true - false - - - $(MSBuildProjectName) - iPhoneAndiPad - CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user - Debug - - - $(MSBuildProjectName) - iPhoneAndiPad - CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user - Debug + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) true $(BDSINCLUDE)\windows\vcl;$(IncludePath) - C:\Program Files (x86)\Embarcadero\DelphiXE5\lib\win32\release\psdk\;$(ILINK_LibraryPath) true $(BDS)\bin\default_app.manifest 1033 @@ -150,44 +94,26 @@ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug\;$(IncludePath) false true false true false - Debug None DEBUG true true true - $(BDS)\lib\debug;$(ILINK_LibraryPath) true Full true - - true - - - true - _DEBUG;$(Defines) - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) None - - true - - - true - 1033 NDEBUG;$(Defines) @@ -206,50 +132,74 @@ 4 - - 7 - - - 8 - 0 - - 6 - + + 0 + + + 1 + - 16 + 2 + + + 3 + + + 4 + + + 5 - 16 + 6 - 16 + 7 + + + 8 + + + 9 + + + 10 + + + 11 + + + 12 + + + 13 - 17 + 14 + + + 15 + + + 16 17 - 17 + 18 + + + 19 - 17 + 20 - 17 - - - 17 - - - 17 - - - 17 + 21 Cfg_2 @@ -342,12 +292,7 @@ True False - - Embarcadero C++Builder-Package für Office 2000-Server - Embarcadero C++Builder-Package für Office XP-Server - 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 @@ -356,435 +301,11 @@ - False - False - False - False True True - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - VirtualTreesCR.bpl - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - - Contents\Resources - 1 - - - - - classes - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - Contents\MacOS - 0 - - - 1 - - - - - library\lib\mips - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 0 - - - 1 - - - 1 - - - 1 - - - library\lib\armeabi-v7a - 1 - - - 1 - - - - - 0 - - - 1 - .framework - - - - - 1 - - - 1 - - - 1 - - - - - library\lib\x86 - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - library\lib\armeabi - 1 - - - - - 0 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-normal - 1 - - - - - res\drawable-xhdpi - 1 - - - - - res\drawable-large - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable-hdpi - 1 - - - - - - - 1 - - - 1 - - - 1 - - - - - res\values - 1 - - - - - res\drawable-small - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - - - res\drawable - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-ldpi - 1 - - - - - 0 - .dll;.bpl - - - 1 - .dylib - - - - - - - - - - 12 - diff --git a/Packages/CBuilder 10/VirtualTreesCR.cpp b/Packages/CBuilder 10/VirtualTreesCR.cpp index d4fbb1610..37aacb559 100644 --- a/Packages/CBuilder 10/VirtualTreesCR.cpp +++ b/Packages/CBuilder 10/VirtualTreesCR.cpp @@ -1,7 +1,7 @@ //--------------------------------------------------------------------------- -#pragma hdrstop #include +#pragma hdrstop #pragma package(smart_init) //--------------------------------------------------------------------------- diff --git a/Packages/CBuilder XE5/VirtualTreeView.groupproj b/Packages/CBuilder 11/VirtualTreeView.groupproj similarity index 79% rename from Packages/CBuilder XE5/VirtualTreeView.groupproj rename to Packages/CBuilder 11/VirtualTreeView.groupproj index c44a4d884..1250e4780 100644 --- a/Packages/CBuilder XE5/VirtualTreeView.groupproj +++ b/Packages/CBuilder 11/VirtualTreeView.groupproj @@ -1,48 +1,48 @@ - - - {90943296-FDFA-4C80-A99D-237F570C4F54} - - - - - - - VirtualTreesCR.cbproj - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + {85AC5363-0DD3-4B39-8709-5987A7DA817E} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Packages/CBuilder 11/VirtualTreesCD.cbproj b/Packages/CBuilder 11/VirtualTreesCD.cbproj new file mode 100644 index 000000000..7d841d8bf --- /dev/null +++ b/Packages/CBuilder 11/VirtualTreesCD.cbproj @@ -0,0 +1,245 @@ + + + {DE1FB54C-6852-4F59-B4A5-7718E6069FE8} + VirtualTreesCD.cpp + 19.5 + Release + VCL + True + Win32 + 1 + Package + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + 280 + VirtualTree CBuilder designtime package + $(BDSCOMMONDIR)\hpp\$(Platform)\ + VirtualTreesCD + true + ..\..\Source;$(DCC_UnitSearchPath) + 4108 + System;Xml;Data;Datasnap;Web;Soap;Vcl;$(DCC_Namespace) + true + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 6 + -LUDesignIDE + true + bpl + CppPackage + true + true + true + All + true + ..\..\Source\;..\..\Design\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) + ..\..\Design\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;..\..\Source;$(ILINK_LibraryPath) + false + true + true + 128 + None + .\$(Platform)\$(Config) + true + .\$(Platform)\$(Config) + + + true + $(BDS)\bin\default_app.manifest + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + + + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + + + false + true + false + true + false + None + DEBUG + true + true + true + true + Full + true + + + _DEBUG;$(Defines) + 1033 + + + None + + + 1033 + NDEBUG;$(Defines) + + + + 0 + + + 10 + + + 5 + + + 1 + + + 4 + + + 0 + + + 9 + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + + CPlusPlusBuilder.Personality.12 + CppPackage + + + + VirtualTreesCD.cpp + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 4108 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + False + + + + + + + False + + False + + True + False + + + + False + True + True + False + + + + True + False + + + 12 + + + diff --git a/Packages/CBuilder XE8/VirtualTreesCD.cpp b/Packages/CBuilder 11/VirtualTreesCD.cpp similarity index 100% rename from Packages/CBuilder XE8/VirtualTreesCD.cpp rename to Packages/CBuilder 11/VirtualTreesCD.cpp diff --git a/Packages/CBuilder 11/VirtualTreesCR.cbproj b/Packages/CBuilder 11/VirtualTreesCR.cbproj new file mode 100644 index 000000000..97976818d --- /dev/null +++ b/Packages/CBuilder 11/VirtualTreesCR.cbproj @@ -0,0 +1,336 @@ + + + {FE6B0D67-74B6-4E30-8AED-CB2B3E77A51F} + VirtualTreesCR.cpp + 19.5 + Release + VCL + True + Win32 + 3 + Package + + + 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 + + + 280 + true + VirtualTree CBuilder runtime package + $(BDSCOMMONDIR)\hpp\$(Platform) + VirtualTreesCR + Shell32.dll;uxtheme.dll;$(ILINK_DelayLoadDll) + $(BDS)\lib;$(BDS)\lib\$(Platform);$(BDS)\lib\$(Platform)\$(Config);$(DCC_UnitSearchPath) + true + 4108 + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + true + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 6 + bpl + CppPackage + true + true + true + All + true + ..\..\Source\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) + ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(Platform)\$(Config);$(BDS)\lib\$(Platform)\release\psdk;$(ILINK_LibraryPath) + false + true + true + 128 + None + .\$(Platform)\$(Config) + true + .\$(Platform)\$(Config) + + + $(BDS)\Bin\BDS.EXE + true + $(BDSINCLUDE)\windows\vcl;$(IncludePath) + $(BDS)\bin\default_app.manifest + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + + + $(BDSINCLUDE)\windows\vcl;$(IncludePath) + 1033 + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + + + false + true + false + true + false + None + DEBUG + true + true + true + true + Full + true + + + _DEBUG;$(Defines) + 1033 + + + 1033 + + + None + + + 1033 + NDEBUG;$(Defines) + + + 1033 + + + + 3 + + + 9 + true + + + 9 + true + + + 18 + true + + + 18 + true + + + 4 + + + 0 + + + 0 + + + 1 + + + 2 + + + 3 + + + 4 + + + 5 + + + 6 + + + 7 + + + 8 + + + 9 + + + 10 + + + 11 + + + 12 + + + 13 + + + 14 + + + 15 + + + 16 + + + 17 + + + 18 + + + 19 + + + 20 + + + 21 + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + + CPlusPlusBuilder.Personality.12 + CppPackage + + + + VirtualTreesCR.cpp + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 4108 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + False + + + + + + + False + + False + + True + False + + + + False + True + True + False + + + + True + True + + + 12 + + + diff --git a/Packages/CBuilder XE8/VirtualTreesCR.cpp b/Packages/CBuilder 11/VirtualTreesCR.cpp similarity index 100% rename from Packages/CBuilder XE8/VirtualTreesCR.cpp rename to Packages/CBuilder 11/VirtualTreesCR.cpp diff --git a/Packages/CBuilder 12/VirtualTrees.groupproj b/Packages/CBuilder 12/VirtualTrees.groupproj new file mode 100644 index 000000000..6c0680676 --- /dev/null +++ b/Packages/CBuilder 12/VirtualTrees.groupproj @@ -0,0 +1,48 @@ + + + {BF155D09-6AED-4790-9020-744D12876B35} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Packages/CBuilder 12/VirtualTreesCD.cbproj b/Packages/CBuilder 12/VirtualTreesCD.cbproj new file mode 100644 index 000000000..35a254c21 --- /dev/null +++ b/Packages/CBuilder 12/VirtualTreesCD.cbproj @@ -0,0 +1,215 @@ + + + {B6350E5E-13A2-44EC-8515-C119E896CB47} + 20.3 + VCL + VirtualTreesCD.cpp + True + Release + Win32 + VirtualTreesCD + 1048579 + Package + c + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + true + -LUDesignIDE + true + .\Design\$(Platform)\$(Config) + false + true + true + $(BDSLIB)\$(PLATFORM)\release\$(LANGDIR);$(ILINK_TranslatedLibraryPath) + CppPackage + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + true + true + <_TCHARMapping>wchar_t + true + VirtualTreesCD + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + VirtualTrees Designtime + ..\..\Source;$(DCC_UnitSearchPath) + All + true + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + $(BDSINCLUDE)\windows\vcl;$(IncludePath) + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + $(BDSINCLUDE)\windows\vcl;$(IncludePath) + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + true + + + false + true + false + true + _DEBUG;$(Defines) + false + None + DEBUG + true + true + true + true + Full + true + true + true + true + true + $(BDSLIB)\$(PLATFORM)\debug;$(ILINK_LibraryPath) + $(BDSLIB)\$(PLATFORM)\debug\$(LANGDIR);$(ILINK_TranslatedLibraryPath) + + + false + $(BDSLIB)\$(PLATFORM)$(CC_SUFFIX)\debug;$(ILINK_LibraryPath) + true + VirtualTrees Designtime + + + true + + + true + + + NDEBUG;$(Defines) + None + + + false + true + + + + {4AB7ABC9-E87D-4D9D-99AF-39363FDE2732} + 2 + + + 4 + + + 5 + + + 1 + + + 3 + + + 0 + + + 12 + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + CPlusPlusBuilder.Personality.12 + CppPackage + + + + False + False + True + True + + + VirtualTreesCD.cpp + + + + + + + True + True + True + + + 12 + + + + + diff --git a/Packages/RAD Studio XE5/VirtualTreesD.cpp b/Packages/CBuilder 12/VirtualTreesCD.cpp similarity index 62% rename from Packages/RAD Studio XE5/VirtualTreesD.cpp rename to Packages/CBuilder 12/VirtualTreesCD.cpp index 37aacb559..4927fbe10 100644 --- a/Packages/RAD Studio XE5/VirtualTreesD.cpp +++ b/Packages/CBuilder 12/VirtualTreesCD.cpp @@ -1,6 +1,6 @@ //--------------------------------------------------------------------------- -#include +#include #pragma hdrstop #pragma package(smart_init) //--------------------------------------------------------------------------- @@ -8,10 +8,14 @@ // Package source. //--------------------------------------------------------------------------- +#pragma comment(lib, "shcore") +#pragma comment(lib, "uxtheme") +#pragma comment(lib, "windowscodecs") +//#pragma comment(lib, "VirtualTrees_R") #pragma argsused -int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +extern "C" int _libmain(unsigned long reason) { - return 1; + return 1; } //--------------------------------------------------------------------------- diff --git a/Packages/CBuilder 12/VirtualTreesCR.cbproj b/Packages/CBuilder 12/VirtualTreesCR.cbproj new file mode 100644 index 000000000..43b617463 --- /dev/null +++ b/Packages/CBuilder 12/VirtualTreesCR.cbproj @@ -0,0 +1,290 @@ + + + {2381F390-47E4-4CAA-BAF9-857BF136C307} + 20.3 + VCL + VirtualTreesCR.cpp + True + Release + Win32 + VirtualTreesCR + 1048579 + Package + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + All + true + true + .\Runtime\$(Platform)\$(Config) + false + true + true + $(BDSLIB)\$(PLATFORM)\release\$(LANGDIR);$(ILINK_TranslatedLibraryPath) + CppPackage + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + bpl + true + true + <_TCHARMapping>wchar_t + true + VirtualTreesCR + ..\..\Source;$(DCC_UnitSearchPath) + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 6 + true + $(BDSCOMMONDIR)\hpp\$(Platform) + true + VirtualTrees Runtime + true + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + $(BDSINCLUDE)\windows\vcl;$(IncludePath) + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + $(BDSINCLUDE)\windows\vcl;$(IncludePath) + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + true + + + false + true + false + true + _DEBUG;$(Defines) + false + None + DEBUG + true + true + true + true + Full + true + true + true + true + true + $(BDSLIB)\$(PLATFORM)\debug;$(ILINK_LibraryPath) + $(BDSLIB)\$(PLATFORM)\debug\$(LANGDIR);$(ILINK_TranslatedLibraryPath) + + + false + $(BDSLIB)\$(PLATFORM)$(CC_SUFFIX)\debug;$(ILINK_LibraryPath) + + + NDEBUG;$(Defines) + None + + + true + VirtualTrees Runtime + + + true + + + true + + + + 1 + + + 32 + + + 0 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 3 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 4 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 5 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 6 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 7 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 8 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 9 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 10 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 11 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 12 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 13 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 14 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 15 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 16 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 17 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 18 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 19 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 20 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 21 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 22 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 23 + + + {FF0836F4-FE45-4852-8226-19028E202F2D} + 24 + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + CPlusPlusBuilder.Personality.12 + CppPackage + + + + False + False + True + True + + + VirtualTreesCR.cpp + + + + + + + True + True + True + + + 12 + + + + + diff --git a/Packages/RAD Studio XE5/VirtualTreesR.cpp b/Packages/CBuilder 12/VirtualTreesCR.cpp similarity index 66% rename from Packages/RAD Studio XE5/VirtualTreesR.cpp rename to Packages/CBuilder 12/VirtualTreesCR.cpp index 37aacb559..80bc9ffc8 100644 --- a/Packages/RAD Studio XE5/VirtualTreesR.cpp +++ b/Packages/CBuilder 12/VirtualTreesCR.cpp @@ -1,17 +1,21 @@ //--------------------------------------------------------------------------- -#include +#include #pragma hdrstop #pragma package(smart_init) + //--------------------------------------------------------------------------- // Package source. //--------------------------------------------------------------------------- +#pragma comment(lib, "shcore") +#pragma comment(lib, "uxtheme") +#pragma comment(lib, "windowscodecs") #pragma argsused -int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +extern "C" int _libmain(unsigned long reason) { - return 1; + return 1; } //--------------------------------------------------------------------------- diff --git a/Packages/CBuilder XE5/VirtualTreesCD.cbproj b/Packages/CBuilder XE5/VirtualTreesCD.cbproj deleted file mode 100644 index 5968e74ba..000000000 --- a/Packages/CBuilder XE5/VirtualTreesCD.cbproj +++ /dev/null @@ -1,619 +0,0 @@ - - - {DE1FB54C-6852-4F59-B4A5-7718E6069FE8} - VirtualTreesCD.cpp - 16.1 - Release - VCL - True - Win32 - 1 - Package - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - VirtualTree CBuilder designtime package - ..\..\source - VirtualTreesCD - true - ..\..\source;$(DCC_UnitSearchPath) - 4108 - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - true - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 6 - -LUDesignIDE - true - bpl - CppPackage - true - true - true - All - true - ..\..\..\..\EMBT\VirtualTree\Design\;..\..\..\..\SourceForge\VirtualTree\Packages\CBuilder XE7\;..\..\Source\;..\RAD Studio XE5\;..\..\Design\;..\..\Common\;$(CG_BOOST_ROOT)\boost\tr1\tr1;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(CG_BOOST_ROOT);$(IncludePath) - ..\..\..\..\EMBT\VirtualTree\Design\;..\..\..\..\SourceForge\VirtualTree\Packages\CBuilder XE7\;..\RAD Studio XE5\;..\..\Design\;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;..\..\source;$(ILINK_LibraryPath) - false - true - true - - - Debug - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=preferExternal;largeHeap=False;theme=TitleBar;hardwareAccelerated=true - false - - - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - true - $(BDS)\bin\default_app.manifest - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - - - Debug\;$(IncludePath) - false - true - false - true - false - Debug - None - DEBUG - true - true - true - $(BDS)\lib\debug;$(ILINK_LibraryPath) - true - Full - true - - - _DEBUG;$(Defines) - - - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) - None - - - 1033 - NDEBUG;$(Defines) - - - - 9 - - - 10 - - - 5 - - - 1 - - - 4 - - - 7 - - - 10 - - - 8 - - - 0 - - - 9 - - - 6 - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - CPlusPlusBuilder.Personality.12 - CppPackage - - - - VirtualTreesCD.cpp - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 4108 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - False - - - - - - - False - - False - - True - False - - - Embarcadero C++Builder-Package für Office 2000-Server - Embarcadero C++Builder-Package für Office XP-Server - 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 - - - - False - False - False - True - False - - - - - true - - - - - true - - - true - - - - - true - - - - - VirtualTreesCD.bpl - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - 1 - .dylib - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - - - 1 - - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - res\drawable-normal - 1 - - - - - library\lib\x86 - 1 - - - - - 1 - - - 1 - - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-xhdpi - 1 - - - - - 1 - - - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - library\lib\mips - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 0 - - - - - 1 - .framework - - - 0 - - - - - res\drawable-small - 1 - - - - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - - 1 - - - 1 - - - - - res\drawable - 1 - - - - - Contents\Resources - 1 - - - - - - 1 - - - 1 - - - - - 1 - - - library\lib\armeabi-v7a - 1 - - - 0 - - - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - res\drawable-large - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - 1 - - - 1 - - - - - res\drawable-ldpi - 1 - - - - - res\values - 1 - - - - - 1 - - - 1 - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - - - 1 - - - - - - - - - - - 12 - - - - diff --git a/Packages/CBuilder XE5/VirtualTreesCR.cbproj b/Packages/CBuilder XE5/VirtualTreesCR.cbproj deleted file mode 100644 index 40983eb57..000000000 --- a/Packages/CBuilder XE5/VirtualTreesCR.cbproj +++ /dev/null @@ -1,616 +0,0 @@ - - - {FE6B0D67-74B6-4E30-8AED-CB2B3E77A51F} - VirtualTreesCR.cpp - 16.1 - Release - VCL - True - Win32 - 3 - Package - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - true - VirtualTree CBuilder runtime package - ..\..\source - VirtualTreesCR - Shell32.dll;$(ILINK_DelayLoadDll) - $(BDS)\lib;$(BDS)\lib\$(Platform);$(BDS)\lib\$(Platform)\$(Config);$(DCC_UnitSearchPath) - true - 4108 - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - true - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 6 - bpl - CppPackage - true - true - true - All - true - $(CG_BOOST_ROOT);$(CG_BOOST_ROOT)\boost\tr1\tr1;..\..\Source\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(platform);$(BDS)\lib\$(Platform)\$(Config);$(ILINK_LibraryPath) - false - true - true - - - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - C:\Program Files (x86)\Embarcadero\DelphiXE5\lib\win32\release\psdk\;$(ILINK_LibraryPath) - true - $(BDS)\bin\default_app.manifest - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - - - Debug\;$(IncludePath) - false - true - false - true - false - Debug - None - DEBUG - true - true - true - $(BDS)\lib\debug;$(ILINK_LibraryPath) - true - Full - true - - - _DEBUG;$(Defines) - - - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) - None - - - 1033 - NDEBUG;$(Defines) - - - 1033 - - - - 17 - true - - - 1 - - - 4 - - - 7 - - - 8 - - - 0 - - - 6 - - - 15 - - - 10 - - - 11 - - - 16 - - - 9 - - - 12 - - - 13 - - - 14 - - - 8 - - - 9 - - - 17 - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - CPlusPlusBuilder.Personality.12 - CppPackage - - - - VirtualTreesCR.cpp - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 4108 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - False - - - - - - - False - - False - - True - False - - - Embarcadero C++Builder-Package für Office 2000-Server - Embarcadero C++Builder-Package für Office XP-Server - Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver - Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server - Datei C:\Program Files (x86)\Raize\CS5\Bin\CodeSiteExpressPkg_Design210.bpl nicht gefunden - - - False - True - True - False - - - - False - False - True - True - - - - - - - - - - - - - - - - - - - - - - - - - - VirtualTreesCR.bpl - - - - - - - - 1 - .dylib - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - - - 1 - - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - res\drawable-normal - 1 - - - - - library\lib\x86 - 1 - - - - - 1 - - - 1 - - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-xhdpi - 1 - - - - - 1 - - - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - library\lib\mips - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 0 - - - - - 1 - .framework - - - 0 - - - - - res\drawable-small - 1 - - - - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - - 1 - - - 1 - - - - - res\drawable - 1 - - - - - Contents\Resources - 1 - - - - - - 1 - - - 1 - - - - - 1 - - - library\lib\armeabi-v7a - 1 - - - 0 - - - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - res\drawable-large - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - 1 - - - 1 - - - - - res\drawable-ldpi - 1 - - - - - res\values - 1 - - - - - 1 - - - 1 - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - - - 1 - - - - - - - - - - - 12 - - - - diff --git a/Packages/CBuilder XE7/VirtualTreesCD.cbproj b/Packages/CBuilder XE7/VirtualTreesCD.cbproj deleted file mode 100644 index a022c44ff..000000000 --- a/Packages/CBuilder XE7/VirtualTreesCD.cbproj +++ /dev/null @@ -1,669 +0,0 @@ - - - {DE1FB54C-6852-4F59-B4A5-7718E6069FE8} - VirtualTreesCD.cpp - 18.0 - Release - VCL - True - Win32 - 1 - Package - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - VirtualTree CBuilder designtime package - ..\..\Source - VirtualTreesCD - true - ..\..\source;$(DCC_UnitSearchPath) - 4108 - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - true - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 6 - -LUDesignIDE - true - bpl - CppPackage - true - true - true - All - true - ..\..\Source\;..\..\Design\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\..\Source\;..\RAD Studio XE5\;..\..\Design\;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;..\..\source;$(ILINK_LibraryPath) - false - true - true - - - C:\Program Files (x86)\Embarcadero\Studio\16.0\lib\win32\release\psdk\;$(ILINK_LibraryPath) - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - true - true - $(BDS)\bin\default_app.manifest - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - - - true - true - true - true - off - Debug\;$(IncludePath) - false - true - false - true - false - Debug - None - DEBUG - true - true - true - $(BDS)\lib\debug;$(ILINK_LibraryPath) - true - Full - true - - - $(BDS)\Bin\BDS.EXE - true - true - true - off - 1033 - true - _DEBUG;$(Defines) - - - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) - None - - - 1033 - NDEBUG;$(Defines) - - - - 16 - true - - - 3 - - - 5 - - - 1 - - - 4 - - - 0 - - - 5 - - - 6 - - - 7 - - - 8 - - - 10 - - - 11 - - - 12 - - - 13 - - - 14 - - - 15 - - - 16 - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - CPlusPlusBuilder.Personality.12 - CppPackage - - - - VirtualTreesCD.cpp - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 4108 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - False - - - - - - - False - - False - - True - False - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - - - False - True - True - False - - - - True - False - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - VirtualTreesCD.tds - true - - - - - true - - - - - VirtualTreesCD.bpl - true - - - - - true - - - - - 1 - .dylib - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - - - 1 - - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - res\drawable-normal - 1 - - - - - library\lib\x86 - 1 - - - - - 1 - - - 1 - - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-xhdpi - 1 - - - - - 1 - - - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - library\lib\mips - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 0 - - - - - 1 - .framework - - - 0 - - - - - res\drawable-small - 1 - - - - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - - 1 - - - 1 - - - - - res\drawable - 1 - - - - - Contents\Resources - 1 - - - - - - 1 - - - 1 - - - - - 1 - - - library\lib\armeabi-v7a - 1 - - - 0 - - - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - res\drawable-large - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - 1 - - - 1 - - - - - res\drawable-ldpi - 1 - - - - - res\values - 1 - - - - - 1 - - - 1 - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - - - 1 - - - - - - - - - - - - - 12 - - - - diff --git a/Packages/CBuilder XE7/VirtualTreesCR.cbproj b/Packages/CBuilder XE7/VirtualTreesCR.cbproj deleted file mode 100644 index 10a0ae752..000000000 --- a/Packages/CBuilder XE7/VirtualTreesCR.cbproj +++ /dev/null @@ -1,701 +0,0 @@ - - - {FE6B0D67-74B6-4E30-8AED-CB2B3E77A51F} - VirtualTreesCR.cpp - 18.0 - Release - VCL - True - Win32 - 3 - Package - - - 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 - VirtualTree CBuilder runtime package - ..\..\Source - VirtualTreesCR - Shell32.dll;$(ILINK_DelayLoadDll) - $(BDS)\lib;$(BDS)\lib\$(Platform);$(BDS)\lib\$(Platform)\$(Config);$(DCC_UnitSearchPath) - true - 4108 - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - true - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 6 - bpl - CppPackage - true - true - true - All - true - ..\..\Source\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(platform);$(BDS)\lib\$(Platform)\$(Config);$(ILINK_LibraryPath) - false - true - true - - - $(BDS)\Bin\BDS.EXE - true - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - C:\Program Files (x86)\Embarcadero\DelphiXE5\lib\win32\release\psdk\;$(ILINK_LibraryPath) - true - $(BDS)\bin\default_app.manifest - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - ..\..\Source - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - - - true - true - true - true - off - Debug\;$(IncludePath) - false - true - false - true - false - Debug - None - DEBUG - true - true - true - $(BDS)\lib\debug;$(ILINK_LibraryPath) - true - Full - true - - - true - true - true - ..\..\Source - off - 1033 - true - _DEBUG;$(Defines) - - - 1033 - - - ..\..\Source - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) - None - - - 1033 - NDEBUG;$(Defines) - - - 1033 - - - - 9 - true - - - 1 - - - 4 - - - 7 - - - 8 - - - 0 - - - 6 - - - 16 - - - 16 - - - 16 - - - 17 - - - 17 - - - 17 - - - 17 - - - 17 - - - 17 - - - 17 - - - 17 - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - CPlusPlusBuilder.Personality.12 - CppPackage - - - - VirtualTreesCR.cpp - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 4108 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - False - - - - - - - False - - False - - True - False - - - (untitled) - (untitled) - - - False - True - True - False - - - - True - True - - - - - true - - - - - true - - - - - true - - - - - true - - - - - VirtualTreesCR.bpl - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - res\drawable-normal - 1 - - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - .dylib - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - - - library\lib\mips - 1 - - - - - library\lib\x86 - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - - 1 - - - 1 - - - - - 1 - - - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - 1 - - - 1 - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - - - res\drawable - 1 - - - - - 1 - .framework - - - 0 - - - - - 1 - - - 1 - - - 0 - - - - - res\drawable-small - 1 - - - - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - - 1 - - - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - - - - Contents\Resources - 1 - - - - - 1 - - - 1 - - - - - 1 - - - library\lib\armeabi-v7a - 1 - - - 0 - - - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - res\drawable-large - 1 - - - - - 1 - - - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - res\values - 1 - - - - - res\drawable-ldpi - 1 - - - - - 1 - - - 1 - - - - - res\drawable-hdpi - 1 - - - - - res\drawable-mdpi - 1 - - - - - 1 - - - - - - - - - - - - - 12 - - - - diff --git a/Packages/CBuilder XE8/VirtualTreesCD.cbproj b/Packages/CBuilder XE8/VirtualTreesCD.cbproj deleted file mode 100644 index d6a132138..000000000 --- a/Packages/CBuilder XE8/VirtualTreesCD.cbproj +++ /dev/null @@ -1,707 +0,0 @@ - - - {DE1FB54C-6852-4F59-B4A5-7718E6069FE8} - VirtualTreesCD.cpp - 18.0 - Release - VCL - True - Win32 - 1 - Package - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - VirtualTree CBuilder designtime package - ..\..\Source - VirtualTreesCD - true - ..\..\source;$(DCC_UnitSearchPath) - 4108 - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - true - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 6 - -LUDesignIDE - true - bpl - CppPackage - true - true - true - All - true - ..\..\Source\;..\..\Design\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\..\Source\;..\RAD Studio XE5\;..\..\Design\;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;..\..\source;$(ILINK_LibraryPath) - false - true - true - - - C:\Program Files (x86)\Embarcadero\Studio\16.0\lib\win32\release\psdk\;$(ILINK_LibraryPath) - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - true - true - $(BDS)\bin\default_app.manifest - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - - - true - true - true - true - off - Debug\;$(IncludePath) - false - true - false - true - false - Debug - None - DEBUG - true - true - true - $(BDS)\lib\debug;$(ILINK_LibraryPath) - true - Full - true - - - $(BDS)\Bin\BDS.EXE - true - true - true - off - 1033 - true - _DEBUG;$(Defines) - - - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) - None - - - 1033 - NDEBUG;$(Defines) - - - - 16 - true - - - 3 - - - 5 - - - 1 - - - 4 - - - 0 - - - 5 - - - 6 - - - 7 - - - 8 - - - 10 - - - 11 - - - 12 - - - 13 - - - 14 - - - 15 - - - 16 - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - CPlusPlusBuilder.Personality.12 - CppPackage - - - - VirtualTreesCD.cpp - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 4108 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - False - - - - - - - False - - False - - True - False - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - - - False - True - True - False - - - - True - False - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - VirtualTreesCD.tds - true - - - - - true - - - - - VirtualTreesCD.bpl - true - - - - - true - - - - - 1 - .dylib - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - - - 1 - - - 1 - - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - res\drawable-normal - 1 - - - - - library\lib\x86 - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-xhdpi - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - library\lib\mips - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 0 - - - - - 1 - .framework - - - 0 - - - - - res\drawable-small - 1 - - - - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable - 1 - - - - - Contents\Resources - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi-v7a - 1 - - - 1 - - - 0 - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - res\drawable-large - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-ldpi - 1 - - - - - res\values - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - - - 1 - - - - - - - - - - - - - 12 - - - - diff --git a/Packages/CBuilder XE8/VirtualTreesCR.cbproj b/Packages/CBuilder XE8/VirtualTreesCR.cbproj deleted file mode 100644 index ff8f87f71..000000000 --- a/Packages/CBuilder XE8/VirtualTreesCR.cbproj +++ /dev/null @@ -1,742 +0,0 @@ - - - {FE6B0D67-74B6-4E30-8AED-CB2B3E77A51F} - VirtualTreesCR.cpp - 18.0 - Release - VCL - True - Win32 - 3 - Package - - - 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 - VirtualTree CBuilder runtime package - ..\..\Source - VirtualTreesCR - Shell32.dll;$(ILINK_DelayLoadDll) - $(BDS)\lib;$(BDS)\lib\$(Platform);$(BDS)\lib\$(Platform)\$(Config);$(DCC_UnitSearchPath) - true - 4108 - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - true - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - 6 - bpl - CppPackage - true - true - true - All - true - ..\..\Source\;$(BDS)\include;$(BDS)\include\windows;$(BDS)\include\windows\rtl;$(BDS)\include\windows\vcl;$(BDS)\include\windows\crtl;$(BDS)\include\windows\sdk;$(IncludePath) - ..\..\Source\;$(BDS)\lib;$(BDS)\lib\$(platform);$(BDS)\lib\$(Platform)\$(Config);$(ILINK_LibraryPath) - false - true - true - - - $(BDS)\Bin\BDS.EXE - true - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - C:\Program Files (x86)\Embarcadero\DelphiXE5\lib\win32\release\psdk\;$(ILINK_LibraryPath) - true - $(BDS)\bin\default_app.manifest - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - $(BDSCOMMONDIR)\DCP\$(Platform) - $(BdsCommponDir)\Dcp\$(Platform) - $(BDSINCLUDE)\windows\vcl;$(IncludePath) - 1033 - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - - - true - true - true - true - off - Debug\;$(IncludePath) - false - true - false - true - false - Debug - None - DEBUG - true - true - true - $(BDS)\lib\debug;$(ILINK_LibraryPath) - true - Full - true - - - true - true - true - ..\..\Source - off - 1033 - true - _DEBUG;$(Defines) - - - 1033 - - - ..\..\Source - Release\;$(IncludePath) - Release - $(BDS)\lib\release;$(ILINK_LibraryPath) - None - - - 1033 - NDEBUG;$(Defines) - - - 1033 - - - - 9 - true - - - 1 - - - 4 - - - 7 - - - 8 - - - 0 - - - 6 - - - 16 - - - 16 - - - 16 - - - 17 - - - 17 - - - 17 - - - 17 - - - 17 - - - 17 - - - 17 - - - 17 - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - CPlusPlusBuilder.Personality.12 - CppPackage - - - - VirtualTreesCR.cpp - - - False - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 4108 - 1252 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - False - - - - - - - False - - False - - True - False - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - - - False - True - True - False - - - - True - True - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - VirtualTreesCR.bpl - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - true - - - - - res\drawable-normal - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - .dylib - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - - - library\lib\mips - 1 - - - - - library\lib\x86 - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - - - res\drawable - 1 - - - - - 1 - .framework - - - 0 - - - - - 1 - - - 1 - - - 0 - - - - - res\drawable-small - 1 - - - - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - - - - Contents\Resources - 1 - - - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi-v7a - 1 - - - 1 - - - 0 - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - res\drawable-large - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - res\values - 1 - - - - - res\drawable-ldpi - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-hdpi - 1 - - - - - res\drawable-mdpi - 1 - - - - - 1 - - - - - - - - - - - - - 12 - - - - diff --git a/Packages/RAD Studio 10.1/VirtualTreesR.dpk b/Packages/RAD Studio 10.1/VirtualTreesR.dpk index 186395feb..6f2d721d6 100644 --- a/Packages/RAD Studio 10.1/VirtualTreesR.dpk +++ b/Packages/RAD Studio 10.1/VirtualTreesR.dpk @@ -34,18 +34,27 @@ requires vclx; contains - VirtualTrees in '..\..\Source\VirtualTrees.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', + VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', + VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas', VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas', VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.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.Utils in '..\..\Source\VirtualTrees.Utils.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/Packages/RAD Studio 10.1/VirtualTreesR.dproj b/Packages/RAD Studio 10.1/VirtualTreesR.dproj index 9eab59276..8baa133a8 100644 --- a/Packages/RAD Studio 10.1/VirtualTreesR.dproj +++ b/Packages/RAD Studio 10.1/VirtualTreesR.dproj @@ -79,17 +79,28 @@ - - - - + + - - + + + + + + + + + + + + + + + Cfg_2 Base diff --git a/Packages/RAD Studio 10.2/VirtualTreesD.dpk b/Packages/RAD Studio 10.2/VirtualTreesD.dpk index c6250eea2..f621bc032 100644 --- a/Packages/RAD Studio 10.2/VirtualTreesD.dpk +++ b/Packages/RAD Studio 10.2/VirtualTreesD.dpk @@ -1,6 +1,6 @@ -package VirtualTreesD; - -{$R *.res} +package VirtualTreesD; + +{$R *.res} {$R '..\..\Design\VirtualTrees.dcr'} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} @@ -31,12 +31,12 @@ package VirtualTreesD; {$DESIGNONLY} {$IMPLICITBUILD OFF} -requires +requires DesignIDE, VirtualTreesR; -contains +contains VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; -end. - +end. + diff --git a/Packages/RAD Studio 10.2/VirtualTreesR.dpk b/Packages/RAD Studio 10.2/VirtualTreesR.dpk index 527e8a9a0..c58d9234f 100644 --- a/Packages/RAD Studio 10.2/VirtualTreesR.dpk +++ b/Packages/RAD Studio 10.2/VirtualTreesR.dpk @@ -34,18 +34,27 @@ requires vclx; contains - VirtualTrees in '..\..\Source\VirtualTrees.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', + VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', + VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas', VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas', VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.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.Utils in '..\..\Source\VirtualTrees.Utils.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/Packages/RAD Studio 10.2/VirtualTreesR.dproj b/Packages/RAD Studio 10.2/VirtualTreesR.dproj index b1c9bb26f..ded52d8f1 100644 --- a/Packages/RAD Studio 10.2/VirtualTreesR.dproj +++ b/Packages/RAD Studio 10.2/VirtualTreesR.dproj @@ -79,17 +79,28 @@ - - - - + + - - + + + + + + + + + + + + + + + Cfg_2 Base diff --git a/Packages/RAD Studio 10.3/VirtualTreesD.dpk b/Packages/RAD Studio 10.3/VirtualTreesD.dpk index d4cff33ac..eb9f5e095 100644 --- a/Packages/RAD Studio 10.3/VirtualTreesD.dpk +++ b/Packages/RAD Studio 10.3/VirtualTreesD.dpk @@ -1,6 +1,6 @@ -package VirtualTreesD; - -{$R *.res} +package VirtualTreesD; + +{$R *.res} {$R '..\..\Design\VirtualTrees.dcr'} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} @@ -31,12 +31,12 @@ package VirtualTreesD; {$DESIGNONLY} {$IMPLICITBUILD OFF} -requires +requires DesignIDE, VirtualTreesR; -contains +contains VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; -end. - +end. + diff --git a/Packages/RAD Studio 10.3/VirtualTreesD.dproj b/Packages/RAD Studio 10.3/VirtualTreesD.dproj index 0b0468d20..0f72d77d7 100644 --- a/Packages/RAD Studio 10.3/VirtualTreesD.dproj +++ b/Packages/RAD Studio 10.3/VirtualTreesD.dproj @@ -1,4 +1,4 @@ - + {A34BA07B-19B6-4C21-9DEE-65FCA52D00AB} VirtualTreesD.dpk @@ -38,7 +38,7 @@ All 26 true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) + ..\..\source;.\$(Platform)\$(Config);$(BDSCOMMONDIR)\dcp;$(DCC_UnitSearchPath) System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 1053 false diff --git a/Packages/RAD Studio 10.3/VirtualTreesR.dpk b/Packages/RAD Studio 10.3/VirtualTreesR.dpk index d27dfdafa..038180285 100644 --- a/Packages/RAD Studio 10.3/VirtualTreesR.dpk +++ b/Packages/RAD Studio 10.3/VirtualTreesR.dpk @@ -9,7 +9,7 @@ package VirtualTreesR; {$EXTENDEDSYNTAX ON} {$IMPORTEDDATA ON} {$IOCHECKS ON} -{$LOCALSYMBOLS ON} +{$LOCALSYMBOLS OFF} {$LONGSTRINGS ON} {$OPENSTRINGS ON} {$OPTIMIZATION ON} @@ -44,8 +44,17 @@ contains VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas', VirtualTrees.Export in '..\..\Source\VirtualTrees.Export.pas', - VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas'; + VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas', + VirtualTrees.Types in '..\..\Source\VirtualTrees.Types.pas', + VirtualTrees.Header in '..\..\Source\VirtualTrees.Header.pas', + VirtualTrees.DataObject in '..\..\Source\VirtualTrees.DataObject.pas', + VirtualTrees.DragnDrop in '..\..\Source\VirtualTrees.DragnDrop.pas', + VirtualTrees.DragImage in '..\..\Source\VirtualTrees.DragImage.pas', + VirtualTrees.EditLink in '..\..\Source\VirtualTrees.EditLink.pas', + VirtualTrees.Colors in '..\..\Source\VirtualTrees.Colors.pas', + VirtualTrees.DrawTree in '..\..\Source\VirtualTrees.DrawTree.pas', + VirtualTrees.AncestorVcl in '..\..\Source\VirtualTrees.AncestorVcl.pas', + VirtualTrees.BaseAncestorVcl in '..\..\Source\VirtualTrees.BaseAncestorVcl.pas', + VirtualTrees.BaseTree in '..\..\source\VirtualTrees.BaseTree.pas'; end. - - diff --git a/Packages/RAD Studio 10.3/VirtualTreesR.dproj b/Packages/RAD Studio 10.3/VirtualTreesR.dproj index 346c57e3b..61c4dfe98 100644 --- a/Packages/RAD Studio 10.3/VirtualTreesR.dproj +++ b/Packages/RAD Studio 10.3/VirtualTreesR.dproj @@ -7,7 +7,7 @@ Package VCL DCC32 - 18.5 + 18.8 Win32 3 @@ -90,6 +90,17 @@ + + + + + + + + + + + Cfg_2 Base @@ -137,7 +148,7 @@ 1.0.0.0 - + True diff --git a/Packages/RAD Studio XE4/VirtualTreeView.groupproj b/Packages/RAD Studio 10.4+/VirtualTreeView.groupproj similarity index 97% rename from Packages/RAD Studio XE4/VirtualTreeView.groupproj rename to Packages/RAD Studio 10.4+/VirtualTreeView.groupproj index 980342db8..b0f33e510 100644 --- a/Packages/RAD Studio XE4/VirtualTreeView.groupproj +++ b/Packages/RAD Studio 10.4+/VirtualTreeView.groupproj @@ -1,48 +1,48 @@ - - - {CC6A9541-DD5C-4BCD-8914-016D8D2EAB3B} - - - - - - - VirtualTreesR.dproj - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + {CC6A9541-DD5C-4BCD-8914-016D8D2EAB3B} + + + + + + + VirtualTreesR.dproj + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Packages/RAD Studio XE7/VirtualTreesD.dpk b/Packages/RAD Studio 10.4+/VirtualTreesD.dpk similarity index 84% rename from Packages/RAD Studio XE7/VirtualTreesD.dpk rename to Packages/RAD Studio 10.4+/VirtualTreesD.dpk index 964496650..601b5477a 100644 --- a/Packages/RAD Studio XE7/VirtualTreesD.dpk +++ b/Packages/RAD Studio 10.4+/VirtualTreesD.dpk @@ -1,4 +1,4 @@ -package VirtualTreesD; +package VirtualTreesD; {$R *.res} {$R '..\..\Design\VirtualTrees.dcr'} @@ -10,13 +10,13 @@ package VirtualTreesD; {$EXTENDEDSYNTAX ON} {$IMPORTEDDATA ON} {$IOCHECKS ON} -{$LOCALSYMBOLS OFF} +{$LOCALSYMBOLS ON} {$LONGSTRINGS ON} {$OPENSTRINGS ON} {$OPTIMIZATION ON} {$OVERFLOWCHECKS OFF} {$RANGECHECKS OFF} -{$REFERENCEINFO OFF} +{$REFERENCEINFO ON} {$SAFEDIVIDE OFF} {$STACKFRAMES OFF} {$TYPEDADDRESS OFF} @@ -27,7 +27,7 @@ package VirtualTreesD; {$DEFINE RELEASE} {$ENDIF IMPLICITBUILDING} {$DESCRIPTION 'VirtualTreeView Controls'} -{$LIBSUFFIX '21'} +{$LIBSUFFIX AUTO} {$DESIGNONLY} {$IMPLICITBUILD OFF} @@ -39,4 +39,3 @@ contains VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; end. - diff --git a/Packages/RAD Studio XE8/VirtualTreesD.dproj b/Packages/RAD Studio 10.4+/VirtualTreesD.dproj similarity index 80% rename from Packages/RAD Studio XE8/VirtualTreesD.dproj rename to Packages/RAD Studio 10.4+/VirtualTreesD.dproj index 7b6a313c5..b0cc108a4 100644 --- a/Packages/RAD Studio XE8/VirtualTreesD.dproj +++ b/Packages/RAD Studio 10.4+/VirtualTreesD.dproj @@ -1,15 +1,16 @@  - {A34BA07B-19B6-4C21-9DEE-65FCA52D00AB} - VirtualTreesD.dpk True - Release Package - VCL + Release DCC32 - 17.2 + VCL + VirtualTreesD.dpk Win32 - 1 + {A34BA07B-19B6-4C21-9DEE-65FCA52D00AB} + 20.2 + 1048577 + VirtualTreesD true @@ -19,6 +20,11 @@ Base true + + true + Base + true + true Base @@ -31,40 +37,41 @@ VirtualTreesD - ..\..\Source + All .\$(Platform)\$(Config) - true VirtualTreeView Controls - All - 22 - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) + ..\..\Source + 00400000 System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false + true + ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) + true + $(Auto) + true true - 00400000 CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false + 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 + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + true - false RELEASE;$(DCC_Define) - 0 - 0 DEBUG;$(DCC_Define) - false true + false @@ -74,10 +81,6 @@ - - Cfg_2 - Base - Base @@ -85,6 +88,10 @@ Cfg_1 Base + + Cfg_2 + Base + Delphi.Personality.12 @@ -94,6 +101,7 @@ VirtualTreesD.dpk + True False @@ -121,15 +129,11 @@ 1.0.0.0 - - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - True + False + True 12 diff --git a/Packages/RAD Studio XE7/VirtualTreesR.dpk b/Packages/RAD Studio 10.4+/VirtualTreesR.dpk similarity index 55% rename from Packages/RAD Studio XE7/VirtualTreesR.dpk rename to Packages/RAD Studio 10.4+/VirtualTreesR.dpk index 67e35d692..f65fc3b6e 100644 --- a/Packages/RAD Studio XE7/VirtualTreesR.dpk +++ b/Packages/RAD Studio 10.4+/VirtualTreesR.dpk @@ -9,7 +9,7 @@ package VirtualTreesR; {$EXTENDEDSYNTAX ON} {$IMPORTEDDATA ON} {$IOCHECKS ON} -{$LOCALSYMBOLS OFF} +{$LOCALSYMBOLS ON} {$LONGSTRINGS ON} {$OPENSTRINGS ON} {$OPTIMIZATION ON} @@ -25,7 +25,7 @@ package VirtualTreesR; {$IMAGEBASE $400000} {$DEFINE RELEASE} {$ENDIF IMPLICITBUILDING} -{$LIBSUFFIX '21'} +{$LIBSUFFIX AUTO} {$RUNONLY} {$IMPLICITBUILD OFF} @@ -34,18 +34,28 @@ requires vclx; contains - VirtualTrees in '..\..\Source\VirtualTrees.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', + VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', + VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas', VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas', VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.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.Utils in '..\..\Source\VirtualTrees.Utils.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/Packages/RAD Studio XE4/VirtualTreesR.dproj b/Packages/RAD Studio 10.4+/VirtualTreesR.dproj similarity index 74% rename from Packages/RAD Studio XE4/VirtualTreesR.dproj rename to Packages/RAD Studio 10.4+/VirtualTreesR.dproj index 53c4c2117..10230a053 100644 --- a/Packages/RAD Studio XE4/VirtualTreesR.dproj +++ b/Packages/RAD Studio 10.4+/VirtualTreesR.dproj @@ -1,15 +1,16 @@  - {B62F3689-96E1-47D5-9FB2-2A2718281FDB} - VirtualTreesR.dpk True - Debug Package - VCL + Release DCC32 - 14.6 - Win32 - 3 + VCL + VirtualTreesR.dpk + Win64 + {B62F3689-96E1-47D5-9FB2-2A2718281FDB} + 20.2 + 1048579 + VirtualTreesR true @@ -19,8 +20,8 @@ Base true - - true + + true Base true @@ -34,62 +35,43 @@ Base true - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - + VirtualTreesR + All .\$(Platform)\$(Config) ..\..\Source + 00400000 + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) true - 18 - true ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false + $(Auto) + true true - 00400000 + true CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false + 1053 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - $(BDSCOMMONDIR)\DCP\$(Platform) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 1033 + true - false + 0 RELEASE;$(DCC_Define) + false 0 - false DEBUG;$(DCC_Define) - false true - - - true - - - true + false @@ -97,21 +79,28 @@ - - - - + + - - - + + + + + + - - Cfg_2 - Base - + + + + + + + + + + Base @@ -119,6 +108,10 @@ Cfg_1 Base + + Cfg_2 + Base + Delphi.Personality.12 @@ -128,6 +121,7 @@ VirtualTreesR.dpk + True False @@ -155,20 +149,16 @@ 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 - False True True + True 12 + diff --git a/Packages/RAD Studio 10/VirtualTreesR.dpk b/Packages/RAD Studio 10/VirtualTreesR.dpk index ed3ea3b3c..4b2f7d9f6 100644 --- a/Packages/RAD Studio 10/VirtualTreesR.dpk +++ b/Packages/RAD Studio 10/VirtualTreesR.dpk @@ -34,18 +34,27 @@ requires vclx; contains - VirtualTrees in '..\..\Source\VirtualTrees.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', + VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', + VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas', VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas', VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.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.Utils in '..\..\Source\VirtualTrees.Utils.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/Packages/RAD Studio 10/VirtualTreesR.dproj b/Packages/RAD Studio 10/VirtualTreesR.dproj index 5efe3e8e5..61567ef51 100644 --- a/Packages/RAD Studio 10/VirtualTreesR.dproj +++ b/Packages/RAD Studio 10/VirtualTreesR.dproj @@ -79,17 +79,28 @@ - - - - + + - - + + + + + + + + + + + + + + + Cfg_2 Base diff --git a/Packages/RAD Studio XE3/VirtualTreeView.groupproj b/Packages/RAD Studio XE3/VirtualTreeView.groupproj deleted file mode 100644 index 980342db8..000000000 --- a/Packages/RAD Studio XE3/VirtualTreeView.groupproj +++ /dev/null @@ -1,48 +0,0 @@ - - - {CC6A9541-DD5C-4BCD-8914-016D8D2EAB3B} - - - - - - - VirtualTreesR.dproj - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/Packages/RAD Studio XE3/VirtualTreesD.dpk b/Packages/RAD Studio XE3/VirtualTreesD.dpk deleted file mode 100644 index 63978fda6..000000000 --- a/Packages/RAD Studio XE3/VirtualTreesD.dpk +++ /dev/null @@ -1,42 +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 ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION OFF} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES ON} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE DEBUG} -{$ENDIF IMPLICITBUILDING} -{$DESCRIPTION 'VirtualTreeView Controls'} -{$LIBSUFFIX '17'} -{$DESIGNONLY} -{$IMPLICITBUILD OFF} - -requires - DesignIDE, - VirtualTreesR; - -contains - VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; - -end. - diff --git a/Packages/RAD Studio XE3/VirtualTreesD.dproj b/Packages/RAD Studio XE3/VirtualTreesD.dproj deleted file mode 100644 index dd2d87870..000000000 --- a/Packages/RAD Studio XE3/VirtualTreesD.dproj +++ /dev/null @@ -1,145 +0,0 @@ - - - {A34BA07B-19B6-4C21-9DEE-65FCA52D00AB} - VirtualTreesD.dpk - True - Debug - Package - VCL - DCC32 - 14.3 - Win32 - 1 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - VirtualTreeView Controls - All - 17 - true - ..\..\source;$(BDSCOMMONDIR)\dcp;$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false - true - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false - - - vcl;$(DCC_UsePackage) - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - vcl;VirtualTreesD;VirtualTreesR;$(DCC_UsePackage) - - - false - RELEASE;$(DCC_Define) - 0 - false - - - DEBUG;$(DCC_Define) - false - true - - - - MainSource - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - 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 - - - - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - - - - False - True - - - 12 - - - - diff --git a/Packages/RAD Studio XE3/VirtualTreesD.res b/Packages/RAD Studio XE3/VirtualTreesD.res deleted file mode 100644 index 743599575..000000000 Binary files a/Packages/RAD Studio XE3/VirtualTreesD.res and /dev/null differ diff --git a/Packages/RAD Studio XE3/VirtualTreesR.dpk b/Packages/RAD Studio XE3/VirtualTreesR.dpk deleted file mode 100644 index 0dbe6b5bf..000000000 --- a/Packages/RAD Studio XE3/VirtualTreesR.dpk +++ /dev/null @@ -1,50 +0,0 @@ -package VirtualTreesR; - -{$R *.res} -{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION OFF} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES ON} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE DEBUG} -{$ENDIF IMPLICITBUILDING} -{$LIBSUFFIX '17'} -{$RUNONLY} -{$IMPLICITBUILD OFF} - -requires - vcl, - vclx; - -contains - VirtualTrees in '..\..\Source\VirtualTrees.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', - VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', - VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas', - VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas', - VirtualTrees.Export in '..\..\Source\VirtualTrees.Export.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas'; - -end. - diff --git a/Packages/RAD Studio XE3/VirtualTreesR.dproj b/Packages/RAD Studio XE3/VirtualTreesR.dproj deleted file mode 100644 index d84abad29..000000000 --- a/Packages/RAD Studio XE3/VirtualTreesR.dproj +++ /dev/null @@ -1,172 +0,0 @@ - - - {B62F3689-96E1-47D5-9FB2-2A2718281FDB} - VirtualTreesR.dpk - True - Debug - Package - VCL - DCC32 - 14.3 - Win32 - 3 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - ..\..\Source - All - 17 - true - ..\..\source;$(BDSCOMMONDIR)\dcp;$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false - true - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false - - - $(BDSCOMMONDIR)\DCP\$(Platform) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - true - 1033 - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - false - RELEASE;$(DCC_Define) - 0 - false - - - DEBUG;$(DCC_Define) - false - true - - - true - - - - - - MainSource - - - - - - - - - - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - 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 - - - - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - - - - True - True - - - 12 - - - - diff --git a/Packages/RAD Studio XE3/VirtualTreesR.res b/Packages/RAD Studio XE3/VirtualTreesR.res deleted file mode 100644 index 93e7e944f..000000000 Binary files a/Packages/RAD Studio XE3/VirtualTreesR.res and /dev/null differ diff --git a/Packages/RAD Studio XE4/VirtualTreesD.dpk b/Packages/RAD Studio XE4/VirtualTreesD.dpk deleted file mode 100644 index cb599e9d8..000000000 --- a/Packages/RAD Studio XE4/VirtualTreesD.dpk +++ /dev/null @@ -1,42 +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 ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION OFF} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES ON} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE DEBUG} -{$ENDIF IMPLICITBUILDING} -{$DESCRIPTION 'VirtualTreeView Controls'} -{$LIBSUFFIX '18'} -{$DESIGNONLY} -{$IMPLICITBUILD OFF} - -requires - DesignIDE, - VirtualTreesR; - -contains - VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; - -end. - diff --git a/Packages/RAD Studio XE4/VirtualTreesD.dproj b/Packages/RAD Studio XE4/VirtualTreesD.dproj deleted file mode 100644 index d78544bc0..000000000 --- a/Packages/RAD Studio XE4/VirtualTreesD.dproj +++ /dev/null @@ -1,146 +0,0 @@ - - - {A34BA07B-19B6-4C21-9DEE-65FCA52D00AB} - VirtualTreesD.dpk - True - Debug - Package - VCL - DCC32 - 14.6 - Win32 - 1 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - .\$(Platform)\$(Config) - true - VirtualTreeView Controls - All - 18 - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false - true - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - vcl;VirtualTreesD;VirtualTreesR;$(DCC_UsePackage) - - - vcl;$(DCC_UsePackage) - - - false - RELEASE;$(DCC_Define) - 0 - false - - - DEBUG;$(DCC_Define) - false - true - - - - MainSource - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - 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 - - - - Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver - Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server - - - - False - False - True - False - - - 12 - - - - diff --git a/Packages/RAD Studio XE4/VirtualTreesD.res b/Packages/RAD Studio XE4/VirtualTreesD.res deleted file mode 100644 index 743599575..000000000 Binary files a/Packages/RAD Studio XE4/VirtualTreesD.res and /dev/null differ diff --git a/Packages/RAD Studio XE4/VirtualTreesR.dpk b/Packages/RAD Studio XE4/VirtualTreesR.dpk deleted file mode 100644 index fe6b6abeb..000000000 --- a/Packages/RAD Studio XE4/VirtualTreesR.dpk +++ /dev/null @@ -1,50 +0,0 @@ -package VirtualTreesR; - -{$R *.res} -{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION OFF} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES ON} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE DEBUG} -{$ENDIF IMPLICITBUILDING} -{$LIBSUFFIX '18'} -{$RUNONLY} -{$IMPLICITBUILD OFF} - -requires - vcl, - vclx; - -contains - VirtualTrees in '..\..\Source\VirtualTrees.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', - VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', - VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas', - VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas', - VirtualTrees.Export in '..\..\Source\VirtualTrees.Export.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas'; - -end. - diff --git a/Packages/RAD Studio XE4/VirtualTreesR.res b/Packages/RAD Studio XE4/VirtualTreesR.res deleted file mode 100644 index 93e7e944f..000000000 Binary files a/Packages/RAD Studio XE4/VirtualTreesR.res and /dev/null differ diff --git a/Packages/RAD Studio XE5/VirtualTreeView.groupproj b/Packages/RAD Studio XE5/VirtualTreeView.groupproj deleted file mode 100644 index 980342db8..000000000 --- a/Packages/RAD Studio XE5/VirtualTreeView.groupproj +++ /dev/null @@ -1,48 +0,0 @@ - - - {CC6A9541-DD5C-4BCD-8914-016D8D2EAB3B} - - - - - - - VirtualTreesR.dproj - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/Packages/RAD Studio XE5/VirtualTreesD.dpk b/Packages/RAD Studio XE5/VirtualTreesD.dpk deleted file mode 100644 index eef9d637a..000000000 --- a/Packages/RAD Studio XE5/VirtualTreesD.dpk +++ /dev/null @@ -1,42 +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 ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION OFF} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES ON} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE DEBUG} -{$ENDIF IMPLICITBUILDING} -{$DESCRIPTION 'VirtualTreeView Controls'} -{$LIBSUFFIX '19'} -{$DESIGNONLY} -{$IMPLICITBUILD OFF} - -requires - DesignIDE, - VirtualTreesR; - -contains - VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; - -end. - diff --git a/Packages/RAD Studio XE5/VirtualTreesD.dproj b/Packages/RAD Studio XE5/VirtualTreesD.dproj deleted file mode 100644 index f655f446c..000000000 --- a/Packages/RAD Studio XE5/VirtualTreesD.dproj +++ /dev/null @@ -1,158 +0,0 @@ - - - {A34BA07B-19B6-4C21-9DEE-65FCA52D00AB} - VirtualTreesD.dpk - True - Debug - Package - VCL - DCC32 - 15.0 - Win32 - 1 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - .\$(Platform)\$(Config) - true - VirtualTreeView Controls - All - 19 - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false - true - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false - - - Debug - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=preferExternal; - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - vcl;VirtualTreesD;VirtualTreesR;$(DCC_UsePackage) - - - vcl;$(DCC_UsePackage) - - - false - RELEASE;$(DCC_Define) - 0 - false - - - DEBUG;$(DCC_Define) - false - true - - - - MainSource - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - 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 - - - - Embarcadero C++Builder-Package für Office 2000-Server - Embarcadero C++Builder-Package für Office XP-Server - Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver - Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server - - - - False - False - False - True - False - - - 12 - - - - diff --git a/Packages/RAD Studio XE5/VirtualTreesD.res b/Packages/RAD Studio XE5/VirtualTreesD.res deleted file mode 100644 index 743599575..000000000 Binary files a/Packages/RAD Studio XE5/VirtualTreesD.res and /dev/null differ diff --git a/Packages/RAD Studio XE5/VirtualTreesR.dpk b/Packages/RAD Studio XE5/VirtualTreesR.dpk deleted file mode 100644 index 25d2f1d77..000000000 --- a/Packages/RAD Studio XE5/VirtualTreesR.dpk +++ /dev/null @@ -1,50 +0,0 @@ -package VirtualTreesR; - -{$R *.res} -{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION OFF} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES ON} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE DEBUG} -{$ENDIF IMPLICITBUILDING} -{$LIBSUFFIX '19'} -{$RUNONLY} -{$IMPLICITBUILD OFF} - -requires - vcl, - vclx; - -contains - VirtualTrees in '..\..\Source\VirtualTrees.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', - VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', - VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas', - VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas', - VirtualTrees.Export in '..\..\Source\VirtualTrees.Export.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas'; - -end. - diff --git a/Packages/RAD Studio XE5/VirtualTreesR.dproj b/Packages/RAD Studio XE5/VirtualTreesR.dproj deleted file mode 100644 index 2ca518671..000000000 --- a/Packages/RAD Studio XE5/VirtualTreesR.dproj +++ /dev/null @@ -1,186 +0,0 @@ - - - {B62F3689-96E1-47D5-9FB2-2A2718281FDB} - VirtualTreesR.dpk - True - Debug - Package - VCL - DCC32 - 15.0 - Win32 - 3 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - .\$(Platform)\$(Config) - ..\..\Source - true - 19 - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false - true - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false - - - Debug - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=preferExternal; - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - $(BDSCOMMONDIR)\DCP\$(Platform) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - true - 1033 - - - false - RELEASE;$(DCC_Define) - 0 - false - - - DEBUG;$(DCC_Define) - false - true - - - true - - - true - - - - MainSource - - - - - - - - - - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - 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 - - - - Embarcadero C++Builder-Package für Office 2000-Server - Embarcadero C++Builder-Package für Office XP-Server - Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver - Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server - - - - False - False - False - True - True - - - 12 - - - - diff --git a/Packages/RAD Studio XE5/VirtualTreesR.res b/Packages/RAD Studio XE5/VirtualTreesR.res deleted file mode 100644 index 93e7e944f..000000000 Binary files a/Packages/RAD Studio XE5/VirtualTreesR.res and /dev/null differ diff --git a/Packages/RAD Studio XE6/VirtualTreeView.groupproj b/Packages/RAD Studio XE6/VirtualTreeView.groupproj deleted file mode 100644 index 980342db8..000000000 --- a/Packages/RAD Studio XE6/VirtualTreeView.groupproj +++ /dev/null @@ -1,48 +0,0 @@ - - - {CC6A9541-DD5C-4BCD-8914-016D8D2EAB3B} - - - - - - - VirtualTreesR.dproj - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/Packages/RAD Studio XE6/VirtualTreesD.dpk b/Packages/RAD Studio XE6/VirtualTreesD.dpk deleted file mode 100644 index 410bd5fcf..000000000 --- a/Packages/RAD Studio XE6/VirtualTreesD.dpk +++ /dev/null @@ -1,42 +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 ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION OFF} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES ON} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE DEBUG} -{$ENDIF IMPLICITBUILDING} -{$DESCRIPTION 'VirtualTreeView Controls'} -{$LIBSUFFIX '20'} -{$DESIGNONLY} -{$IMPLICITBUILD OFF} - -requires - DesignIDE, - VirtualTreesR; - -contains - VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; - -end. - diff --git a/Packages/RAD Studio XE6/VirtualTreesD.dproj b/Packages/RAD Studio XE6/VirtualTreesD.dproj deleted file mode 100644 index e019f8a6c..000000000 --- a/Packages/RAD Studio XE6/VirtualTreesD.dproj +++ /dev/null @@ -1,138 +0,0 @@ - - - {A34BA07B-19B6-4C21-9DEE-65FCA52D00AB} - VirtualTreesD.dpk - True - Debug - Package - VCL - DCC32 - 15.4 - Win32 - 1 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - ..\..\Source - .\$(Platform)\$(Config) - true - VirtualTreeView Controls - All - 20 - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false - true - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - vcl;VirtualTreesR;$(DCC_UsePackage) - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - DEBUG;$(DCC_Define) - false - true - - - - MainSource - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - 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 - - - - Embarcadero C++Builder-Package für Office 2000-Server - Embarcadero C++Builder-Package für Office XP-Server - Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver - Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server - - - - True - - - 12 - - - - diff --git a/Packages/RAD Studio XE6/VirtualTreesR.dpk b/Packages/RAD Studio XE6/VirtualTreesR.dpk deleted file mode 100644 index f8c6494e0..000000000 --- a/Packages/RAD Studio XE6/VirtualTreesR.dpk +++ /dev/null @@ -1,50 +0,0 @@ -package VirtualTreesR; - -{$R *.res} -{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION OFF} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES ON} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DEFINE DEBUG} -{$ENDIF IMPLICITBUILDING} -{$LIBSUFFIX '20'} -{$RUNONLY} -{$IMPLICITBUILD OFF} - -requires - vcl, - vclx; - -contains - VirtualTrees in '..\..\Source\VirtualTrees.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', - VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', - VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas', - VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas', - VirtualTrees.Export in '..\..\Source\VirtualTrees.Export.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas'; - -end. - diff --git a/Packages/RAD Studio XE6/VirtualTreesR.dproj b/Packages/RAD Studio XE6/VirtualTreesR.dproj deleted file mode 100644 index 997de03b8..000000000 --- a/Packages/RAD Studio XE6/VirtualTreesR.dproj +++ /dev/null @@ -1,186 +0,0 @@ - - - {B62F3689-96E1-47D5-9FB2-2A2718281FDB} - VirtualTreesR.dpk - True - Debug - Package - VCL - DCC32 - 15.4 - Win32 - 3 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - .\$(Platform)\$(Config) - ..\..\Source - true - 20 - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false - true - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false - - - Debug - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=preferExternal; - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - $(BDSCOMMONDIR)\DCP\$(Platform) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - true - 1033 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - DEBUG;$(DCC_Define) - false - true - - - true - - - true - - - - MainSource - - - - - - - - - - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - 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 - - - - Embarcadero C++Builder-Package für Office 2000-Server - Embarcadero C++Builder-Package für Office XP-Server - Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver - Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server - - - - False - False - False - True - True - - - 12 - - - - diff --git a/Packages/RAD Studio XE7/VirtualTreeView.groupproj b/Packages/RAD Studio XE7/VirtualTreeView.groupproj deleted file mode 100644 index 980342db8..000000000 --- a/Packages/RAD Studio XE7/VirtualTreeView.groupproj +++ /dev/null @@ -1,48 +0,0 @@ - - - {CC6A9541-DD5C-4BCD-8914-016D8D2EAB3B} - - - - - - - VirtualTreesR.dproj - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/Packages/RAD Studio XE7/VirtualTreesD.dproj b/Packages/RAD Studio XE7/VirtualTreesD.dproj deleted file mode 100644 index 722f10d8f..000000000 --- a/Packages/RAD Studio XE7/VirtualTreesD.dproj +++ /dev/null @@ -1,139 +0,0 @@ - - - {A34BA07B-19B6-4C21-9DEE-65FCA52D00AB} - VirtualTreesD.dpk - True - Release - Package - VCL - DCC32 - 17.2 - Win32 - 1 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - VirtualTreesD - ..\..\Source - .\$(Platform)\$(Config) - true - VirtualTreeView Controls - All - 21 - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false - true - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - vcl;VirtualTreesR;$(DCC_UsePackage) - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - DEBUG;$(DCC_Define) - false - true - - - - MainSource - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - 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 - - - - Embarcadero C++Builder-Package für Office 2000-Server - Embarcadero C++Builder-Package für Office XP-Server - Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver - Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server - - - - True - - - 12 - - - - diff --git a/Packages/RAD Studio XE7/VirtualTreesR.dproj b/Packages/RAD Studio XE7/VirtualTreesR.dproj deleted file mode 100644 index d47bbc215..000000000 --- a/Packages/RAD Studio XE7/VirtualTreesR.dproj +++ /dev/null @@ -1,490 +0,0 @@ - - - {B62F3689-96E1-47D5-9FB2-2A2718281FDB} - VirtualTreesR.dpk - True - Release - Package - VCL - DCC32 - 17.2 - Win32 - 3 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - All - VirtualTreesR - .\$(Platform)\$(Config) - ..\..\Source - true - 21 - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false - true - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - DEBUG;$(DCC_Define) - false - true - - - true - - - - MainSource - - - - - - - - - - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - 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 - - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - - - - True - True - - - - - VirtualTreesR.bpl - true - - - - - 1 - .dylib - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - - - 1 - - - 1 - - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - res\drawable-normal - 1 - - - - - library\lib\x86 - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-xhdpi - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - library\lib\mips - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 0 - - - - - 1 - .framework - - - 0 - - - - - res\drawable-small - 1 - - - - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable - 1 - - - - - Contents\Resources - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi-v7a - 1 - - - 1 - - - 0 - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - res\drawable-large - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-ldpi - 1 - - - - - res\values - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - - - 1 - - - - - - - - - - - - 12 - - - - - diff --git a/Packages/RAD Studio XE8/VirtualTreeView.groupproj b/Packages/RAD Studio XE8/VirtualTreeView.groupproj deleted file mode 100644 index 980342db8..000000000 --- a/Packages/RAD Studio XE8/VirtualTreeView.groupproj +++ /dev/null @@ -1,48 +0,0 @@ - - - {CC6A9541-DD5C-4BCD-8914-016D8D2EAB3B} - - - - - - - VirtualTreesR.dproj - - - - Default.Personality.12 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/Packages/RAD Studio XE8/VirtualTreesD.dpk b/Packages/RAD Studio XE8/VirtualTreesD.dpk deleted file mode 100644 index e9e263d73..000000000 --- a/Packages/RAD Studio XE8/VirtualTreesD.dpk +++ /dev/null @@ -1,42 +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 OFF} -{$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} -{$DESCRIPTION 'VirtualTreeView Controls'} -{$LIBSUFFIX '22'} -{$DESIGNONLY} -{$IMPLICITBUILD OFF} - -requires - DesignIDE, - VirtualTreesR; - -contains - VirtualTreesReg in '..\..\Design\VirtualTreesReg.pas'; - -end. - diff --git a/Packages/RAD Studio XE8/VirtualTreesR.dpk b/Packages/RAD Studio XE8/VirtualTreesR.dpk deleted file mode 100644 index 4ea2e1b16..000000000 --- a/Packages/RAD Studio XE8/VirtualTreesR.dpk +++ /dev/null @@ -1,51 +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 OFF} -{$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} -{$LIBSUFFIX '22'} -{$RUNONLY} -{$IMPLICITBUILD OFF} - -requires - vcl, - vclx; - -contains - VirtualTrees in '..\..\Source\VirtualTrees.pas', - VirtualTrees.HeaderPopup in '..\..\Source\VirtualTrees.HeaderPopup.pas', - VirtualTrees.AccessibilityFactory in '..\..\Source\VirtualTrees.AccessibilityFactory.pas', - VirtualTrees.Accessibility in '..\..\Source\VirtualTrees.Accessibility.pas', - VirtualTrees.StyleHooks in '..\..\Source\VirtualTrees.StyleHooks.pas', - VirtualTrees.Classes in '..\..\Source\VirtualTrees.Classes.pas', - VirtualTrees.WorkerThread in '..\..\Source\VirtualTrees.WorkerThread.pas', - VirtualTrees.ClipBoard in '..\..\Source\VirtualTrees.ClipBoard.pas', - VirtualTrees.Actions in '..\..\Source\VirtualTrees.Actions.pas', - VirtualTrees.Export in '..\..\Source\VirtualTrees.Export.pas', - VirtualTrees.Utils in '..\..\Source\VirtualTrees.Utils.pas'; - -end. - - diff --git a/Packages/RAD Studio XE8/VirtualTreesR.dproj b/Packages/RAD Studio XE8/VirtualTreesR.dproj deleted file mode 100644 index 622e1da0c..000000000 --- a/Packages/RAD Studio XE8/VirtualTreesR.dproj +++ /dev/null @@ -1,490 +0,0 @@ - - - {B62F3689-96E1-47D5-9FB2-2A2718281FDB} - VirtualTreesR.dpk - True - Release - Package - VCL - DCC32 - 17.2 - Win32 - 3 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - All - VirtualTreesR - .\$(Platform)\$(Config) - ..\..\Source - true - 22 - true - ..\..\source;.\$(Platform)\$(Config);$(DCC_UnitSearchPath) - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - 1053 - false - true - 00400000 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - false - true - false - false - false - - - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - DEBUG;$(DCC_Define) - false - true - - - true - - - - MainSource - - - - - - - - - - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - 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 - - - - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - - - - True - True - - - - - VirtualTreesR.bpl - true - - - - - 1 - .dylib - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - - - 1 - - - 1 - - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - res\drawable-normal - 1 - - - - - library\lib\x86 - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-xhdpi - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - library\lib\mips - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 0 - - - - - 1 - .framework - - - 0 - - - - - res\drawable-small - 1 - - - - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable - 1 - - - - - Contents\Resources - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi-v7a - 1 - - - 1 - - - 0 - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - res\drawable-large - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-ldpi - 1 - - - - - res\values - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - - - 1 - - - - - - - - - - - - 12 - - - - - diff --git a/README.md b/README.md index 5bcf4f293..a882caa8f 100644 --- a/README.md +++ b/README.md @@ -2,30 +2,32 @@ Virtual Treeview is a Delphi treeview control built from ground up. Many years of development made it one of the most flexible and advanced tree controls available today. Virtual Treeview starts off with the claim to improve many aspects of existing solutions and introduces some new technologies and principles which were not available before. ### Help Needed: Any volunteer that takes care about **C++ Builder** bugs and packages? -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. Please contact me at joachim.marder+CPP@gmail.com. +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.2** official release for **RAD Studio XE3 to 10.3 Rio**: [JAM Software](https://www.jam-software.com/virtual-treeview/VirtualTreeView.zip) ([Changes](https://github.com/Virtual-TreeView/Virtual-TreeView/milestone/12?closed=1)) +[**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)**. -An experimetal **FireMonkey** port can be found here: [livius2/Virtual-TreeView](https://github.com/livius2/Virtual-TreeView) +[**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) A port to **Lazarus / FPC** can be found here: [blikblum/VirtualTreeView-Lazarus](https://github.com/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](http://www.jam-software.com/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) For installation instruction see the "INSTALL.TXT" file in the ZIP. [Delphinus](http://memnarch.bplaced.net/blog/2015/08/delphinus-packagemanager-for-delphi-xe-and-newer/)-Support was added. ### Technical Support -Please do not contact developers or JAM Software for technical support. Please try to get support from the community e.g. at [Stack Overflow](http://stackoverflow.com/search?q=%22virtual+treeview%22) , [Delphi Pages](http://www.delphipages.com/), [Delphi Praxis](http://www.delphipraxis.net/141465-virtual-treeview-tutorials-mit-beispielen.html) or [Embarcadero forums](https://forums.embarcadero.com/). Please do not use the issue tracker for getting support, only for reporting true bugs (see below). +Please do not contact developers or JAM Software for technical support. Please try to get support from the community e.g. at [Stack Overflow](http://stackoverflow.com/search?q=%22virtual+treeview%22), [Delphi Pages](http://www.delphipages.com/), [Delphi Praxis](http://www.delphipraxis.net/141465-virtual-treeview-tutorials-mit-beispielen.html) or [Embarcadero forums](https://forums.embarcadero.com/). Please do not use the issue tracker for getting support, only for reporting true bugs (see below). ### Reporting Bugs -First of all, please make sure you are using the **latest official version**. When **[reporting a bug](https://github.com/Virtual-TreeView/Virtual-TreeView/issues)** please include a **sample** project that allows us to quickly reproduce the bug. This can also be one of the demo projects that come with Virtual Treeview, modified to show the bug. If only small changes are required, a description is sufficient how a demo projects needs to be changed in order to replicate the bug. If you already have a solution, please supply a patch file or make a pull request. If you used a previous version that did not have the bug, please include this version number in your report. +First of all, please make sure you are using the **latest official version**. When **[reporting a bug](https://github.com/Virtual-TreeView/Virtual-TreeView/issues)** please attach a **sample** project as ZIP-file that allows us to quickly reproduce the bug. This can also be one of the demo projects that come with Virtual Treeview, modified to show the bug. If only small changes are required, a description is sufficient how a demo projects needs to be changed in order to replicate the bug. Please follow [best practices for good bug reports](https://www.softwaretestinghelp.com/how-to-write-good-bug-report/). + +If you already have a solution, please supply a patch file or make a pull request. If you used a previous version that did not have the bug, please include this version number in your report. ### Feature Requests We currently focus on reducing the number of reported bugs and getting Virtual Treeview stable. Feature Requests will most likely not processed at the moment. We are only going to process enhancement requests if the new feature is of general interest and a source code patch based on the latest SVN revision is attached to the report. Please mark feature requests with the flag "Enhancement". @@ -34,7 +36,7 @@ We currently focus on reducing the number of reported bugs and getting Virtual T If you want to contribute, you are welcome. We always look for help, not only for the development of the Virtual Treeview control itself, but also for maintaining the sample projects, the help or the wiki. Please send an email to: joachim(dot)marder(a)gmail.com ### License -Virtual Treeview is published under a double license: MPL 1.1 and LGPL 2.1 with static linking excpetion as described here: http://wiki.freepascal.org/modified_LGPL +Virtual Treeview is published under a double license: MPL 1.1 and LGPL 2.1 with static linking exception as described here: http://wiki.freepascal.org/modified_LGPL ### New project owner JAM Software took Virtual Treeview under its wing in 2014, but not much will change besides the homepage and download location. diff --git a/Resources/VirtualTreeview-Catalog-Image.png b/Resources/VirtualTreeview-Catalog-Image.png new file mode 100644 index 000000000..c4116cc15 Binary files /dev/null and b/Resources/VirtualTreeview-Catalog-Image.png differ diff --git a/Source/VirtualTrees.Accessibility.pas b/Source/VirtualTrees.Accessibility.pas index 568815a5c..cb1e46896 100644 --- a/Source/VirtualTrees.Accessibility.pas +++ b/Source/VirtualTrees.Accessibility.pas @@ -1,4 +1,4 @@ -unit VirtualTrees.Accessibility; +unit VirtualTrees.Accessibility; // This unit implements iAccessible interfaces for the VirtualTree visual components // and the currently focused node. @@ -8,8 +8,10 @@ interface uses - Winapi.Windows, System.Classes, Winapi.ActiveX, System.Types, Winapi.oleacc, - VirtualTrees, VirtualTrees.AccessibilityFactory, Vcl.Controls; + Winapi.Windows, Winapi.ActiveX, Winapi.oleacc, + System.Classes, System.Types, + Vcl.Controls, + VirtualTrees, VirtualTrees.AccessibilityFactory, VirtualTrees.BaseTree; type TVirtualTreeAccessibility = class(TInterfacedObject, IDispatch, IAccessible) @@ -17,6 +19,8 @@ TVirtualTreeAccessibility = class(TInterfacedObject, IDispatch, IAccessible) FVirtualTree: TVirtualStringTree; public constructor Create(AVirtualTree: TVirtualStringTree); + /// Register the default accessible provider of Virtual TreeView + class procedure RegisterDefaultAccessibleProviders(); { IAccessibility } function Get_accParent(out ppdispParent: IDispatch): HResult; stdcall; @@ -97,7 +101,9 @@ TVTMultiColumnAccessibleItemProvider = class(TInterfacedObject, IVTAccessibleP implementation uses - System.SysUtils, Vcl.Forms, System.Variants, System.Math; + System.SysUtils, System.Variants, System.Math, + Vcl.Forms, + VirtualTrees.Types; type @@ -766,7 +772,8 @@ function TVTMultiColumnAccessibleItemProvider.CreateIAccessible(ATree: TBaseVirt DefaultAccessibleItemProvider: TVTDefaultAccessibleItemProvider; MultiColumnAccessibleProvider: TVTMultiColumnAccessibleItemProvider; -initialization +class procedure TVirtualTreeAccessibility.RegisterDefaultAccessibleProviders(); +begin if DefaultAccessibleProvider = nil then begin DefaultAccessibleProvider := TVTDefaultAccessibleProvider.Create; @@ -782,15 +789,10 @@ initialization MultiColumnAccessibleProvider := TVTMultiColumnAccessibleItemProvider.Create; TVTAccessibilityFactory.GetAccessibilityFactory.RegisterAccessibleProvider(MultiColumnAccessibleProvider); end; -finalization - TVTAccessibilityFactory.GetAccessibilityFactory.UnRegisterAccessibleProvider(MultiColumnAccessibleProvider); - MultiColumnAccessibleProvider := nil; - TVTAccessibilityFactory.GetAccessibilityFactory.UnRegisterAccessibleProvider(DefaultAccessibleItemProvider); - DefaultAccessibleItemProvider := nil; - TVTAccessibilityFactory.GetAccessibilityFactory.UnRegisterAccessibleProvider(DefaultAccessibleProvider); - DefaultAccessibleProvider := nil; - -end. +end; +initialization + TVirtualTreeAccessibility.RegisterDefaultAccessibleProviders(); +end. diff --git a/Source/VirtualTrees.AccessibilityFactory.pas b/Source/VirtualTrees.AccessibilityFactory.pas index 5c772d81a..e26dacaf8 100644 --- a/Source/VirtualTrees.AccessibilityFactory.pas +++ b/Source/VirtualTrees.AccessibilityFactory.pas @@ -1,4 +1,4 @@ -unit VirtualTrees.AccessibilityFactory; +unit VirtualTrees.AccessibilityFactory; // The contents of this file are subject to the Mozilla Public License // Version 1.1 (the "License"); you may not use this file except in compliance @@ -30,17 +30,21 @@ // the AccessibleItem is returned when the Accessible is being asked for the first child // To create your own IAccessibles, use the VTStandardAccessible unit as a reference, // and assign your Accessibles to the variables in the unit's initialization. -// You only need to add the unit to your project, and voilá, you have an accessible string tree! +// You only need to add the unit to your project, and voilá, you have an accessible string tree! // // Written by Marco Zehe. (c) 2007 interface uses - System.Classes, Winapi.oleacc, VirtualTrees; + Winapi.oleacc, + System.Classes, + Vcl.Controls, + VirtualTrees.BaseTree; type IVTAccessibleProvider = interface + ['{8B76176B-C1F2-4C5C-99B4-2444FABE495C}'] function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible; end; @@ -55,13 +59,13 @@ TVTAccessibilityFactory = class(TObject) public constructor Create; destructor Destroy; override; - function CreateIAccessible(ATree: TBaseVirtualTree): IAccessible; + function CreateIAccessible(ATree: TCustomControl): IAccessible; class function GetAccessibilityFactory: TVTAccessibilityFactory; static; procedure RegisterAccessibleProvider(const AProvider: IVTAccessibleProvider); procedure UnRegisterAccessibleProvider(const AProvider: IVTAccessibleProvider); end; - + implementation { TVTAccessibilityFactory } @@ -73,11 +77,11 @@ constructor TVTAccessibilityFactory.Create; FAccessibleProviders.Clear; end; -function TVTAccessibilityFactory.CreateIAccessible( - ATree: TBaseVirtualTree): IAccessible; +function TVTAccessibilityFactory.CreateIAccessible(ATree: TCustomControl): IAccessible; var I: Integer; TmpIAccessible: IAccessible; + lTree: TBaseVirtualTree; // returns an IAccessible. // 1. If the Accessible property of the passed-in tree is nil, // the first registered element will be returned. @@ -89,23 +93,24 @@ function TVTAccessibilityFactory.CreateIAccessible( // The index for these should all be greater than 0, e g the IAccessible for the tree itself should always be registered first, then any IAccessible items. begin Result := nil; - if ATree <> nil then + lTree := (ATree as TBaseVirtualTree); + if lTree <> nil then begin - if ATree.Accessible = nil then + if lTree.Accessible = nil then begin if FAccessibleProviders.Count > 0 then begin - Result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(ATree); + Result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(lTree); Exit; end; end; - if ATree.AccessibleItem = nil then + if lTree.AccessibleItem = nil then begin if FAccessibleProviders.Count > 0 then begin for I := FAccessibleProviders.Count - 1 downto 1 do begin - TmpIAccessible := IVTAccessibleProvider(FAccessibleProviders.Items[I]).CreateIAccessible(ATree); + TmpIAccessible := IVTAccessibleProvider(FAccessibleProviders.Items[I]).CreateIAccessible(lTree); if TmpIAccessible <> nil then begin Result := TmpIAccessible; @@ -114,12 +119,12 @@ function TVTAccessibilityFactory.CreateIAccessible( end; if TmpIAccessible = nil then begin - Result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(ATree); + Result := IVTAccessibleProvider(FAccessibleProviders.Items[0]).CreateIAccessible(lTree); end; end; end else - Result := ATree.AccessibleItem; + Result := lTree.AccessibleItem; end; end; @@ -174,5 +179,3 @@ finalization TVTAccessibilityFactory.FreeFactory; end. - - diff --git a/Source/VirtualTrees.Actions.pas b/Source/VirtualTrees.Actions.pas index 0a74ac618..9f91a9087 100644 --- a/Source/VirtualTrees.Actions.pas +++ b/Source/VirtualTrees.Actions.pas @@ -1,163 +1,164 @@ -unit VirtualTrees.Actions; - -interface - -uses - System.Classes, - System.Actions, - Vcl.Controls, - Vcl.ActnList, - VirtualTrees; - -type - TVirtualTreeAction = class(TCustomAction) - strict private - fTree: TBaseVirtualTree; // Member variable for the property "Control" - fTreeAutoDetect: Boolean; // True if a potential Virtual TreeView should be detected automatically, false if a specific Tree was assigned to the property "Tree" - fOnAfterExecute: TNotifyEvent; // Member variable for the OnAfterExecute event - function GetSelectedOnly: Boolean; // Setter for the property "SelectedOnly" - procedure SetSelectedOnly(const Value: Boolean); // Getter for the property "SelectedOnly" - strict protected - fFilter: TVirtualNodeStates; // Apply only of nodes which match these states - procedure SetControl(Value: TBaseVirtualTree); // Setter for the property "Control" - procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure DoAfterExecute; virtual;// Fires the event "OnAfterExecute" - property SelectedOnly: Boolean read GetSelectedOnly write SetSelectedOnly default False; - public - function HandlesTarget(Target: TObject): Boolean; override; - procedure UpdateTarget(Target: TObject); override; - procedure ExecuteTarget(Target: TObject); override; - published - constructor Create(AOwner: TComponent); override; - function Update: Boolean; override; - property Control: TBaseVirtualTree read fTree write SetControl; - property OnAfterExecute: TNotifyEvent read fOnAfterExecute write fOnAfterExecute; // Executed after the action was performed - property Caption; - property Enabled; - property HelpContext; - property HelpType; - property Hint; - property ImageIndex; - property ShortCut; - property SecondaryShortCuts; - property Visible; - property OnHint; - end; - - TVirtualTreePerItemAction = class(TVirtualTreeAction) - strict private - fOnBeforeExecute: TNotifyEvent; - fOldCursor: TCursor; - strict protected - fToExecute: TVTGetNodeProc; // method which is executed per item to perform this action - procedure DoBeforeExecute(); - procedure DoAfterExecute(); override;// Fires the event "OnAfterExecute" - public - constructor Create(AOwner: TComponent); override; - procedure ExecuteTarget(Target: TObject); override; - published - property OnBeforeExecute: TNotifyEvent read fOnBeforeExecute write fOnBeforeExecute; - end; - - // A standard action which checkmarks nodes in a virtual treeview - TVirtualTreeCheckAll = class(TVirtualTreePerItemAction) - protected - fDesiredCheckState: TCheckState; - public - constructor Create(AOwner: TComponent); override; - published - property SelectedOnly; - property OnUpdate; - end; - - // A standard action which unchecks nodes in a virtual treeview - TVirtualTreeUncheckAll = class(TVirtualTreeCheckAll) - public - constructor Create(AOwner: TComponent); override; - end; - - TVirtualTreeSelectAll = class(TVirtualTreeAction) - public - procedure UpdateTarget(Target: TObject); override; - procedure ExecuteTarget(Target: TObject); override; - end; - - // Base class for actions that are applied to selected nodes only - TVirtualTreeForSelectedAction = class(TVirtualTreeAction) - public - constructor Create(AOwner: TComponent); override; - end; - - TVirtualTreeCopy = class(TVirtualTreeForSelectedAction) - public - procedure ExecuteTarget(Target: TObject); override; - end; - - TVirtualTreeCut = class(TVirtualTreeForSelectedAction) - public - procedure ExecuteTarget(Target: TObject); override; - end; - - TVirtualTreePaste = class(TVirtualTreeForSelectedAction) - public - procedure ExecuteTarget(Target: TObject); override; - end; - - TVirtualTreeDelete = class(TVirtualTreeForSelectedAction) - public - procedure ExecuteTarget(Target: TObject); override; - end; - -procedure Register; - - -implementation - -uses - WinApi.Windows, - Vcl.Forms; - -procedure Register; -begin - RegisterActions('VirtualTree', [TVirtualTreeCheckAll, TVirtualTreeUncheckAll, TVirtualTreeSelectAll, TVirtualTreeCopy, TVirtualTreeCut, TVirtualTreePaste, TVirtualTreeDelete], nil); -end; - -{ TVirtualTreeAction } - -constructor TVirtualTreeAction.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - fTree := nil; - fFilter := []; - fOnAfterExecute := nil; - fTreeAutoDetect := True; -end; - -function TVirtualTreeAction.GetSelectedOnly: Boolean; -begin - exit(TVirtualNodeState.vsSelected in fFilter); -end; - -procedure TVirtualTreeAction.SetSelectedOnly(const Value: Boolean); -begin - if Value then - Include(fFilter, TVirtualNodeState.vsSelected) - else - Exclude(fFilter, TVirtualNodeState.vsSelected); -end; - -procedure TVirtualTreeAction.DoAfterExecute; -begin - if Assigned(fOnAfterExecute) then - fOnAfterExecute(Self); -end; - -function TVirtualTreeAction.HandlesTarget(Target: TObject): Boolean; -begin - Result := (Target is TBaseVirtualTree); -end; - -function TVirtualTreeAction.Update(): Boolean; +unit VirtualTrees.Actions; + +interface + +uses + System.Classes, + System.Actions, + Vcl.Controls, + Vcl.ActnList, + VirtualTrees.Types, + VirtualTrees.BaseTree; + +type + TVirtualTreeAction = class(TCustomAction) + strict private + fTree: TBaseVirtualTree; // Member variable for the property "Control" + fTreeAutoDetect: Boolean; // True if a potential Virtual TreeView should be detected automatically, false if a specific Tree was assigned to the property "Tree" + fOnAfterExecute: TNotifyEvent; // Member variable for the OnAfterExecute event + function GetSelectedOnly: Boolean; // Setter for the property "SelectedOnly" + procedure SetSelectedOnly(const Value: Boolean); // Getter for the property "SelectedOnly" + strict protected + fFilter: TVirtualNodeStates; // Apply only of nodes which match these states + procedure SetControl(Value: TBaseVirtualTree); // Setter for the property "Control" + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure DoAfterExecute; virtual;// Fires the event "OnAfterExecute" + property SelectedOnly: Boolean read GetSelectedOnly write SetSelectedOnly default False; + public + function HandlesTarget(Target: TObject): Boolean; override; + procedure UpdateTarget(Target: TObject); override; + procedure ExecuteTarget(Target: TObject); override; + published + constructor Create(AOwner: TComponent); override; + function Update: Boolean; override; + property Control: TBaseVirtualTree read fTree write SetControl; + property OnAfterExecute: TNotifyEvent read fOnAfterExecute write fOnAfterExecute; // Executed after the action was performed + property Caption; + property Enabled; + property HelpContext; + property HelpType; + property Hint; + property ImageIndex; + property ShortCut; + property SecondaryShortCuts; + property Visible; + property OnHint; + end; + + TVirtualTreePerItemAction = class(TVirtualTreeAction) + strict private + fOnBeforeExecute: TNotifyEvent; + fOldCursor: TCursor; + strict protected + fToExecute: TVTGetNodeProc; // method which is executed per item to perform this action + procedure DoBeforeExecute(); + procedure DoAfterExecute(); override;// Fires the event "OnAfterExecute" + public + constructor Create(AOwner: TComponent); override; + procedure ExecuteTarget(Target: TObject); override; + published + property OnBeforeExecute: TNotifyEvent read fOnBeforeExecute write fOnBeforeExecute; + end; + + // A standard action which checkmarks nodes in a virtual treeview + TVirtualTreeCheckAll = class(TVirtualTreePerItemAction) + protected + fDesiredCheckState: TCheckState; + public + constructor Create(AOwner: TComponent); override; + published + property SelectedOnly; + property OnUpdate; + end; + + // A standard action which unchecks nodes in a virtual treeview + TVirtualTreeUncheckAll = class(TVirtualTreeCheckAll) + public + constructor Create(AOwner: TComponent); override; + end; + + TVirtualTreeSelectAll = class(TVirtualTreeAction) + public + procedure UpdateTarget(Target: TObject); override; + procedure ExecuteTarget(Target: TObject); override; + end; + + // Base class for actions that are applied to selected nodes only + TVirtualTreeForSelectedAction = class(TVirtualTreeAction) + public + constructor Create(AOwner: TComponent); override; + end; + + TVirtualTreeCopy = class(TVirtualTreeForSelectedAction) + public + procedure ExecuteTarget(Target: TObject); override; + end; + + TVirtualTreeCut = class(TVirtualTreeForSelectedAction) + public + procedure ExecuteTarget(Target: TObject); override; + end; + + TVirtualTreePaste = class(TVirtualTreeForSelectedAction) + public + procedure ExecuteTarget(Target: TObject); override; + end; + + TVirtualTreeDelete = class(TVirtualTreeForSelectedAction) + public + procedure ExecuteTarget(Target: TObject); override; + end; + +procedure Register; + + +implementation + +uses + WinApi.Windows, + Vcl.Forms; + +procedure Register; +begin + RegisterActions('VirtualTree', [TVirtualTreeCheckAll, TVirtualTreeUncheckAll, TVirtualTreeSelectAll, TVirtualTreeCopy, TVirtualTreeCut, TVirtualTreePaste, TVirtualTreeDelete], nil); +end; + +{ TVirtualTreeAction } + +constructor TVirtualTreeAction.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + fTree := nil; + fFilter := []; + fOnAfterExecute := nil; + fTreeAutoDetect := True; +end; + +function TVirtualTreeAction.GetSelectedOnly: Boolean; +begin + exit(TVirtualNodeState.vsSelected in fFilter); +end; + +procedure TVirtualTreeAction.SetSelectedOnly(const Value: Boolean); +begin + if Value then + Include(fFilter, TVirtualNodeState.vsSelected) + else + Exclude(fFilter, TVirtualNodeState.vsSelected); +end; + +procedure TVirtualTreeAction.DoAfterExecute; +begin + if Assigned(fOnAfterExecute) then + fOnAfterExecute(Self); +end; + +function TVirtualTreeAction.HandlesTarget(Target: TObject): Boolean; +begin + Result := (Target is TBaseVirtualTree); +end; + +function TVirtualTreeAction.Update(): Boolean; begin Result := inherited; // If an OnUpdate event handler is assigned, TBasicAction.Update() will return True and so TBasicAction.UpdateTarget() will not be called. @@ -166,162 +167,162 @@ function TVirtualTreeAction.Update(): Boolean; SendAppMessage(CM_ACTIONUPDATE, 0, LPARAM(Self)) end; -procedure TVirtualTreeAction.UpdateTarget(Target: TObject); -begin - if fTreeAutoDetect and (Target is TBaseVirtualTree) then - fTree := (Target as TBaseVirtualTree); - Enabled := Assigned(Control) and not Control.IsEmpty and (not SelectedOnly or (Control.SelectedCount > 0)) -end; - -procedure TVirtualTreeAction.ExecuteTarget(Target: TObject); -begin - DoAfterExecute(); -end; - -procedure TVirtualTreeAction.Notification(AComponent: TComponent; Operation: TOperation); -begin - inherited Notification(AComponent, Operation); - if (Operation = opRemove) and (AComponent = FTree) then - FTree := nil; -end; - -procedure TVirtualTreeAction.SetControl(Value: TBaseVirtualTree); -begin - if Value <> fTree then begin - fTree := Value; - if Assigned(fTree) then begin - fTree.FreeNotification(Self);// register Self as a component that should be notified when fTree is about to be destroyed. - end;//if - // Do not update the target of this action if it wa set explicitely by the developer - fTreeAutoDetect := not Assigned(fTree); - end;//if -end; - - -{ TVirtualTreePerItemAction } - -constructor TVirtualTreePerItemAction.Create(AOwner: TComponent); -begin - inherited; - fToExecute := nil; - fOnBeforeExecute := nil; - fOldCursor := crNone; -end; - -procedure TVirtualTreePerItemAction.DoAfterExecute; -begin - inherited; - if fOldCursor <> crNone then - Screen.Cursor := fOldCursor; -end; - -procedure TVirtualTreePerItemAction.DoBeforeExecute; -begin - if Screen.Cursor <> crHourGlass then begin - fOldCursor := Screen.Cursor; - Screen.Cursor := crHourGlass; - end;//if - if Assigned(fOnBeforeExecute) then - fOnBeforeExecute(Self); -end; - -procedure TVirtualTreePerItemAction.ExecuteTarget(Target: TObject); -begin - DoBeforeExecute(); - Control.BeginUpdate(); - try - Control.IterateSubtree(nil, Self.fToExecute, nil, fFilter, true); - finally - Control.EndUpdate(); - DoAfterExecute(); - end; -end; - -{ TVirtualTreeCheckAll } - -constructor TVirtualTreeCheckAll.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - Hint := 'Check all items in the list'; - Caption := 'Check &All'; - fDesiredCheckState := csCheckedNormal; - fToExecute := procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean) - begin - if not Control.CheckState[Node].IsDisabled then - Control.CheckState[Node] := fDesiredCheckState; - end; -end; - - -{ TVirtualTreeUncheckAll } - -constructor TVirtualTreeUncheckAll.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - Hint := 'Uncheck all items in the list'; - Caption := '&Uncheck All'; - fDesiredCheckState := csUncheckedNormal; -end; - - -{ TVirtualStringSelectAll } - -procedure TVirtualTreeSelectAll.UpdateTarget(Target: TObject); -begin - Inherited; - //Enabled := Enabled and (toMultiSelect in Control.TreeOptions.SelectionOptions) // TreeOptions is protected :-( -end; - -procedure TVirtualTreeSelectAll.ExecuteTarget(Target: TObject); -begin - Control.SelectAll(False); - inherited; -end; - - -{ TVirtualTreeForSelectedAction } - -constructor TVirtualTreeForSelectedAction.Create(AOwner: TComponent); -begin - inherited; - SelectedOnly := True; -end; - - -{ TVirtualTreeCopy } - -procedure TVirtualTreeCopy.ExecuteTarget(Target: TObject); -begin - Control.CopyToClipboard(); - Inherited; -end; - - -{ TVirtualTreeCut } - -procedure TVirtualTreeCut.ExecuteTarget(Target: TObject); -begin - Control.CutToClipboard(); - Inherited; -end; - - -{ TVirtualTreePaste } - -procedure TVirtualTreePaste.ExecuteTarget(Target: TObject); -begin - Control.PasteFromClipboard(); - Inherited; -end; - - -{ TVirtualTreeDelete } - -procedure TVirtualTreeDelete.ExecuteTarget(Target: TObject); -begin - Control.DeleteSelectedNodes(); - Inherited; -end; - - -end. +procedure TVirtualTreeAction.UpdateTarget(Target: TObject); +begin + if fTreeAutoDetect and (Target is TBaseVirtualTree) then + fTree := (Target as TBaseVirtualTree); + Enabled := Assigned(Control) and not Control.IsEmpty and (not SelectedOnly or (Control.SelectedCount > 0)) +end; + +procedure TVirtualTreeAction.ExecuteTarget(Target: TObject); +begin + DoAfterExecute(); +end; + +procedure TVirtualTreeAction.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if (Operation = opRemove) and (AComponent = FTree) then + FTree := nil; +end; + +procedure TVirtualTreeAction.SetControl(Value: TBaseVirtualTree); +begin + if Value <> fTree then begin + fTree := Value; + if Assigned(fTree) then begin + fTree.FreeNotification(Self);// register Self as a component that should be notified when fTree is about to be destroyed. + end;//if + // Do not update the target of this action if it wa set explicitely by the developer + fTreeAutoDetect := not Assigned(fTree); + end;//if +end; + + +{ TVirtualTreePerItemAction } + +constructor TVirtualTreePerItemAction.Create(AOwner: TComponent); +begin + inherited; + fToExecute := nil; + fOnBeforeExecute := nil; + fOldCursor := crNone; +end; + +procedure TVirtualTreePerItemAction.DoAfterExecute; +begin + inherited; + if fOldCursor <> crNone then + Screen.Cursor := fOldCursor; +end; + +procedure TVirtualTreePerItemAction.DoBeforeExecute; +begin + if Screen.Cursor <> crHourGlass then begin + fOldCursor := Screen.Cursor; + Screen.Cursor := crHourGlass; + end;//if + if Assigned(fOnBeforeExecute) then + fOnBeforeExecute(Self); +end; + +procedure TVirtualTreePerItemAction.ExecuteTarget(Target: TObject); +begin + DoBeforeExecute(); + Control.BeginUpdate(); + try + Control.IterateSubtree(nil, Self.fToExecute, nil, fFilter, true); + finally + Control.EndUpdate(); + DoAfterExecute(); + end; +end; + +{ TVirtualTreeCheckAll } + +constructor TVirtualTreeCheckAll.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Hint := 'Check all items in the list'; + Caption := 'Check &All'; + fDesiredCheckState := csCheckedNormal; + fToExecute := procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean) + begin + if not Control.CheckState[Node].IsDisabled then + Control.CheckState[Node] := fDesiredCheckState; + end; +end; + + +{ TVirtualTreeUncheckAll } + +constructor TVirtualTreeUncheckAll.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Hint := 'Uncheck all items in the list'; + Caption := '&Uncheck All'; + fDesiredCheckState := csUncheckedNormal; +end; + + +{ TVirtualStringSelectAll } + +procedure TVirtualTreeSelectAll.UpdateTarget(Target: TObject); +begin + Inherited; + //Enabled := Enabled and (toMultiSelect in Control.TreeOptions.SelectionOptions) // TreeOptions is protected :-( +end; + +procedure TVirtualTreeSelectAll.ExecuteTarget(Target: TObject); +begin + Control.SelectAll(False); + inherited; +end; + + +{ TVirtualTreeForSelectedAction } + +constructor TVirtualTreeForSelectedAction.Create(AOwner: TComponent); +begin + inherited; + SelectedOnly := True; +end; + + +{ TVirtualTreeCopy } + +procedure TVirtualTreeCopy.ExecuteTarget(Target: TObject); +begin + Control.CopyToClipboard(); + Inherited; +end; + + +{ TVirtualTreeCut } + +procedure TVirtualTreeCut.ExecuteTarget(Target: TObject); +begin + Control.CutToClipboard(); + Inherited; +end; + + +{ TVirtualTreePaste } + +procedure TVirtualTreePaste.ExecuteTarget(Target: TObject); +begin + Control.PasteFromClipboard(); + Inherited; +end; + + +{ TVirtualTreeDelete } + +procedure TVirtualTreeDelete.ExecuteTarget(Target: TObject); +begin + Control.DeleteSelectedNodes(); + Inherited; +end; + + +end. diff --git a/Source/VirtualTrees.AncestorFMX.pas b/Source/VirtualTrees.AncestorFMX.pas new file mode 100644 index 000000000..ca82b78e4 --- /dev/null +++ b/Source/VirtualTrees.AncestorFMX.pas @@ -0,0 +1,309 @@ +unit VirtualTrees.AncestorFMX; + +{$SCOPEDENUMS ON} + +{****************************************************************************************************************} +{ Project : VirtualTrees } +{ } +{ author : Karol Bieniaszewski } +{ year : 2022 } +{ contibutors : } +{****************************************************************************************************************} + +interface + +uses + System.Classes, System.UITypes, + FMX.Graphics, + VirtualTrees.FMX, VirtualTrees.BaseTree; + +const + EVENT_OBJECT_STATECHANGE = $800A; + +type + TVTAncestorFMX = class abstract(TBaseVirtualTree) + protected + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override; + procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override; + + function PrepareDottedBrush(CurrentDottedBrush: TBrush; Bits: Pointer; const BitsLinesCount: Word): TBrush; override; + + function GetClientHeight: Single; override; + function GetClientWidth: Single; override; + function GetClientRect: TRect; override; + + procedure NotifyAccessibleEvent(pEvent: Uint32 = EVENT_OBJECT_STATECHANGE); virtual; + procedure HScrollChangeProc(Sender: TObject); override; + procedure VScrollChangeProc(Sender: TObject); override; + + procedure Resize; override; + //TODO: CopyCutPaste - need to be implemented + { + function PasteFromClipboard(): Boolean; override; + procedure CopyToClipboard(); override; + procedure CutToClipboard(); override; + } + public + constructor Create(AOwner: TComponent); override; + end; + +implementation +uses + System.SysUtils, + FMX.Forms, + VirtualTrees.Header, + VirtualTrees.Types; + +type + TVTHeaderCracker = class(TVTHeader); + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTAncestorFMX.MouseDown(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); //wymaga BaseTree +Var MM: TWMMouse; + hInfo: THitInfo; + P: TPoint; + isNC: Boolean; +begin + P.X:= X; + P.Y:= Y; + if ClientRect.Contains(P) then + begin + isNc:= false; + end else + begin + isNC:= true; + P:= ClientToScreen(P); + end; + FillTWMMouse(MM, Button, Shift, P.X, P.Y, isNC, false); + if TVTHeaderCracker(Header).HandleMessage(TMessage(MM)) then + exit;//!!! + + FillTWMMouse(MM, Button, Shift, X, Y, isNC, false); + // get information about the hit + GetHitTestInfoAt(X, Y, True, hInfo); + + HandleMouseDown(MM, hInfo); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTAncestorFMX.MouseUp(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); //wymaga BaseTree +Var MM: TWMMouse; + hInfo: THitInfo; + P: TPoint; + isNC: Boolean; +begin + P.X:= X; + P.Y:= Y; + if ClientRect.Contains(P) then + begin + isNc:= false; + end else + begin + isNC:= true; + P:= ClientToScreen(P); + end; + FillTWMMouse(MM, Button, Shift, P.X, P.Y, isNC, true); + if TVTHeaderCracker(Header).HandleMessage(TMessage(MM)) then + exit;//!!! + + FillTWMMouse(MM, Button, Shift, X, Y, isNC, true); + // get information about the hit + GetHitTestInfoAt(X, Y, True, hInfo); + HandleMouseUp(MM, hInfo); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTAncestorFMX.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); //wymaga BaseTree +Var M: TCMMouseWheel; + P: TPoint; +begin + P:= Screen.MousePos; + if not ClientRect.Contains(P) then + P:= ClientToScreen(P); + + M.Msg:= CM_MOUSEWHEEL; + M.ShiftState:= Shift; + M.WheelDelta:= WheelDelta; + M.XPos:= P.X; + M.YPos:= P.Y; + M.Result:= 0; + CMMouseWheel(M); + Handled:= M.Result<>0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTAncestorFMX.NotifyAccessibleEvent(pEvent: Uint32); +begin + // Currently empty by intention as highly platfrom depedant +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTAncestorFMX.PrepareDottedBrush(CurrentDottedBrush: TBrush; Bits: Pointer; const BitsLinesCount: Word): TBrush; +Var PatternBitmap: TBitmap; + i_bmp, line, bit: Integer; +begin + //FMX pattern brush is different then VCL. Where color is derived from current one... + //We should have 2 brushes 1 for Tree lines 1 for grid lines + //and recreate it every time when color is changing + + CurrentDottedBrush.Free; + FDottedBrushGridLines.Free; + + Result := nil; + for i_bmp:= 1 to 2 do + begin + PatternBitmap := TBitmap.Create(8, BitsLinesCount); + PatternBitmap.Clear(TAlphaColorRec.Null); //fully transparent + PatternBitmap.Canvas.BeginScene; + + PatternBitmap.Map(TMapAccess.Write, BitmapData); + try + { + DestPitch := PixelFormatBytes[PatternBitmap.PixelFormat]; + System.Move(PAlphaColorArray(BitmapData.Data)[0], PAlphaColorArray(Bits)[0], 8 * 4); + } + for line:= 0 to BitsLinesCount-1 do + begin + for bit:= 0 to 7 do + begin + if PWordArray(Bits)^[line] and (1 shl bit)=0 then + BitmapData.SetPixel(bit, line, clWhite) else + begin + if i_bmp=1 then + BitmapData.SetPixel(bit, line, TreeColors.TreeLineColor) else + BitmapData.SetPixel(bit, line, TreeColors.GridLineColor); + end; + end; + end; + finally + PatternBitmap.UnMap(BitmapData); + end; + + PatternBitmap.Canvas.EndScene; + + if i_bmp=1 then + begin + Result := TStrokeBrush.Create(TBrushKind.Bitmap, clWhite); + Result.Bitmap.Bitmap.Assign(PatternBitmap); + end else + begin + FDottedBrushGridLines := TStrokeBrush.Create(TBrushKind.Bitmap, clWhite); + FDottedBrushGridLines.Bitmap.Bitmap.Assign(PatternBitmap); + end; + FreeAndNil(PatternBitmap); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTAncestorFMX.Resize; +Var M: TWMSize; +begin + inherited; + + if FInCreate then + exit; //!! + + M.Msg:= WM_SIZE; + M.SizeType:= SIZE_RESTORED; + M.Width:= Width; + M.Height:= Height; + M.Result:= 0; + WMSize(M); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTAncestorFMX.VScrollChangeProc(Sender: TObject); +Var M: TWMHScroll; +begin + M.Msg:= WM_VSCROLL; + M.ScrollCode:= SB_THUMBPOSITION; + M.Pos:= GetScrollPos(SB_VERT); + M.ScrollBar:= SB_VERT; + M.Result:= 0; + + WMVScroll(M); + Repaint; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTAncestorFMX.HScrollChangeProc(Sender: TObject); +Var M: TWMHScroll; +begin + M.Msg:= WM_HSCROLL; + M.ScrollCode:= SB_THUMBPOSITION; + M.Pos:= GetScrollPos(SB_HORZ); + M.ScrollBar:= SB_HORZ; + M.Result:= 0; + + WMHScroll(M); + Repaint; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +constructor TVTAncestorFMX.Create(AOwner: TComponent); +begin + FInCreate:= true; + + inherited; + + BackgroundOffsetX:= 0; + BackgroundOffsetY:= 0; + Margin:= 4; + TextMargin:= 4; + DefaultNodeHeight:= 18; //??? + Indent:= 18; //??? + + FInCreate:= false; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTAncestorFMX.GetClientHeight: Single; +begin + Result:= ClientRect.Height; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTAncestorFMX.GetClientWidth: Single; +begin + Result:= ClientRect.Width; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTAncestorFMX.GetClientRect: TRect; +begin + Result:= ClipRect; + if Assigned(Header) then + begin + if TVTHeaderOption.hoVisible in Header.Options then + Inc(Result.Top, Header.Height); + end; + if FVScrollBar.Visible then + Dec(Result.Right, VScrollBar.Width); + if HScrollBar.Visible then + Dec(Result.Bottom, HScrollBar.Height); + + if Result.Left>Result.Right then + Result.Left:= Result.Right; + + if Result.Top>Result.Bottom then + Result.Top:= Result.Bottom; + + //OffsetRect(Result, OffsetX, OffsetY); + //Dec(Result.Left, -OffsetX); //increase width + //Dec(Result.Top, -OffsetY); //increase height +end; + +end. diff --git a/Source/VirtualTrees.AncestorVcl.pas b/Source/VirtualTrees.AncestorVcl.pas new file mode 100644 index 000000000..d0739a9e7 --- /dev/null +++ b/Source/VirtualTrees.AncestorVcl.pas @@ -0,0 +1,494 @@ +unit VirtualTrees.AncestorVCL; + +{$SCOPEDENUMS ON} + +{****************************************************************************************************************} +{ Project : VirtualTrees } +{ } +{ author : Karol Bieniaszewski, look at VirtualTrees.pas as some code moved from there } +{ year : 2022 } +{ contibutors : } +{****************************************************************************************************************} + +interface + +uses + Vcl.Controls, + Vcl.Themes, + Winapi.Messages, + Winapi.Windows, + Winapi.oleacc, + Winapi.ActiveX, + VirtualTrees.Types, + VirtualTrees.BaseTree; + +type + TVTRenderOLEDataEvent = procedure(Sender: TBaseVirtualTree; const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; + ForClipboard: Boolean; var Result: HRESULT) of object; + + TVTAncestorVcl = class abstract(TBaseVirtualTree) + private + FOnRenderOLEData: TVTRenderOLEDataEvent; // application/descendant defined clipboard formats + + protected + function GetHintWindowClass: THintWindowClass; 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 + function PasteFromClipboard(): Boolean; override; + end; + + // The trees need an own hint window class because of Unicode output and adjusted font. + TVirtualTreeHintWindow = class(THintWindow) + strict private + FHintData: TVTHintData; + FTextHeight: TDimension; + procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; + procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; + strict protected + procedure CreateParams(var Params: TCreateParams); override; + procedure Paint; override; + // Mitigator function to use the correct style service for this context (either the style assigned to the control for Delphi > 10.4 or the application style) + function StyleServices(AControl: TControl = nil): TCustomStyleServices; + public + function CalcHintRect(MaxWidth: TDimension; const AHint: string; AData: Pointer): TRect; override; + function IsHintMsg(var Msg: TMsg): Boolean; override; + end; + +implementation +uses + System.Classes, + Vcl.Graphics, + System.UITypes, + Vcl.AxCtrls, + Vcl.Forms, + Vcl.GraphUtil, + VirtualTrees.ClipBoard, + VirtualTrees.DataObject, + VirtualTrees.DragnDrop, + VirtualTrees.StyleHooks; + +resourcestring + SClipboardFailed = 'Clipboard operation failed.'; + +type + TBVTCracker = class(TBaseVirtualTree); + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTAncestorVcl.DoRenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HRESULT; +begin + Result := E_FAIL; + if Assigned(FOnRenderOLEData) then + FOnRenderOLEData(Self, FormatEtcIn, Medium, ForClipboard, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTAncestorVcl.GetHintWindowClass: THintWindowClass; + +// Returns the default hint window class used for the tree. Descendants can override it to use their own classes. + +begin + Result := TVirtualTreeHintWindow; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +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. + +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 TVTAncestorVcl.PasteFromClipboard(): Boolean; + +// Reads what is currently on the clipboard into the tree (if the format is supported). +// Note: If the application wants to have text or special formats to be inserted then it must implement +// its own code (OLE). Here only the native tree format is accepted. + +var + Data: IDataObject; + Source: TBaseVirtualTree; + +begin + Result := False; + if not (toReadOnly in TreeOptions.MiscOptions) then + begin + if OleGetClipboard(Data) <> S_OK then + RaiseVTError(SClipboardFailed, hcTFClipboardFailed) + else + begin + // Try to get the source tree of the operation to optimize the operation. + Source := TVTDragManager.GetTreeFromDataObject(Data); + Result := ProcessOLEData(Source, Data, FocusedNode, DefaultPasteMode, Assigned(Source) and + (tsCutPending in Source.TreeStates)); + if Assigned(Source) then + begin + if Source <> Self then + Source.FinishCutOrCopy + else + DoStateChange([], [tsCutPending]); + end; + end; + end; +end; + +//----------------- TVirtualTreeHintWindow ----------------------------------------------------------------------------- + +procedure TVirtualTreeHintWindow.CMTextChanged(var Message: TMessage); + +begin + // swallow this message to prevent the ancestor from resizing the window (we don't use the caption anyway) +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeHintWindow.WMEraseBkgnd(var Message: TWMEraseBkgnd); + +// The control is fully painted by own code so don't erase its background as this causes flickering. + +begin + Message.Result := 1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeHintWindow.CreateParams(var Params: TCreateParams); + +begin + inherited CreateParams(Params); + + with Params do + begin + Style := WS_POPUP; + ExStyle := ExStyle and not WS_EX_CLIENTEDGE; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeHintWindow.Paint(); +var + R: TRect; + Y: Integer; + S: string; + DrawFormat: Cardinal; + HintKind: TVTHintKind; + LClipRect: TRect; + + LColor: TColor; + LDetails: TThemedElementDetails; + LGradientStart: TColor; + LGradientEnd: TColor; + +begin + with FHintData do + begin + // Do actual painting only in the very first run. + // If the given node is nil then we have to display a header hint. + if (Node = nil) or (TBVTCracker(Tree).HintMode <> hmToolTip) then + begin + Canvas.Font := Screen.HintFont; + Canvas.Font.Height := MulDiv(Canvas.Font.Height, Tree.ScaledPixels(96), Screen.PixelsPerInch); // See issue #992 + Y := 2; + end + else + begin + Tree.GetTextInfo(Node, Column, Canvas.Font, R, S); + if LineBreakStyle = hlbForceMultiLine then + Y := 1 + else + Y := (R.Top - R.Bottom + Self.Height) div 2; + end; + + R := Rect(0, 0, Width, Height); + + HintKind := vhkText; + if Assigned(Node) then + TBVTCracker(Tree).DoGetHintKind(Node, Column, HintKind); + + if HintKind = vhkOwnerDraw then + begin + TBVTCracker(Tree).DoDrawHint(Canvas, Node, R, Column); + end + else + with Canvas do + begin + if TBVTCracker(Tree).VclStyleEnabled then + begin + InflateRect(R, -1, -1); // Fixes missing border when VCL styles are used + LDetails := StyleServices(Tree).GetElementDetails(thHintNormal); + if StyleServices(Tree).GetElementColor(LDetails, ecGradientColor1, LColor) and (LColor <> clNone) then + LGradientStart := LColor + else + LGradientStart := clInfoBk; + if StyleServices(Tree).GetElementColor(LDetails, ecGradientColor2, LColor) and (LColor <> clNone) then + LGradientEnd := LColor + else + LGradientEnd := clInfoBk; + if StyleServices(Tree).GetElementColor(LDetails, ecTextColor, LColor) and (LColor <> clNone) then + Font.Color := LColor + else + Font.Color := Screen.HintFont.Color; + GradientFillCanvas(Canvas, LGradientStart, LGradientEnd, R, gdVertical); + end + else + begin + // Still force tooltip back and text color. + Font.Color := clInfoText; + Pen.Color := clBlack; + Brush.Color := clInfoBk; + if StyleServices(Tree).Enabled and ((toThemeAware in TBVTCracker(Tree).TreeOptions.PaintOptions) or + (toUseExplorerTheme in TBVTCracker(Tree).TreeOptions.PaintOptions)) then + begin + if toUseExplorerTheme in TBVTCracker(Tree).TreeOptions.PaintOptions then // ToolTip style + StyleServices(Tree).DrawElement(Canvas.Handle, StyleServices(Tree).GetElementDetails(tttStandardNormal), R {$IF CompilerVersion >= 34}, nil, FCurrentPPI{$IFEND}) + else + begin // Hint style + LClipRect := R; + InflateRect(R, 4, 4); + StyleServices(Tree).DrawElement(Handle, StyleServices(Tree).GetElementDetails(tttStandardNormal), R, @LClipRect{$IF CompilerVersion >= 34}, FCurrentPPI{$IFEND}); + R := LClipRect; + StyleServices(Tree).DrawEdge(Handle, StyleServices(Tree).GetElementDetails(twWindowRoot), R, [eeRaisedOuter], [efRect]); + end; + end + else + if TBVTCracker(Tree).VclStyleEnabled then + StyleServices(Tree).DrawElement(Canvas.Handle, StyleServices(Tree).GetElementDetails(tttStandardNormal), R {$IF CompilerVersion >= 34}, nil, FCurrentPPI{$IFEND}) + else + Rectangle(R); + end; + // Determine text position and don't forget the border. + InflateRect(R, -1, -1); + DrawFormat := DT_TOP or DT_NOPREFIX; + SetBkMode(Handle, Winapi.Windows.TRANSPARENT); + R.Top := Y; + R.Left := R.Left + 3; // Make the text more centered + if Assigned(Node) and (LineBreakStyle = hlbForceMultiLine) then + DrawFormat := DrawFormat or DT_WORDBREAK; + Winapi.Windows.DrawTextW(Handle, PWideChar(HintText), Length(HintText), R, DrawFormat); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeHintWindow.StyleServices(AControl: TControl): TCustomStyleServices; +begin + Result := VTStyleServices(AControl); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; + +var + TM: TTextMetric; + R: TRect; + +begin + try + if AData = nil then + // Defensive approach, it *can* happen that AData is nil. Maybe when several user defined hint classes are used. + Result := Rect(0, 0, 0, 0) + else + begin + // The hint window does not need any bidi mode setting but the caller of this method (TApplication.ActivateHint) + // does some unneccessary actions if the hint window is not left-to-right. + // The text alignment is based on the bidi mode passed in the hint data, hence we can + // simply set the window's mode to left-to-right (it might have been modified by the caller, if the + // tree window is right-to-left aligned). + BidiMode := bdLeftToRight; + + FHintData := PVTHintData(AData)^; + + with FHintData do + begin + // The draw tree gets its hint size by the application (but only if not a header hint is about to show). + // If the user will be drawing the hint, it gets its hint size by the application + // (but only if not a header hint is about to show). + // This size has already been determined in CMHintShow. + if Assigned(Node) and (not IsRectEmpty(HintRect)) then + Result := HintRect + else + begin + if Column <= NoColumn then + begin + BidiMode := Tree.BidiMode; + Alignment := TBVTCracker(Tree).Alignment; + end + else + begin + BidiMode := Tree.Header.Columns[Column].BidiMode; + Alignment := Tree.Header.Columns[Column].Alignment; + end; + + if BidiMode <> bdLeftToRight then + ChangeBidiModeAlignment(Alignment); + + if (Node = nil) or (TBVTCracker(Tree).HintMode <> hmToolTip) then + begin + Canvas.Font := Screen.HintFont; + Canvas.Font.Height := MulDiv(Canvas.Font.Height, Tree.ScaledPixels(96), Screen.PixelsPerInch); // See issue #992 + end + else + begin + Canvas.Font := Tree.Font; + with TBVTCracker(Tree) do + DoPaintText(Node, Self.Canvas, Column, ttNormal); + end; + + GetTextMetrics(Canvas.Handle, TM); + FTextHeight := TM.tmHeight; + + if Length(HintText) = 0 then + Result := Rect(0, 0, 0, 0) + else + begin + if Assigned(Node) and (TBVTCracker(Tree).HintMode = hmToolTip) then + begin + // Determine actual line break style depending on what was returned by the methods and what's in the node. + if LineBreakStyle = hlbDefault then + if (vsMultiline in Node.States) or HintText.Contains(#13) then + LineBreakStyle := hlbForceMultiLine + else + LineBreakStyle := hlbForceSingleLine; + + // Hint for a node. + if LineBreakStyle = hlbForceMultiLine then + begin + // Multiline tooltips use the columns width but extend the bottom border to fit the whole caption. + Result := Tree.GetDisplayRect(Node, Column, True, False); + R := Result; + + // On Windows NT/2K/XP the behavior of the tooltip is slightly different to that on Windows 9x/Me. + // We don't have Unicode word wrap on the latter so the tooltip gets as wide as the largest line + // in the caption (limited by carriage return), which results in unoptimal overlay of the tooltip. + Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), R, DT_CALCRECT or DT_WORDBREAK); + if BidiMode = bdLeftToRight then + Result.Right := R.Right + TBVTCracker(Tree).TextMargin + else + Result.Left := R.Left - TBVTCracker(Tree).TextMargin + 1; + Result.Bottom := R.Bottom; + + Inc(Result.Right); + + // If the node height and the column width are both already large enough to cover the entire text, + // then we don't need the hint, though. + // However if the text is partially scrolled out of the client area then a hint is useful as well. + if (Tree.Header.Columns.Count > 0) and ((Tree.NodeHeight[Node] + 2) >= (Result.Bottom - Result.Top)) and + ((Tree.Header.Columns[Column].Width + 2) >= (Result.Right - Result.Left)) and not + ((Result.Left < 0) or (Result.Right > Tree.ClientWidth + 3) or + (Result.Top < 0) or (Result.Bottom > Tree.ClientHeight + 3)) then + begin + Result := Rect(0, 0, 0, 0); + Exit; + end; + end + else + begin + Result := TBVTCracker(Tree).LastHintRect; // = Tree.GetDisplayRect(Node, Column, True, True, True); see TBaseVirtualTree.CMHintShow + + { Fixes issue #623 + + Measure the rectangle to draw the text. The width of the result + is always adjusted according to the hint text because it may + be a custom hint coming in which can be larger or smaller than + the node text. + Earlier logic was using the current width of the node that was + either cutting off the hint text or producing undesired space + on the right. + } + R := Rect(0, 0, MaxWidth, FTextHeight); + Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), R, DT_CALCRECT or DT_TOP or DT_NOPREFIX or DT_WORDBREAK); + if R.Right <> result.right - result.left then + begin + result.Right := result.Left + r.Right; + + //Space on right--taken from the code in the hmHint branch below. + if Assigned(Tree) then + Inc(Result.Right, TBVTCracker(Tree).TextMargin + TBVTCracker(Tree).Margin + Tree.ScaledPixels(4)); + end; + // Fix ends. + + if toShowHorzGridLines in TBVTCracker(Tree).TreeOptions.PaintOptions then + Dec(Result.Bottom); + end; + + // Include a one pixel border. + InflateRect(Result, 1, 1); + + // Make the coordinates relative. They will again be offset by the caller code. + OffsetRect(Result, -Result.Left - 1, -Result.Top - 1); + end + else + begin + // Hint for a header or non-tooltip hint. + + // Start with the base size of the hint in client coordinates. + Result := Rect(0, 0, MaxWidth, FTextHeight); + // Calculate the true size of the text rectangle. + Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), Result, DT_CALCRECT or DT_TOP or DT_NOPREFIX or DT_WORDBREAK); + // The height of the text plus 2 pixels vertical margin plus the border determine the hint window height. + // Minus 4 because THintWindow.ActivateHint adds 4 to Rect.Bottom anyway. Note that it is not scaled because the RTL itself does not do any scaling either. + Inc(Result.Bottom, Tree.ScaledPixels(6) - 4); + // The text is centered horizontally with usual text margin for left and right borders (plus border). + if not Assigned(Tree) then + Exit; // Workaround, because we have seen several exceptions here caught by Eurekalog. Submitted as issue #114 to http://code.google.com/p/virtual-treeview/ + { Issue #623 Fix for strange space on the right. + Original logic was adding FTextHeight. Changed it to add FMargin instead and + it looks OK even if the hint font is larger. + } + Inc(Result.Right, TBVTCracker(Tree).TextMargin + + TBVTCracker(Tree).Margin + Tree.ScaledPixels(4)); //Issue #623 space on right + //+ FTextHeight); // Old code: We are extending the width here, but the text height scales with the text width and has a similar value as AveCharWdith * 2. + end; + end; + end; + end; + end; + except + Application.HandleException(Self); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeHintWindow.IsHintMsg(var Msg: TMsg): Boolean; + +// The VCL is a bit too generous when telling that an existing hint can be cancelled. Need to specify further here. + +begin + Result := inherited IsHintMsg(Msg) and HandleAllocated and IsWindowVisible(Handle); + // Avoid that mouse moves over the non-client area or cursor key presses cancel the current hint. + if Result and ((Msg.Message = WM_NCMOUSEMOVE) or ((Msg.Message >= WM_KEYFIRST) and (Msg.Message <= WM_KEYLAST) and (Msg.wparam in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT]))) then + Result := False; +end; + +end. diff --git a/Source/VirtualTrees.BaseAncestorFMX.pas b/Source/VirtualTrees.BaseAncestorFMX.pas new file mode 100644 index 000000000..9d7ba60cf --- /dev/null +++ b/Source/VirtualTrees.BaseAncestorFMX.pas @@ -0,0 +1,553 @@ +unit VirtualTrees.BaseAncestorFMX; + +{$SCOPEDENUMS ON} + +{****************************************************************************************************************} +{ Project : VirtualTrees } +{ } +{ author : Karol Bieniaszewski } +{ year : 2022 } +{ contibutors : } +{****************************************************************************************************************} + +interface +uses + {$IFDEF MSWINDOWS} + WinApi.Windows, + {$ENDIF} + System.Classes, System.UITypes, + FMX.Objects, FMX.Graphics, FMX.Controls, FMX.StdCtrls, FMX.Forms, FMX.ImgList, + VirtualTrees.Types, VirtualTrees.FMX; + + +type + TVTBaseAncestorFMX = class abstract(TRectangle) + strict private + FFont: TFont; + procedure SetFont(const Value: TFont); + private + FDottedBrushTreeLines: TStrokeBrush; // used to paint dotted lines without special pens + FDottedBrushGridLines: TStrokeBrush; // used to paint dotted lines without special pens + FInCreate: Boolean; + + function GetFillColor: TAlphaColor; + procedure SetFillColor(const Value: TAlphaColor); + protected + FBevelEdges: TBevelEdges; + FBevelInner: TBevelCut; + FBevelOuter: TBevelCut; + FBevelKind: TBevelKind; + FBevelWidth: TBevelWidth; + FBorderWidth: TBorderWidth; + FHandleAllocated: Boolean; + FBiDiMode: TBiDiMode; + FHScrollBar: TScrollBar; + FVScrollBar: TScrollBar; + + FUseRightToLeftAlignment: Boolean; + + procedure SetBevelCut(Index: Integer; const Value: TBevelCut); + procedure SetBevelEdges(const Value: TBevelEdges); + procedure SetBevelKind(const Value: TBevelKind); + procedure SetBevelWidth(const Value: TBevelWidth); + procedure SetBorderWidth(Value: TBorderWidth); + procedure SetBiDiMode(Value: TBiDiMode); + + function GetClientHeight: Single; virtual; abstract; + function GetClientWidth: Single; virtual; abstract; + function GetClientRect: TRect; virtual; abstract; + procedure UpdateStyleElements; virtual; abstract; + + procedure DoStartDrag(var DragObject: TVTDragDataObject); virtual; abstract; + procedure DoEndDrag(Target: TObject; X, Y: TDimension); virtual; abstract; + procedure DragCanceled; virtual; abstract; + + procedure Resize; override; + function CreateSystemImageSet(): TImageList; + procedure SetWindowTheme(const Theme: string); virtual; + + procedure ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; isDpiChange: Boolean{$ifend}); virtual; abstract; + function GetControlsAlignment: TAlignment; virtual; abstract; + function PrepareDottedBrush(CurrentDottedBrush: TBrush; Bits: Pointer; const BitsLinesCount: Word): TBrush; virtual; abstract; + function GetSelectedCount(): Integer; virtual; abstract; + procedure MarkCutCopyNodes; virtual; abstract; + function GetSortedCutCopySet(Resolve: Boolean): TNodeArray; virtual; abstract; + function GetSortedSelection(Resolve: Boolean): TNodeArray; virtual; abstract; + procedure WriteNode(Stream: TStream; Node: PVirtualNode); virtual; abstract; + procedure DoMouseEnter(); reintroduce; overload; virtual; abstract; + procedure DoMouseLeave(); reintroduce; overload; virtual; abstract; + protected //properties + property DottedBrushTreeLines: TStrokeBrush read FDottedBrushTreeLines write FDottedBrushTreeLines; + property DottedBrushGridLines: TStrokeBrush read FDottedBrushGridLines write FDottedBrushGridLines; + public //methods + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function ClientToScreen(P: TPoint): TPoint; + function ScreenToClient(P: TPoint): TPoint; + procedure RecreateWnd; + procedure ShowScrollBar(Bar: Integer; AShow: Boolean); + function SetScrollInfo(Bar: Integer; const ScrollInfo: TScrollInfo; Redraw: Boolean): TDimension; + function GetScrollInfo(Bar: Integer; var ScrollInfo: TScrollInfo): Boolean; + function GetScrollPos(Bar: Integer): TDimension; + function GetScrollBarForBar(Bar: Integer): TScrollBar; + procedure HScrollChangeProc(Sender: TObject); virtual; abstract; + procedure VScrollChangeProc(Sender: TObject); virtual; abstract; + + procedure CopyToClipboard; virtual; abstract; + procedure CutToClipboard; virtual; abstract; + function PasteFromClipboard: Boolean; virtual; abstract; + + /// + /// Alias for IsFocused to make same as Vcl Focused + /// + function Focused(): Boolean; inline; + + /// + /// Convert mouse message to TMouseButton + /// Created as method, to be available in whole hierarchy without specifing Unit file name (prevent circular unit ref). + /// + class function KeysToShiftState(Keys: LongInt): TShiftState; static; + + function GetParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm; + + /// + /// Alias for Repaint on FMX to be compatible with VCL + /// + procedure Invalidate(); inline; + /// + /// Alias for Repaint on FMX to be compatible with VCL + /// + function InvalidateRect(lpRect: PRect; bErase: Boolean): Boolean; inline; + /// + /// Alias for Repaint on FMX to be compatible with VCL + /// + function UpdateWindow(): Boolean; inline; + /// + /// Alias for Repaint on FMX to be compatible with VCL + /// + function RedrawWindow(lprcUpdate: PRect; hrgnUpdate: NativeUInt; flags: UINT): Boolean; overload; inline; + /// + /// Alias for Repaint on FMX to be compatible with VCL + /// + function RedrawWindow(const lprcUpdate: TRect; hrgnUpdate: NativeUInt; flags: UINT): Boolean; overload; inline; + + /// + /// Alias for Repaint on FMX to be compatible with VCL + /// + function SendWM_SETREDRAW(Updating: Boolean): NativeUInt; inline; + + /// + /// Simulate Windows GetSystemMetrics + /// + function GetSystemMetrics(nIndex: Integer): Integer; + procedure Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); reintroduce; overload; virtual; abstract; + public //properties + property Font: TFont read FFont write SetFont; + property ClientRect: TRect read GetClientRect; + property ClientWidth: Single read GetClientWidth; + property ClientHeight: Single read GetClientHeight; + property UseRightToLeftAlignment: Boolean read FUseRightToLeftAlignment write FUseRightToLeftAlignment default false; + property BevelEdges: TBevelEdges read FBevelEdges write SetBevelEdges default [TBevelEdge.beLeft, TBevelEdge.beTop, TBevelEdge.beRight, TBevelEdge.beBottom]; + property BevelInner: TBevelCut index 0 read FBevelInner write SetBevelCut default TBevelCut.bvRaised; + property BevelOuter: TBevelCut index 1 read FBevelOuter write SetBevelCut default TBevelCut.bvLowered; + property BevelKind: TBevelKind read FBevelKind write SetBevelKind default TBevelKind.bkNone; + property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; + property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth; + property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode; + property HScrollBar: TScrollBar read FHScrollBar; + property VScrollBar: TScrollBar read FVScrollBar; + property HandleAllocated: Boolean read FHandleAllocated; + + /// + /// Alias for Fill.Color to make same use as Vcl Color property + /// + property Color: TAlphaColor read GetFillColor write SetFillColor; + end; + +{$IFNDEF MSWINDOWS} +const + { GetSystemMetrics() codes } + SM_CXVSCROLL = 2; + SM_CYHSCROLL = 3; +{$ENDIF} + +implementation +uses FMX.TextLayout, FMX.Utils + {$IFNDEF MSWINDOWS} + , WinApi.Windows + {$ENDIF} + ; + +//-------- TVTBaseAncestorFMX ------------------------------------------------------------------------------------------ + +class function TVTBaseAncestorFMX.KeysToShiftState(Keys: LongInt): TShiftState; +begin + Result := TShiftState(Word(Keys)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.GetFillColor: TAlphaColor; +begin + Result:= Fill.Color; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +constructor TVTBaseAncestorFMX.Create(AOwner: TComponent); +begin + FInCreate:= true; + inherited; + + FHandleAllocated:= true; + FUseRightToLeftAlignment:= false; + FBevelEdges:= [TBevelEdge.beLeft, TBevelEdge.beTop, TBevelEdge.beRight, TBevelEdge.beBottom]; + FBevelInner:= TBevelCut.bvRaised; + FBevelOuter:= TBevelCut.bvLowered; + FBevelKind:= TBevelKind.bkNone; + FBevelWidth:= 1; + FBorderWidth:= 0; + FFont:= TFont.Create; + DisableFocusEffect := True; + CanFocus := True; + AutoCapture := True; + + FHScrollBar:= TScrollBar.Create(Self); + FHScrollBar.Parent:= Self; + FHScrollBar.Orientation:= TOrientation.Horizontal; + FHScrollBar.Align:= TAlignLayout.MostBottom; + FHScrollBar.Visible:= true; + FHScrollBar.OnChange:= HScrollChangeProc; + FHScrollBar.Margins.Right:= FHScrollBar.Height; + + FVScrollBar:= TScrollBar.Create(Self); + FVScrollBar.Parent:= Self; + FVScrollBar.Orientation:= TOrientation.Vertical; + FVScrollBar.Align:= TAlignLayout.MostRight; + FVScrollBar.Visible:= true; + FVScrollBar.OnChange:= VScrollChangeProc; + //FVScrollBar.Margins.Bottom:= FVScrollBar.Width; + + SetAcceptsControls(false); + + FInCreate:= false; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +destructor TVTBaseAncestorFMX.Destroy(); +begin + inherited; + + if FDottedBrushTreeLines <> nil then + FreeAndNil(FDottedBrushTreeLines); + if FDottedBrushGridLines <> nil then + FreeAndNil(FDottedBrushGridLines); + FreeAndNil(FFont); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.SetBevelCut(Index: Integer; const Value: TBevelCut); +begin + case Index of + 0: { BevelInner } + if Value <> FBevelInner then + begin + FBevelInner := Value; + Repaint; + end; + 1: { BevelOuter } + if Value <> FBevelOuter then + begin + FBevelOuter := Value; + Repaint; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.SetBevelEdges(const Value: TBevelEdges); +begin + if Value <> FBevelEdges then + begin + FBevelEdges := Value; + Repaint; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.SetBevelKind(const Value: TBevelKind); +begin + if Value <> FBevelKind then + begin + FBevelKind := Value; + Repaint; + end; +end; +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.SetBevelWidth(const Value: TBevelWidth); +begin + if Value <> FBevelWidth then + begin + FBevelWidth := Value; + Repaint; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.ScreenToClient(P: TPoint): TPoint; + +begin + Result:= AbsoluteToLocal(P); +end; +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.ClientToScreen(P: TPoint): TPoint; +begin + Result:= LocalToAbsolute(P); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.Invalidate(); +begin + Repaint; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.InvalidateRect(lpRect: PRect; bErase: Boolean): Boolean; +begin + Repaint; + Result:= true; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.UpdateWindow(): Boolean; +begin + Repaint; + Result:= true; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.RedrawWindow(lprcUpdate: PRect; hrgnUpdate: NativeUInt; flags: UINT): Boolean; +begin + Repaint; + Result:= true; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.RedrawWindow(const lprcUpdate: TRect; hrgnUpdate: NativeUInt; flags: UINT): Boolean; +begin + Repaint; + Result:= true; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.RecreateWnd(); +begin + Repaint; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.ShowScrollBar(Bar: Integer; AShow: Boolean); +begin + if (Bar=SB_HORZ) or (Bar=SB_BOTH) then + FHScrollBar.Visible:= AShow; + + if (Bar=SB_VERT) or (Bar=SB_BOTH) then + FVScrollBar.Visible:= AShow; + + if FHScrollBar.Visible and FVScrollBar.Visible then + FHScrollBar.Margins.Right:= FHScrollBar.Height else + FHScrollBar.Margins.Right:= 0; + + Repaint; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.SetScrollInfo(Bar: Integer; const ScrollInfo: TScrollInfo; Redraw: Boolean): TDimension; +Var ScrollBar: TScrollBar; +begin + ScrollBar:= GetScrollBarForBar(Bar); + if ScrollBar=nil then + Exit(0); //!!! + + if ScrollInfo.fMask and SIF_PAGE<>0 then + begin + ScrollBar.SmallChange:= ScrollInfo.nPage; + end; + + if ScrollInfo.fMask and SIF_RANGE<>0 then + begin + ScrollBar.Min:= ScrollInfo.nMin; + ScrollBar.Max:= ScrollInfo.nMax; + end; + + if ScrollInfo.fMask and SIF_POS<>0 then + begin + ScrollBar.Value:= ScrollInfo.nPos; + end; + + Result:= ScrollBar.Value; + + Repaint; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.GetScrollInfo(Bar: Integer; var ScrollInfo: TScrollInfo): Boolean; +Var ScrollBar: TScrollBar; +begin + ScrollBar:= GetScrollBarForBar(Bar); + if ScrollBar=nil then + Exit(False); //!!! + + Result:= true; + + ScrollInfo.cbSize:= SizeOf(TScrollInfo); + ScrollInfo.fMask:= SIF_ALL; + + ScrollInfo.nMin:= ScrollBar.Min; + ScrollInfo.nMax:= ScrollBar.Max; + ScrollInfo.nPage:= ScrollBar.SmallChange; + ScrollInfo.nPos:= ScrollBar.Value; + ScrollInfo.nTrackPos:= ScrollBar.Value; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.GetScrollPos(Bar: Integer): TDimension; +Var ScrollInfo: TScrollInfo; +begin + GetScrollInfo(Bar, ScrollInfo); //ignore result + Result:= ScrollInfo.nPos; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.GetScrollBarForBar(Bar: Integer): TScrollBar; +begin + if (Bar=SB_HORZ) then + Result:= FHScrollBar else + if (Bar=SB_VERT) then + Result:= FVScrollBar else + Result:= nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.SetBiDiMode(Value: TBiDiMode); +begin + if FBiDiMode <> Value then + begin + FBiDiMode := Value; + Repaint; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.SetBorderWidth(Value: TBorderWidth); +begin + if FBorderWidth <> Value then + begin + FBorderWidth := Value; + Repaint; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.SetFillColor(const Value: TAlphaColor); +begin + Fill.Color:= Value; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.SetFont(const Value: TFont); +begin + FFont.Assign(Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.Focused(): Boolean; +begin + Result:= IsFocused; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.GetParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm; +begin + Result:= Control.Root.GetObject as TCustomForm; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.SendWM_SETREDRAW(Updating: Boolean): NativeUInt; +begin + Repaint; + Result:= 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.GetSystemMetrics(nIndex: Integer): Integer; +begin + {$IFDEF MSWINDOWS} + Result:= GetSystemMetrics(nIndex); + {$ELSE} + case nIndex of + SM_CXVSCROLL: Result:= 16; + SM_CYHSCROLL: Result:= 3; + else + raise Exception.Create('Unknown code for GetSystemMetrics: ' + IntToStr(nIndex)); + end; + {$ENDIF} +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.CreateSystemImageSet(): TImageList; +begin + Result:= TImageList.Create(Self); + FillSystemCheckImages(Self, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.SetWindowTheme(const Theme: string); +begin + //nothing +end; +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorFMX.CreateSystemImageSet(): TImageList; +begin + Result:= TImageList.Create(Self); + FillSystemCheckImages(Self, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorFMX.SetWindowTheme(const Theme: string); +begin + //nothing +end; + +end. diff --git a/Source/VirtualTrees.BaseAncestorVcl.pas b/Source/VirtualTrees.BaseAncestorVcl.pas new file mode 100644 index 000000000..8eba812f9 --- /dev/null +++ b/Source/VirtualTrees.BaseAncestorVcl.pas @@ -0,0 +1,602 @@ +unit VirtualTrees.BaseAncestorVCL; + +{$SCOPEDENUMS ON} + +{****************************************************************************************************************} +{ Project : VirtualTrees } +{ } +{ author : Karol Bieniaszewski, look at VirtualTrees.pas as some code moved from there } +{ year : 2022 } +{ contibutors : } +{****************************************************************************************************************} + +interface +uses + Winapi.Windows, + Winapi.oleacc, + Winapi.ActiveX, + Winapi.Messages, + System.Classes, + Vcl.Controls, + Vcl.Graphics, + Vcl.StdCtrls, + VirtualTrees.Types; + +type + TVTBaseAncestorVcl = class abstract(TCustomControl) + private + // MSAA support + FAccessible: IAccessible; // The IAccessible interface to the window itself. + FAccessibleItem: IAccessible; // The IAccessible to the item that currently has focus. + FAccessibleName: string; // The name the window is given for screen readers. + FDottedBrushTreeLines: TBrush; // used to paint dotted lines without special pens + + procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT; + protected // methods + function DoRenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HRESULT; virtual; abstract; + function RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HResult; virtual; + procedure NotifyAccessibleEvent(pEvent: DWord = EVENT_OBJECT_STATECHANGE); + function PrepareDottedBrush(CurrentDottedBrush: TBrush; Bits: Pointer; const BitsLinesCount: Word): TBrush; virtual; + function CreateSystemImageSet(): TImageList; + procedure SetWindowTheme(const Theme: string); virtual; + //// Abtract method that are implemented in TBaseVirtualTree, keep in sync with TVTBaseAncestorFMX + function GetSelectedCount(): Integer; virtual; abstract; + + /// + /// multicell support. How many cells are selected? + /// + function GetSelectedCellCount(): Integer; virtual; abstract; + procedure MarkCutCopyCells; virtual; abstract; + + procedure MarkCutCopyNodes; virtual; abstract; + procedure DoStateChange(Enter: TVirtualTreeStates; Leave: TVirtualTreeStates = []); virtual; abstract; + function GetSortedCutCopySet(Resolve: Boolean): TNodeArray; virtual; abstract; + function GetSortedSelection(Resolve: Boolean): TNodeArray; virtual; abstract; + procedure WriteNode(Stream: TStream; Node: PVirtualNode); virtual; abstract; + procedure Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; abstract; + procedure DoMouseEnter(); virtual; abstract; + procedure DoMouseLeave(); virtual; abstract; + protected //properties + property DottedBrushTreeLines: TBrush read FDottedBrushTreeLines write FDottedBrushTreeLines; + public // methods + destructor Destroy; override; + procedure CopyToClipboard(); virtual; + procedure CutToClipboard(); virtual; + function PasteFromClipboard: Boolean; virtual; abstract; + + /// + /// Handle less alias for WinApi.Windows.InvalidateRect + /// + function InvalidateRect(lpRect: PRect; bErase: BOOL): BOOL; inline; + /// + /// Handle less alias for WinApi.Windows.UpdateWindow + /// + function UpdateWindow(): BOOL; inline; + /// + /// Handle less alias for WinApi.Windows.RedrawWindow + /// + function RedrawWindow(lprcUpdate: PRect; hrgnUpdate: HRGN; flags: UINT): BOOL; overload; inline; + /// + /// Handle less alias for WinApi.Windows.RedrawWindow + /// + function RedrawWindow(const lprcUpdate: TRect; hrgnUpdate: HRGN; flags: UINT): BOOL; overload; inline; + + /// + /// Handle less and with limited parameters version + /// + function SendWM_SETREDRAW(Updating: Boolean): LRESULT; inline; + + /// + /// Handle less alias for WinApi.Windows.ShowScrollBar + /// + procedure ShowScrollBar(Bar: Integer; AShow: Boolean); + /// + /// Handle less alias for WinApi.Windows.SetScrollInfo + /// + function SetScrollInfo(Bar: Integer; const ScrollInfo: TScrollInfo; Redraw: Boolean): TDimension; + /// + /// Handle less alias for WinApi.Windows.GetScrollInfo + /// + function GetScrollInfo(Bar: Integer; var ScrollInfo: TScrollInfo): Boolean; + /// + /// Handle less alias for WinApi.Windows.GetScrollPos + /// + function GetScrollPos(Bar: Integer): TDimension; + /// + /// Canvas based without HDC alias for WinApi.Windows.GetTextMetrics + /// + function GetTextMetrics(Canvas: TCanvas; var TM: TTextMetric): BOOL; overload; inline; + public //properties + property Accessible: IAccessible read FAccessible write FAccessible; + property AccessibleItem: IAccessible read FAccessibleItem write FAccessibleItem; + property AccessibleName: string read FAccessibleName write FAccessibleName; + end; + +implementation + +uses + System.SyncObjs, + System.SysUtils, + Vcl.AxCtrls, + Vcl.Forms, + Vcl.Themes, + Winapi.CommCtrl, + Winapi.ShlObj, + Winapi.UxTheme, + VirtualTrees.DataObject, + VirtualTrees.Clipboard, + VirtualTrees.AccessibilityFactory, + VirtualTrees.StyleHooks; + +//---------------------------------------------------------------------------------------------------------------------- + +const + Grays: array[0..3] of TColor = (clWhite, clSilver, clGray, clBlack); + SysGrays: array[0..3] of TColor = (clWindow, clBtnFace, clBtnShadow, clBtnText); + +//not used curently anywhere, moved to VCL, to remove ifdef (gWatcher is declared in VirtualTrees.BaseTree) +procedure ConvertImageList(gWatcher: TCriticalSection; BaseVirtualTreeClass: TClass; IL: TImageList; const ImageName: string; ColorRemapping: Boolean = True); + +// Loads a bunch of images given by ImageName into IL. If ColorRemapping = True then a mapping of gray values to +// system colors is performed. + +var + lImages, + lOneImage: TBitmap; + I: Integer; + MaskColor: TColor; + Source, + Dest: TRect; + +begin + gWatcher.Enter(); + try + // Since we want the image list appearing in the correct system colors, we have to remap its colors. + lImages := TBitmap.Create; + lOneImage := TBitmap.Create; + if ColorRemapping then + lImages.Handle := CreateMappedRes(FindClassHInstance(BaseVirtualTreeClass), PChar(ImageName), Grays, SysGrays) + else + lImages.Handle := LoadBitmap(FindClassHInstance(BaseVirtualTreeClass), PChar(ImageName)); + + try + Assert(lImages.Height > 0, 'Internal image "' + ImageName + '" is missing or corrupt.'); + if lImages.Height = 0 then + Exit;// This should never happen, it prevents a division by zero exception below in the for loop, which we have seen in a few cases + // It is assumed that the image height determines also the width of one entry in the image list. + IL.Clear; + IL.Height := lImages.Height; + IL.Width := lImages.Height; + lOneImage.Width := IL.Width; + lOneImage.Height := IL.Height; + MaskColor := lImages.Canvas.Pixels[0, 0]; // this is usually clFuchsia + Dest := Rect(0, 0, IL.Width, IL.Height); + for I := 0 to (lImages.Width div lImages.Height) - 1 do + begin + Source := Rect(I * IL.Width, 0, (I + 1) * IL.Width, IL.Height); + lOneImage.Canvas.CopyRect(Dest, lImages.Canvas, Source); + IL.AddMasked(lOneImage, MaskColor); + end; + finally + lImages.Free; + lOneImage.Free; + end; + finally + gWatcher.Leave(); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HResult; + +// Returns a memory expression of all currently selected nodes in the Medium structure. +// Note: The memory requirement of this method might be very high. This depends however on the requested storage format. +// For HGlobal (a global memory block) we need to render first all nodes to local memory and copy this then to +// the global memory in Medium. This is necessary because we have first to determine how much +// memory is needed before we can allocate it. Hence for a short moment we need twice the space as used by the +// nodes alone (plus the amount the nodes need in the tree anyway)! +// With IStream this does not happen. We directly stream out the nodes and pass the constructed stream along. + + //--------------- local function -------------------------------------------- + + procedure WriteNodes(Stream: TStream); + + var + Selection: TNodeArray; + I: Integer; + + begin + if ForClipboard then + Selection := GetSortedCutCopySet(True) + else + Selection := GetSortedSelection(True); + for I := 0 to High(Selection) do + WriteNode(Stream, Selection[I]); + end; + + //--------------- end local function ---------------------------------------- + +var + Data: PCardinal; + ResPointer: Pointer; + ResSize: Integer; + OLEStream: IStream; + VCLStream: TStream; + +begin + ZeroMemory (@Medium, SizeOf(Medium)); + + // We can render the native clipboard format in two different storage media. + if (FormatEtcIn.cfFormat = CF_VIRTUALTREE) and (FormatEtcIn.tymed and (TYMED_HGLOBAL or TYMED_ISTREAM) <> 0) then + begin + VCLStream := nil; + try + Medium.unkForRelease := nil; + // Return data in one of the supported storage formats, prefer IStream. + if FormatEtcIn.tymed and TYMED_ISTREAM <> 0 then + begin + // Create an IStream on a memory handle (here it is 0 which indicates to implicitely allocated a handle). + // Do not use TStreamAdapter as it is not compatible with OLE (when flushing the clipboard OLE wants the HGlobal + // back which is not supported by TStreamAdapater). + CreateStreamOnHGlobal(0, True, OLEStream); + VCLStream := TOLEStream.Create(OLEStream); + WriteNodes(VCLStream); + // Rewind stream. + VCLStream.Position := 0; + Medium.tymed := TYMED_ISTREAM; + IUnknown(Medium.stm) := OLEStream; + Result := S_OK; + end + else + begin + VCLStream := TMemoryStream.Create; + WriteNodes(VCLStream); + ResPointer := TMemoryStream(VCLStream).Memory; + ResSize := VCLStream.Position; + + // Allocate memory to hold the string. + if ResSize > 0 then + begin + Medium.hGlobal := GlobalAlloc(GHND or GMEM_SHARE, ResSize + SizeOf(Cardinal)); + Data := GlobalLock(Medium.hGlobal); + // Store the size of the data too, for easy retrival. + Data^ := ResSize; + Inc(Data); + Move(ResPointer^, Data^, ResSize); + GlobalUnlock(Medium.hGlobal); + Medium.tymed := TYMED_HGLOBAL; + + Result := S_OK; + end + else + Result := E_FAIL; + end; + finally + // We can free the VCL stream here since it was either a pure memory stream or only a wrapper around + // the OLEStream which exists independently. + VCLStream.Free; + end; + end + else // Ask application descendants to render self defined formats. + Result := DoRenderOLEData(FormatEtcIn, Medium, ForClipboard); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorVcl.CopyToClipboard; + +var + lDataObject: IDataObject; + +begin + // multicell support copy + if GetSelectedCellCount > 0 then + begin + lDataObject := TVTDataObject.Create(Self, True); + if OleSetClipboard(lDataObject) = S_OK then + begin + MarkCutCopyCells; + DoStateChange([tsCopyPending]); + Invalidate; + end; + Exit; + end; + + // regular fullrow copy + if GetSelectedCount > 0 then + begin + lDataObject := TVTDataObject.Create(Self, True); + if OleSetClipboard(lDataObject) = S_OK then + begin + MarkCutCopyNodes; + DoStateChange([tsCopyPending]); + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.CreateSystemImageSet: TImageList; + +// Creates a system check image set. +// Note: the DarkCheckImages and FlatImages image lists must already be filled, as some images from them are copied here. + +const + MaskColor: TColor = clRed; + cFlags = ILC_COLOR32 or ILC_MASK; + +var + BM: TBitmap; + Theme: HTHEME; + Details: TThemedElementDetails; + + //--------------------------------------------------------------------------- + + // Mitigator function to use the correct style service for this context (either the style assigned to the control for Delphi > 10.4 or the application style) + function StyleServices: TCustomStyleServices; + begin + Result := VTStyleServices(Self); + end; + + procedure AddSystemImage(IL: TImageList; Index: Integer); + const + States: array [0..19] of Integer = ( + RBS_UNCHECKEDNORMAL, RBS_UNCHECKEDHOT, RBS_UNCHECKEDPRESSED, RBS_UNCHECKEDDISABLED, + RBS_CHECKEDNORMAL, RBS_CHECKEDHOT, RBS_CHECKEDPRESSED, RBS_CHECKEDDISABLED, + CBS_UNCHECKEDNORMAL, CBS_UNCHECKEDHOT, CBS_UNCHECKEDPRESSED, CBS_UNCHECKEDDISABLED, + CBS_CHECKEDNORMAL, CBS_CHECKEDHOT, CBS_CHECKEDPRESSED, CBS_CHECKEDDISABLED, + CBS_MIXEDNORMAL, CBS_MIXEDHOT, CBS_MIXEDPRESSED, CBS_MIXEDDISABLED); + var + ButtonState: Cardinal; + ButtonType: Cardinal; + + begin + BM.Canvas.FillRect(Rect(0, 0, BM.Width, BM.Height)); + if StyleServices.Enabled and StyleServices.IsSystemStyle then + begin + if Index < 8 then + Details.Part := BP_RADIOBUTTON + else + Details.Part := BP_CHECKBOX; + Details.State := States[Index]; + DrawThemeBackground(Theme, BM.Canvas.Handle, Details.Part, Details.State, Rect(0, 0, BM.Width, BM.Height), nil); + end + else + begin + if Index < 8 then + ButtonType := DFCS_BUTTONRADIO + else + ButtonType := DFCS_BUTTONCHECK; + if Index >= 16 then + ButtonType := ButtonType or DFCS_BUTTON3STATE; + + case Index mod 4 of + 0: + ButtonState := 0; + 1: + ButtonState := DFCS_HOT; + 2: + ButtonState := DFCS_PUSHED; + else + ButtonState := DFCS_INACTIVE; + end; + if Index in [4..7, 12..19] then + ButtonState := ButtonState or DFCS_CHECKED; +// if Flat then +// ButtonState := ButtonState or DFCS_FLAT; + DrawFrameControl(BM.Canvas.Handle, Rect(0, 0, BM.Width, BM.Height), DFC_BUTTON, ButtonType or ButtonState); + end; + IL.AddMasked(BM, MaskColor); + end; + + //--------------- end local functions --------------------------------------- + +const + cDefaultCheckboxSize = 13;// Used when no other value is available +var + I: Integer; + lSize: TSize; + Res: Boolean; +begin + BM := TBitmap.Create; // Create a temporary bitmap, which holds the intermediate images. + try + Res := False; + // Retrieve the checkbox image size, prefer theme if available, fall back to GetSystemMetrics() otherwise, but this returns odd results on Windows 8 and higher in high-dpi scenarios. + if StyleServices.Enabled then + if StyleServices.IsSystemStyle then + begin + {$if CompilerVersion >= 33} + if TOSVersion.Check(10) and (TOSVersion.Build >= 15063) then + Theme := OpenThemeDataForDPI(Handle, 'BUTTON', CurrentPPI) + else + {$ifend} + Theme := OpenThemeData(Self.Handle, 'BUTTON'); + Details := StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal); + Res := GetThemePartSize(Theme, BM.Canvas.Handle, Details.Part, Details.State, nil, TS_TRUE, lSize) = S_OK; + end + else + Res := StyleServices.GetElementSize(BM.Canvas.Handle, StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal), TElementSize.esActual, lSize {$IF CompilerVersion >= 34}, Self.CurrentPPI{$IFEND}); + if not Res then begin + lSize := TSize.Create(GetSystemMetrics(SM_CXMENUCHECK), GetSystemMetrics(SM_CYMENUCHECK)); + if lSize.cx = 0 then begin // error? (Should happen rarely only) + lSize.cx := MulDiv(cDefaultCheckboxSize, Screen.PixelsPerInch, USER_DEFAULT_SCREEN_DPI); + lSize.cy := lSize.cx; + end;// if + end;//if + + Result := TImageList.CreateSize(lSize.cx, lSize.cy); + Result.Handle := ImageList_Create(Result.Width, Result.Height, cFlags, 0, Result.AllocBy); + Result.Masked := True; + Result.BkColor := clWhite; + + // Make the bitmap the same size as the image list is to avoid problems when adding. + BM.SetSize(Result.Width, Result.Height); + BM.Canvas.Brush.Color := MaskColor; + BM.Canvas.Brush.Style := bsSolid; + BM.Canvas.FillRect(Rect(0, 0, BM.Width, BM.Height)); + Result.AddMasked(BM, MaskColor); + + // Add the 20 system checkbox and radiobutton images. + for I := 0 to 19 do + AddSystemImage(Result, I); + if StyleServices.Enabled and StyleServices.IsSystemStyle then + CloseThemeData(Theme); + + finally + BM.Free; + end; +end; + +procedure TVTBaseAncestorVcl.CutToClipboard; +var + lDataObject: IDataObject; +begin + if (GetSelectedCount > 0) then + begin + lDataObject := TVTDataObject.Create(Self, True); + if OleSetClipboard(lDataObject) = S_OK then + begin + MarkCutCopyNodes; + DoStateChange([tsCutPending], [tsCopyPending]); + Invalidate; + end; + end; +end; + +destructor TVTBaseAncestorVcl.Destroy; +begin + // Disconnect all remote MSAA connections + if Assigned(AccessibleItem) then begin + CoDisconnectObject(AccessibleItem, 0); + AccessibleItem := nil; + end; + if Assigned(Accessible) then begin + CoDisconnectObject(Accessible, 0); + Accessible := nil; + end; + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.PrepareDottedBrush(CurrentDottedBrush: TBrush; Bits: Pointer; const BitsLinesCount: Word): TBrush; +begin + if Assigned(CurrentDottedBrush) then + begin + Result := CurrentDottedBrush; + end else + begin + Result := TBrush.Create; + Result.Bitmap := TBitmap.Create; + end; + + Result.Bitmap.Handle := CreateBitmap(8, 8, 1, 1, Bits); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.RedrawWindow(const lprcUpdate: TRect; hrgnUpdate: HRGN; flags: UINT): BOOL; +begin + Result:= Winapi.Windows.RedrawWindow(Handle, lprcUpdate, hrgnUpdate, flags); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.RedrawWindow(lprcUpdate: PRect; hrgnUpdate: HRGN; flags: UINT): BOOL; +begin + Result:= Winapi.Windows.RedrawWindow(Handle, lprcUpdate, hrgnUpdate, flags); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.InvalidateRect(lpRect: PRect; bErase: BOOL): BOOL; +begin + Result:= WinApi.Windows.InvalidateRect(Handle, lpRect, bErase); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorVcl.NotifyAccessibleEvent(pEvent: DWord = EVENT_OBJECT_STATECHANGE); +begin + if Assigned(AccessibleItem) then + NotifyWinEvent(pEvent, Handle, OBJID_CLIENT, CHILDID_SELF); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.UpdateWindow(): BOOL; +begin + Result:= WinApi.Windows.UpdateWindow(Handle); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorVcl.WMGetObject(var Message: TMessage); + +begin + if TVTAccessibilityFactory.GetAccessibilityFactory <> nil then + begin + // Create the IAccessibles for the tree view and tree view items, if necessary. + if Accessible = nil then + Accessible := TVTAccessibilityFactory.GetAccessibilityFactory.CreateIAccessible(Self); + if AccessibleItem = nil then + AccessibleItem := TVTAccessibilityFactory.GetAccessibilityFactory.CreateIAccessible(Self); + if Cardinal(Message.LParam) = OBJID_CLIENT then + if Assigned(Accessible) then + Message.Result := LresultFromObject(IID_IAccessible, Message.WParam, Accessible) + else + Message.Result := 0; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorVcl.ShowScrollBar(Bar: Integer; AShow: Boolean); +begin + WinApi.Windows.ShowScrollBar(Handle, Bar, AShow); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.SendWM_SETREDRAW(Updating: Boolean): LRESULT; +begin + Result:= SendMessage(Handle, WM_SETREDRAW, Ord(not Updating), 0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.SetScrollInfo(Bar: Integer; const ScrollInfo: TScrollInfo; Redraw: Boolean): TDimension; +begin + Result:= WinApi.Windows.SetScrollInfo(Handle, Bar, ScrollInfo, Redraw); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTBaseAncestorVcl.SetWindowTheme(const Theme: string); +begin + Winapi.UxTheme.SetWindowTheme(Handle, PWideChar(Theme), nil); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.GetScrollInfo(Bar: Integer; var ScrollInfo: TScrollInfo): Boolean; +begin + Result:= WinApi.Windows.GetScrollInfo(Handle, Bar, ScrollInfo); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTBaseAncestorVcl.GetScrollPos(Bar: Integer): TDimension; +begin + Result:= WinApi.Windows.GetScrollPos(Handle, Bar); +end; + +function TVTBaseAncestorVcl.GetTextMetrics(Canvas: TCanvas; var TM: TTextMetric): BOOL; +begin + Result:= WinApi.Windows.GetTextMetrics(Canvas.Handle, TM); +end; + +end. diff --git a/Source/VirtualTrees.BaseTree.pas b/Source/VirtualTrees.BaseTree.pas new file mode 100644 index 000000000..8dc36ee6a --- /dev/null +++ b/Source/VirtualTrees.BaseTree.pas @@ -0,0 +1,23511 @@ +unit VirtualTrees.BaseTree; + +interface + +{$if CompilerVersion < 24}{$MESSAGE FATAL 'This version supports only RAD Studio XE3 and higher. Please use V5 from http://www.jam-software.com/virtual-treeview/VirtualTreeViewV5.5.3.zip or https://github.com/Virtual-TreeView/Virtual-TreeView/archive/V5_stable.zip'}{$ifend} + +{$booleval off} // Use fastest possible boolean evaluation + +// For some things to work we need code, which is classified as being unsafe for .NET. +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CAST OFF} +{$WARN UNSAFE_CODE OFF} + +{$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, Winapi.CommCtrl, + Winapi.UxTheme, Winapi.ShlObj, + System.SysUtils, System.Classes, System.Types, + Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.ImgList, Vcl.StdCtrls, + Vcl.Menus, Vcl.Printers, Vcl.Themes, + System.UITypes, // some types moved from Vcl.* to System.UITypes + VirtualTrees.Types, + VirtualTrees.Colors, + VirtualTrees.DragImage, + VirtualTrees.Header +{$IFDEF VT_FMX} + , VirtualTrees.BaseAncestorFMX +{$ELSE} + , VirtualTrees.BaseAncestorVCL +{$ENDIF} + ; + +{$MinEnumSize 1, make enumerations as small as possible} + +type + {$IFDEF VT_FMX} + TVTBaseAncestor = TVTBaseAncestorFMX; + TCanvas = FMX.Graphics.TCanvas; + {$ELSE} + TVTBaseAncestor = TVTBaseAncestorVcl; + TCanvas = Vcl.Graphics.TCanvas; + TFormatEtcArray = VirtualTrees.Types.TFormatEtcArray; + {$ENDIF} + + // Alias defintions for convenience + TImageIndex = System.UITypes.TImageIndex; + + //these were moved, aliases are for backwards compatibility. + //some may be removed once we sort out excactly what is needed. + + TDimension = VirtualTrees.Types.TDimension; + TColumnIndex = VirtualTrees.Types.TColumnIndex; + TColumnPosition = VirtualTrees.Types.TColumnPosition; + EVirtualTreeError = VirtualTrees.Types.EVirtualTreeError; + TAutoScrollInterval = VirtualTrees.Types.TAutoScrollInterval; + TVTScrollIncrement = VirtualTrees.Types.TVTScrollIncrement; + TFormatArray = VirtualTrees.Types.TFormatArray; + + TVTPaintOption = VirtualTrees.Types.TVTPaintOption; + TVTPaintOptions = VirtualTrees.Types.TVTPaintOptions; + TVTAnimateOption = VirtualTrees.Types.TVTAnimationOption; + TVTAnimateOptions = VirtualTrees.Types.TVTAnimationOptions; + TVTAutoOption = VirtualTrees.Types.TVTAutoOption; + TVTAutoOptions = VirtualTrees.Types.TVTAutoOptions; + TVTSelectionOption = VirtualTrees.Types.TVTSelectionOption; + TVTSelectionOptions = VirtualTrees.Types.TVTSelectionOptions; + TVTEditOptions = VirtualTrees.Types.TVTEditOptions; + TVTMiscOption = VirtualTrees.Types.TVTMiscOption; + TVTMiscOptions = VirtualTrees.Types.TVTMiscOptions; + TVTExportMode = VirtualTrees.Types.TVTExportMode; + TVTStringOption = VirtualTrees.Types.TVTStringOption; + TVTStringOptions = VirtualTrees.Types.TVTStringOptions; + TCustomVirtualTreeOptions= VirtualTrees.Types.TCustomVirtualTreeOptions; + TVirtualTreeOptions = VirtualTrees.Types.TVirtualTreeOptions; + TTreeOptionsClass = VirtualTrees.Types.TTreeOptionsClass; + TCustomStringTreeOptions = VirtualTrees.Types.TCustomStringTreeOptions; + TStringTreeOptions = VirtualTrees.Types.TStringTreeOptions; + + TScrollBarStyle = VirtualTrees.Types.TScrollBarStyle; + TScrollBarOptions = VirtualTrees.Types.TScrollBarOptions; + + TVTColumnOption = VirtualTrees.Types.TVTColumnOption; + TVTColumnOptions = VirtualTrees.Types.TVTColumnOptions; + TVirtualTreeColumnStyle = VirtualTrees.Types.TVirtualTreeColumnStyle; + TSortDirection = VirtualTrees.Types.TSortDirection; + TCheckType = VirtualTrees.Types.TCheckType; + TCheckState = VirtualTrees.Types.TCheckState; + TVTDropMarkMode = VirtualTrees.Types.TVTDropMarkMode; + TScrollDirections = VirtualTrees.Types.TScrollDirections; + TVirtualTreeColumn = VirtualTrees.Header.TVirtualTreeColumn; + TVirtualTreeColumns = VirtualTrees.Header.TVirtualTreeColumns; + TVirtualTreeColumnClass = VirtualTrees.Header.TVirtualTreeColumnClass; + TColumnsArray = VirtualTrees.Header.TColumnsArray; + TCardinalArray = VirtualTrees.Header.TCardinalArray; + TIndexArray = VirtualTrees.Header.TIndexArray; + + TVTColors = VirtualTrees.Colors.TVTColors; + // + +type + TBaseVirtualTree = class; + TVirtualTreeClass = class of TBaseVirtualTree; + + + // This record must already be defined here and not later because otherwise BCB users will not be able + // to compile (conversion done by BCB is wrong). + TCacheEntry = record + Node: PVirtualNode; + AbsoluteTop: TNodeHeight; + end; + + TCache = array of TCacheEntry; + + // Used in the CF_VTREFERENCE clipboard format. + PVTReference = ^TVTReference; + TVTReference = record + Process: Cardinal; + Tree: TBaseVirtualTree; + end; + + + // ----- OLE drag'n drop handling + + IVTDragManager = interface(IUnknown) + ['{C4B25559-14DA-446B-8901-0C879000EB16}'] + procedure ForceDragLeave; stdcall; + function GetDataObject: IDataObject; stdcall; + function GetDragSource: TBaseVirtualTree; stdcall; + function GetIsDropTarget: Boolean; stdcall; + + property DataObject: IDataObject read GetDataObject; + property DragSource: TBaseVirtualTree read GetDragSource; + property IsDropTarget: Boolean read GetIsDropTarget; + end; + + + + PVTHintData = ^TVTHintData; + TVTHintData = record + Tree: TBaseVirtualTree; + Node: PVirtualNode; + Column: TColumnIndex; + HintRect: TRect; // used for draw trees only, string trees get the size from the hint string + HintText: string; // set when size of the hint window is calculated + BidiMode: TBidiMode; + Alignment: TAlignment; + LineBreakStyle: TVTToolTipLineBreakStyle; + end; + + // Communication interface between a tree editor and the tree itself (declared as using stdcall in case it + // is implemented in a (C/C++) DLL). The GUID is not nessecary in Delphi but important for BCB users + // to allow QueryInterface and _uuidof calls. + IVTEditLink = interface + ['{2BE3EAFA-5ACB-45B4-9D9A-B58BCC496E17}'] + function BeginEdit: Boolean; stdcall; // Called when editing actually starts. + function CancelEdit: Boolean; stdcall; // Called when editing has been cancelled by the tree. + function EndEdit: Boolean; stdcall; // Called when editing has been finished by the tree. Returns True if successful, False if edit mode is still active. + function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall; + // Called after creation to allow a setup. + procedure ProcessMessage(var Message: TMessage); stdcall; + // Used to forward messages to the edit window(s)- + procedure SetBounds(R: TRect); stdcall; // Called to place the editor. + end; + + + TVTNodeExportEvent = procedure (Sender: TBaseVirtualTree; aExportType: TVTExportType; Node: PVirtualNode) of object; + TVTColumnExportEvent = procedure (Sender: TBaseVirtualTree; aExportType: TVTExportType; Column: TVirtualTreeColumn) of object; + TVTTreeExportEvent = procedure(Sender: TBaseVirtualTree; aExportType: TVTExportType) of object; + + TClipboardFormats = class(TStringList) + private + FOwner: TBaseVirtualTree; + public + constructor Create(AOwner: TBaseVirtualTree); virtual; + + function Add(const S: string): Integer; override; + procedure Insert(Index: Integer; const S: string); override; + property Owner: TBaseVirtualTree read FOwner; + end; + + // ----- Event prototypes: + + // node enumeration + TVTGetNodeProc = reference to procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean); + // node events + TVTChangingEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; var Allowed: Boolean) of object; + TVTCheckChangingEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; var NewState: TCheckState; + var Allowed: Boolean) of object; + TVTChangeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; + /// + /// Cells can be empty + /// + TVTChangeCellEvent = procedure(Sender: TBaseVirtualTree; const Cells: TVTCellArray) of object; + TVTStructureChangeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Reason: TChangeReason) of object; + TVTEditCancelEvent = procedure(Sender: TBaseVirtualTree; Column: TColumnIndex) of object; + TVTEditChangingEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + var Allowed: Boolean) of object; + TVTEditChangeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex) of object; + TVTFreeNodeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; + TVTFocusChangingEvent = procedure(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn, + NewColumn: TColumnIndex; var Allowed: Boolean) of object; + TVTFocusChangeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex) of object; + TVTAddToSelectionEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; + TVTRemoveFromSelectionEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; + TVTGetImageEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var ImageIndex: TImageIndex) of object; + TVTGetImageExEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var ImageIndex: TImageIndex; var ImageList: TCustomImageList) of object; + TVTGetImageTextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var ImageText: string) of object; + TVTHotNodeChangeEvent = procedure(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode) of object; + TVTInitChildrenEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal) of object; + TVTInitNodeEvent = procedure(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates) of object; + TVTPopupEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; const P: TPoint; + var AskParent: Boolean; var PopupMenu: TPopupMenu) of object; + TVTHelpContextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + var HelpContext: Integer) of object; + TVTCreateEditorEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + out EditLink: IVTEditLink) of object; + TVTSaveTreeEvent = procedure(Sender: TBaseVirtualTree; Stream: TStream) of object; + TVTSaveNodeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Stream: TStream) of object; + TVTBeforeGetCheckStateEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; + + // header/column events + TVTHeaderAddPopupItemEvent = procedure(const Sender: TObject; const Column: TColumnIndex; var Cmd: TAddPopupItemType) of object; + TVTHeaderClickEvent = procedure(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo) of object; + TVTHeaderMouseEvent = procedure(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X, Y: TDimension) of object; + TVTHeaderMouseMoveEvent = procedure(Sender: TVTHeader; Shift: TShiftState; X, Y: TDimension) of object; + TVTBeforeHeaderHeightTrackingEvent = procedure(Sender: TVTHeader; Shift: TShiftState) of object; + TVTAfterHeaderHeightTrackingEvent = procedure(Sender: TVTHeader) of object; + TVTHeaderHeightTrackingEvent = procedure(Sender: TVTHeader; var P: TPoint; Shift: TShiftState; var Allowed: Boolean) of object; + TVTHeaderHeightDblClickResizeEvent = procedure(Sender: TVTHeader; var P: TPoint; Shift: TShiftState; var Allowed: Boolean) of object; + TVTHeaderNotifyEvent = procedure(Sender: TVTHeader; Column: TColumnIndex) of object; + TVTHeaderDraggingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var Allowed: Boolean) of object; + TVTHeaderDraggedEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; OldPosition: Integer) of object; + TVTHeaderDraggedOutEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; DropPosition: TPoint) of object; + TVTHeaderPaintEvent = procedure(Sender: TVTHeader; HeaderCanvas: TCanvas; Column: TVirtualTreeColumn; R: TRect; Hover, + Pressed: Boolean; DropMark: TVTDropMarkMode) of object; + TVTHeaderPaintQueryElementsEvent = procedure(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; + var Elements: THeaderPaintElements) of object; + TVTAdvancedHeaderPaintEvent = procedure(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; + const Elements: THeaderPaintElements) of object; + TVTBeforeAutoFitColumnsEvent = procedure(Sender: TVTHeader; var SmartAutoFitType: TSmartAutoFitType) of object; + TVTBeforeAutoFitColumnEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var SmartAutoFitType: TSmartAutoFitType; + var Allowed: Boolean) of object; + TVTAfterAutoFitColumnEvent = procedure(Sender: TVTHeader; Column: TColumnIndex) of object; + TVTAfterAutoFitColumnsEvent = procedure(Sender: TVTHeader) of object; + TVTColumnCheckChangingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var NewState: TCheckState; + var Allowed: Boolean) of object; + TVTColumnClickEvent = procedure (Sender: TBaseVirtualTree; Column: TColumnIndex; Shift: TShiftState) of object; + TVTColumnDblClickEvent = procedure (Sender: TBaseVirtualTree; Column: TColumnIndex; Shift: TShiftState) of object; + TColumnChangeEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex; Visible: Boolean) of object; + TVTColumnWidthDblClickResizeEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; Shift: TShiftState; P: TPoint; + var Allowed: Boolean) of object; + TVTBeforeColumnWidthTrackingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; Shift: TShiftState) of object; + TVTAfterColumnWidthTrackingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex) of object; + TVTColumnWidthTrackingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; Shift: TShiftState; var TrackPoint: TPoint; P: TPoint; + var Allowed: Boolean) of object; + TVTGetHeaderCursorEvent = procedure(Sender: TVTHeader; var Cursor: TVTCursor) of object; + TVTBeforeGetMaxColumnWidthEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var UseSmartColumnWidth: Boolean) of object; + TVTAfterGetMaxColumnWidthEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var MaxWidth: TDimension) of object; + TVTCanSplitterResizeColumnEvent = procedure(Sender: TVTHeader; P: TPoint; Column: TColumnIndex; var Allowed: Boolean) of object; + TVTCanSplitterResizeHeaderEvent = procedure(Sender: TVTHeader; P: TPoint; var Allowed: Boolean) of object; + + // move, copy and node tracking events + TVTNodeMovedEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; + TVTNodeMovingEvent = procedure(Sender: TBaseVirtualTree; Node, Target: PVirtualNode; + var Allowed: Boolean) of object; + TVTNodeCopiedEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; + TVTNodeCopyingEvent = procedure(Sender: TBaseVirtualTree; Node, Target: PVirtualNode; + var Allowed: Boolean) of object; + TVTNodeClickEvent = procedure(Sender: TBaseVirtualTree; const HitInfo: THitInfo) of object; + TVTNodeHeightTrackingEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; + var TrackPoint: TPoint; P: TPoint; var Allowed: Boolean) of object; + TVTNodeHeightDblClickResizeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + Shift: TShiftState; P: TPoint; var Allowed: Boolean) of object; + TVTCanSplitterResizeNodeEvent = procedure(Sender: TBaseVirtualTree; P: TPoint; Node: PVirtualNode; + Column: TColumnIndex; var Allowed: Boolean) of object; + + TVTGetUserClipboardFormatsEvent = procedure(Sender: TBaseVirtualTree; var Formats: TFormatEtcArray) of object; + + // drag'n drop/OLE events + TVTCreateDragManagerEvent = procedure(Sender: TBaseVirtualTree; out DragManager: IVTDragManager) of object; + TVTCreateDataObjectEvent = procedure(Sender: TBaseVirtualTree; out IDataObject: TVTDragDataObject) of object; + TVTDragAllowedEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + var Allowed: Boolean) of object; + TVTDragOverEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; + Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean) of object; + TVTDragDropEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; DataObject: TVTDragDataObject; + Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode) of object; + + // paint events + TVTBeforeItemEraseEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; + var ItemColor: TColor; var EraseAction: TItemEraseAction) of object; + TVTAfterItemEraseEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + ItemRect: TRect) of object; + TVTBeforeItemPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + ItemRect: TRect; var CustomDraw: Boolean) of object; + TVTAfterItemPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + ItemRect: TRect) of object; + TVTBeforeCellPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect) of object; + TVTAfterCellPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + Column: TColumnIndex; CellRect: TRect) of object; + TVTPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas) of object; + TVTBackgroundPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; R: TRect; + var Handled: Boolean) of object; + TVTGetLineStyleEvent = procedure(Sender: TBaseVirtualTree; var Bits: Pointer) of object; + TVTMeasureItemEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + var NodeHeight: TDimension) of object; + TVTPaintText = procedure(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType) of object; + + TVTPrepareButtonImagesEvent = procedure(Sender: TBaseVirtualTree; const APlusBM : TBitmap; const APlusHotBM :TBitmap; + 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; + TVTIncrementalSearchEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; const SearchText: string; + var Result: Integer) of object; + + // operations + TVTOperationEvent = procedure(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind) of object; + + TVTHintKind = (vhkText, vhkOwnerDraw); + TVTHintKindEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Kind: TVTHintKind) of object; + TVTDrawHintEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; R: TRect; Column: TColumnIndex) of object; + TVTGetHintSizeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect) of object; + + // miscellaneous + TVTBeforeDrawLineImageEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Level: Integer; var PosX: TDimension) of object; + TVTGetNodeDataSizeEvent = procedure(Sender: TBaseVirtualTree; var NodeDataSize: Integer) of object; + TVTKeyActionEvent = procedure(Sender: TBaseVirtualTree; var CharCode: Word; var Shift: TShiftState; + var DoDefault: Boolean) of object; + TVTScrollEvent = procedure(Sender: TBaseVirtualTree; DeltaX, DeltaY: TDimension) of object; + TVTUpdatingEvent = procedure(Sender: TBaseVirtualTree; State: TVTUpdateState) of object; + TVTGetCursorEvent = procedure(Sender: TBaseVirtualTree; var Cursor: TCursor) of object; + TVTStateChangeEvent = procedure(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates) of object; + TVTGetCellIsEmptyEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + var IsEmpty: Boolean) of object; + TVTScrollBarShowEvent = procedure(Sender: TBaseVirtualTree; Bar: Integer; Show: Boolean) of object; + + // Helper types for node iterations. + TGetFirstNodeProc = function: PVirtualNode of object; + TGetNextNodeProc = function(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode of object; + + TVZVirtualNodeEnumerationMode = ( + vneAll, + vneChecked, + vneChild, + vneCutCopy, + vneInitialized, + vneLeaf, + vneLevel, + vneNoInit, + vneSelected, + vneVisible, + vneVisibleChild, + vneVisibleNoInitChild, + vneVisibleNoInit + ); + + PVTVirtualNodeEnumeration = ^TVTVirtualNodeEnumeration; + + TVTVirtualNodeEnumerator = record + private + FNode: PVirtualNode; + FCanMoveNext: Boolean; + FEnumeration: PVTVirtualNodeEnumeration; + function GetCurrent: PVirtualNode; inline; + public + function MoveNext: Boolean; inline; + property Current: PVirtualNode read GetCurrent; + end; + + TVTVirtualNodeEnumeration = record + private + FMode: TVZVirtualNodeEnumerationMode; + FTree: TBaseVirtualTree; + // GetNextXxx parameters: + FConsiderChildrenAbove: Boolean; + FNode: PVirtualNode; + FNodeLevel: Cardinal; + FState: TCheckState; + FIncludeFiltered: Boolean; + public + function GetEnumerator: TVTVirtualNodeEnumerator; + private + function GetNext(Node: PVirtualNode): PVirtualNode; + end; + + + // ----- TBaseVirtualTree + TBaseVirtualTree = class abstract(TVTBaseAncestor) + private + FTotalInternalDataSize: Cardinal; // Cache of the sum of the necessary internal data size for all tree + FBorderStyle: TBorderStyle; + FHeader: TVTHeader; + FRoot: PVirtualNode; + FDefaultNodeHeight, + FIndent: TDimension; + FOptions: TCustomVirtualTreeOptions; + FUpdateCount: Cardinal; // update stopper, updates of the tree control are only done if = 0 + FSynchUpdateCount: Cardinal; // synchronizer, causes all events which are usually done via timers + // to happen immediately, regardless of the normal update state + FNodeDataSize: Integer; // number of bytes to allocate with each node (in addition to its base + // structure and the internal data), if -1 then do callback + FStates: TVirtualTreeStates; // various active/pending states the tree needs to consider + FLastSelected, + FFocusedNode: PVirtualNode; + FEditColumn, // column to be edited (focused node) + FFocusedColumn: TColumnIndex; // NoColumn if no columns are active otherwise the last hit column of + // the currently focused node + FHeightTrackPoint: TPoint; // Starting point of a node's height changing operation. + FHeightTrackNode: PVirtualNode; // Node which height is being changed. + FHeightTrackColumn: TColumnIndex; // Initial column where the height changing operation takes place. + FScrollDirections: TScrollDirections; // directions to scroll client area into depending on mouse position + FLastStructureChangeReason: TChangeReason; // Used for delayed structure change event. + FLastStructureChangeNode, // dito + FLastChangedNode, // used for delayed change event + FCurrentHotNode: PVirtualNode; // Node over which the mouse is hovering. + FCurrentHotColumn: TColumnIndex; // Column over which the mouse is hovering. + FHotNodeButtonHit: Boolean; // Indicates wether the mouse is hovering over the hot node's button. + FLastSelRect, + FNewSelRect: TRect; // used while doing draw selection + FHotCursor: TCursor; // can be set to additionally indicate the current hot node + FLastHitInfo: THitInfo; // The THitInfo of the last mouse-down event. + // in Win98 (slide) and Windows 2000 (fade)) + FHintMode: TVTHintMode; // determines the kind of the hint window + FHintData: TVTHintData; // used while preparing the hint window + FChangeDelay: Cardinal; // used to delay OnChange event + FEditDelay: Cardinal; // determines time to elapse before a node goes into edit mode + FPositionCache: TCache; // array which stores node references ordered by vertical positions + // (see also DoValidateCache for more information) + FVisibleCount: Cardinal; // number of currently visible nodes + FStartIndex: Cardinal; // index to start validating cache from + FSelection: TNodeArray; // list of currently selected nodes + FSelectionLocked: Boolean; // prevents the tree from changing the selection + FSelectedCells: TVTCellArray; // list of currently selected cells (node+column) / multicell + FSelectedCellCount: Integer; // number of selected cells in the array / multicell + FCellRangeAnchor: TVTCell; // anchor cell for cell range selection / multicell + FRangeAnchor: PVirtualNode; // anchor node for selection with the keyboard, determines start of a + // selection range + FCheckPropagationCount: Cardinal; // nesting level of check propagation (WL, 05.02.2004) + FLastSelectionLevel: Integer; // keeps the last node level for constrained multiselection + FDrawSelShiftState: TShiftState; // keeps the initial shift state when the user starts selection with + // the mouse + FEditLink: IVTEditLink; // used to comunicate with an application defined editor + FTempNodeCache: TNodeArray; // used at various places to hold temporarily a bunch of node refs. + FTempNodeCount: Cardinal; // number of nodes in FTempNodeCache + FBackground: TVTBackground; // A background image loadable at design and runtime. + FBackgroundImageTransparent: Boolean; // By default, this is off. When switched on, will try to draw the image + // transparent by using the color of the component as transparent color + + FMargin: TDimension; // horizontal distance to border and columns + FTextMargin: TDimension; // space between the node's text and its horizontal bounds + FBackgroundOffsetX, + FBackgroundOffsetY: TDimension; // used to fine tune the position of the background image + FAnimationDuration: Cardinal; // specifies how long an animation shall take (expanding, hint) + FWantTabs: Boolean; // If True then the tree also consumes the tab key. + FNodeAlignment: TVTNodeAlignment; // determines how to interpret the align member of a node + FHeaderRect: TRect; // Space which the header currently uses in the control (window coords). + FLastHintRect: TRect; // Area which the mouse must leave to reshow a hint. + FUpdateRect: TRect; + FEmptyListMessage: string; // Optional message that will be displayed if no nodes exist in the control. + + // paint support and images + FPlusBM, + FMinusBM, // small bitmaps used for tree buttons + FHotPlusBM, + FHotMinusBM, + FSelectedHotPlusBM, + FSelectedHotMinusBM: TBitmap; // small bitmaps used for hot tree buttons + FImages, // normal images in the tree + FStateImages, // state images in the tree + FCustomCheckImages: TCustomImageList; // application defined check images + FCheckImageKind: TCheckImageKind; // light or dark, cross marks or tick marks + FCheckImages: TCustomImageList; // Reference to global image list to be used for the check images. + //TODO: Use this margin for other images as well + FImagesMargin: TDimension; // The margin used left and right of the checkboxes. + FImageChangeLink, + FStateChangeLink, + FCustomCheckChangeLink: TChangeLink; // connections to the image lists + FOldFontChange: TNotifyEvent; // helper method pointer for tracking font changes in the off screen buffer + FColors: TVTColors; // class comprising all customizable colors in the tree + FButtonStyle: TVTButtonStyle; // style of the tree buttons + FButtonFillMode: TVTButtonFillMode; // for rectangular tree buttons only: how to fill them + FLineStyle: TVTLineStyle; // style of the tree lines + FLineMode: TVTLineMode; // tree lines or bands etc. + FSelectionCurveRadius: Cardinal; // radius for rounded selection rectangles + FSelectionBlendFactor: Byte; // Determines the factor by which the selection rectangle is to be + // faded if enabled. + FDrawSelectionMode: TVTDrawSelectionMode; // determines the paint mode for draw selection + + // alignment and directionality support + FAlignment: TAlignment; // default alignment of the tree if no columns are shown + + // drag'n drop and clipboard support + FDragImageKind: TVTDragImageKind; // determines whether or not and what to show in the drag image + FDragOperations: TDragOperations; // determines which operations are allowed during drag'n drop + FDragThreshold: Integer; // used to determine when to actually start a drag'n drop operation + FDragManager: IVTDragManager; // drag'n drop, cut'n paste + FDropTargetNode: PVirtualNode; // node currently selected as drop target + FLastDropMode: TDropMode; // set while dragging and used to track changes + FDragSelection: TNodeArray; // temporary copy of FSelection used during drag'n drop + FLastDragEffect: Integer; // The last executed drag effect + FDragType: TVTDragType; // used to switch between OLE and VCL drag'n drop + FDragWidth, + FDragHeight: Integer; // size of the drag image, the larger the more CPU power is needed + FClipboardFormats: TClipboardFormats; // a list of clipboard format descriptions enabled for this tree + FLastVCLDragTarget: PVirtualNode; // A node cache for VCL drag'n drop (keywords: DragLeave on DragDrop). + FVCLDragEffect: Integer; // A cache for VCL drag'n drop to keep the current drop effect. + + // scroll support + FScrollBarOptions: TScrollBarOptions; // common properties of horizontal and vertical scrollbar + FAutoScrollInterval: TAutoScrollInterval; // determines speed of auto scrolling + FAutoScrollDelay: Cardinal; // amount of milliseconds to wait until autoscrolling becomes active + FAutoExpandDelay: Cardinal; // amount of milliseconds to wait until a node is expanded if it is the + // drop target + FOffsetX: TDimension; + FOffsetY: TDimension; // Determines left and top scroll offset. + FEffectiveOffsetX: TDimension; // Actual position of the horizontal scroll bar (varies depending on bidi mode). + FRangeX, + 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. + FDragScrollStart: Cardinal; // Contains the start time when a tree does auto scrolling as drop target. + + // search + FIncrementalSearch: TVTIncrementalSearch; // Used to determine whether and how incremental search is to be used. + FSearchTimeout: Cardinal; // Number of milliseconds after which to stop incremental searching. + FSearchBuffer: string; // Collects a sequence of keypresses used to do incremental searching. + FLastSearchNode: PVirtualNode; // Reference to node which was last found as search fit. + FSearchDirection: TVTSearchDirection; // Direction to incrementally search the tree. + FSearchStart: TVTSearchStart; // Where to start iteration on each key press. + + // miscellanous + FPanningWindow: TForm; // Helper window for wheel panning + FPanningCursor: TVTCursor; // Current wheel panning cursor. + 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. + FChangingTheme: Boolean; // Used to indicate that a theme change is goi ng on + FNextNodeToSelect: PVirtualNode; // Next tree node that we would like to select if the current one gets deleted or looses selection for other reasons. + FPendingSyncProcs:Integer; // Counter that indicates whether we have queued anonymous calls to the min thread, see issue #1199 + + // export + FOnBeforeNodeExport: TVTNodeExportEvent; // called before exporting a node + FOnNodeExport: TVTNodeExportEvent; + FOnAfterNodeExport: TVTNodeExportEvent; // called after exporting a node + FOnBeforeColumnExport: TVTColumnExportEvent; // called before exporting a column + FOnColumnExport: TVTColumnExportEvent; + FOnAfterColumnExport: TVTColumnExportEvent; // called after exporting a column + FOnBeforeTreeExport: TVTTreeExportEvent; // called before starting the export + FOnAfterTreeExport: TVTTreeExportEvent; // called after finishing the export + FOnBeforeHeaderExport: TVTTreeExportEvent; // called before exporting the header + FOnAfterHeaderExport: TVTTreeExportEvent; // called after exporting the header + + // common events + FOnChange: TVTChangeEvent; // selection change + /// + /// Used for notifying that cell selection have changed + /// + FOnChangeCell: TVTChangeCellEvent; + // cells selection change + FOnStructureChange: TVTStructureChangeEvent; // structural change like adding nodes etc. + FOnInitChildren: TVTInitChildrenEvent; // called when a node's children are needed (expanding etc.) + FOnInitNode: TVTInitNodeEvent; // called when a node needs to be initialized (child count etc.) + FOnFreeNode: TVTFreeNodeEvent; // called when a node is about to be destroyed, user data can and should + // be freed in this event + FOnGetImage: TVTGetImageEvent; // Used to retrieve the image index of a given node. + FOnGetImageEx: TVTGetImageExEvent; // Used to retrieve the image index of a given node along with a custom + // image list. + FOnGetImageText: TVTGetImageTextEvent; // Used to retrieve the image alternative text of a given node. + // Used by the accessibility interface to provide useful text for status images. + FOnHotChange: TVTHotNodeChangeEvent; // called when the current "hot" node (that is, the node under the mouse) + // changes and hot tracking is enabled + FOnExpanding, // called just before a node is expanded + FOnCollapsing: TVTChangingEvent; // called just before a node is collapsed + FOnChecking: TVTCheckChangingEvent; // called just before a node's check state is changed + FOnExpanded, // called after a node has been expanded + FOnCollapsed, // called after a node has been collapsed + FOnChecked: TVTChangeEvent; // called after a node's check state has been changed + FOnResetNode: TVTChangeEvent; // called when a node is set to be uninitialized + FOnNodeMoving: TVTNodeMovingEvent; // called just before a node is moved from one parent node to another + // (this can be cancelled) + FOnNodeMoved: TVTNodeMovedEvent; // called after a node and its children have been moved to another + // parent node (probably another tree, but within the same application) + FOnNodeCopying: TVTNodeCopyingEvent; // called when a node is copied to another parent node (probably in + // another tree, but within the same application, can be cancelled) + FOnNodeClick: TVTNodeClickEvent; // called when the user clicks on a node + FOnNodeDblClick: TVTNodeClickEvent; // called when the user double clicks on a node + FOnCanSplitterResizeNode: TVTCanSplitterResizeNodeEvent; // called to query the application wether resizing a node is allowed + FOnNodeHeightTracking: TVTNodeHeightTrackingEvent; // called when a node's height is being changed via mouse + FOnNodeHeightDblClickResize: TVTNodeHeightDblClickResizeEvent; // called when a node's vertical splitter is double clicked + FOnNodeCopied: TVTNodeCopiedEvent; // call after a node has been copied + FOnEditing: TVTEditChangingEvent; // called just before a node goes into edit mode + FOnEditCancelled: TVTEditCancelEvent; // called when editing has been cancelled + FOnEdited: TVTEditChangeEvent; // called when editing has successfully been finished + FOnFocusChanging: TVTFocusChangingEvent; // called when the focus is about to go to a new node and/or column + // (can be cancelled) + FOnFocusChanged: TVTFocusChangeEvent; // called when the focus goes to a new node and/or column + FOnAddToSelection: TVTAddToSelectionEvent; // called when a node is added to the selection + FOnRemoveFromSelection: TVTRemoveFromSelectionEvent; // called when a node is removed from the selection + FOnGetPopupMenu: TVTPopupEvent; // called when the popup for a node or the header needs to be shown + FOnGetHelpContext: TVTHelpContextEvent; // called when a node specific help theme should be called + FOnCreateEditor: TVTCreateEditorEvent; // called when a node goes into edit mode, this allows applications + // to supply their own editor + FOnLoadNode, // called after a node has been loaded from a stream (file, clipboard, + // OLE drag'n drop) to allow an application to load their own data + // saved in OnSaveNode + FOnSaveNode: TVTSaveNodeEvent; // called when a node needs to be serialized into a stream + // (see OnLoadNode) to give the application the opportunity to save + // their node specific, persistent data (note: never save memory + // references) + FOnLoadTree, // called after the tree has been loaded from a stream to allow an + // application to load their own data saved in OnSaveTree + FOnSaveTree: TVTSaveTreeEvent; // called after the tree has been saved to a stream to allow an + // application to save its own data + + // header/column mouse events + FOnAfterAutoFitColumn: TVTAfterAutoFitColumnEvent; + FOnAfterAutoFitColumns: TVTAfterAutoFitColumnsEvent; + FOnBeforeAutoFitColumns: TVTBeforeAutoFitColumnsEvent; + FOnBeforeAutoFitColumn: TVTBeforeAutoFitColumnEvent; + FOnHeaderAddPopupItem: TVTHeaderAddPopupItemEvent; + FOnHeaderClick: TVTHeaderClickEvent; + FOnHeaderDblClick: TVTHeaderClickEvent; + FOnAfterHeaderHeightTracking: TVTAfterHeaderHeightTrackingEvent; + FOnBeforeHeaderHeightTracking: TVTBeforeHeaderHeightTrackingEvent; + FOnHeaderHeightTracking: TVTHeaderHeightTrackingEvent; + FOnHeaderHeightDblClickResize: TVTHeaderHeightDblClickResizeEvent; + FOnHeaderMouseDown, + FOnHeaderMouseUp: TVTHeaderMouseEvent; + FOnHeaderMouseMove: TVTHeaderMouseMoveEvent; + FOnAfterGetMaxColumnWidth: TVTAfterGetMaxColumnWidthEvent; + FOnBeforeGetMaxColumnWidth: TVTBeforeGetMaxColumnWidthEvent; + FOnColumnChecked: TVTHeaderNotifyEvent; // triggered when the column is about to be checked + FOnColumnChecking: TVTColumnCheckChangingEvent; + FOnColumnClick: TVTColumnClickEvent; + FOnColumnDblClick: TVTColumnDblClickEvent; + FOnColumnResize: TVTHeaderNotifyEvent; + fOnColumnVisibilityChanged: TColumnChangeEvent; + FOnColumnWidthDblClickResize: TVTColumnWidthDblClickResizeEvent; + FOnAfterColumnWidthTracking: TVTAfterColumnWidthTrackingEvent; + FOnBeforeColumnWidthTracking: TVTBeforeColumnWidthTrackingEvent; + FOnColumnWidthTracking: TVTColumnWidthTrackingEvent; + FOnGetHeaderCursor: TVTGetHeaderCursorEvent; // triggered to allow the app. to use customized cursors for the header + FOnCanSplitterResizeColumn: TVTCanSplitterResizeColumnEvent; + FOnCanSplitterResizeHeader: TVTCanSplitterResizeHeaderEvent; + + // paint events + FOnAfterPaint, // triggered when the tree has entirely been painted + FOnBeforePaint: TVTPaintEvent; // triggered when the tree is about to be painted + FOnAfterItemPaint: TVTAfterItemPaintEvent; // triggered after an item has been painted + FOnBeforeItemPaint: TVTBeforeItemPaintEvent; // triggered when an item is about to be painted + FOnBeforeItemErase: TVTBeforeItemEraseEvent; // triggered when an item's background is about to be erased + FOnAfterItemErase: TVTAfterItemEraseEvent; // triggered after an item's background has been erased + FOnAfterCellPaint: TVTAfterCellPaintEvent; // triggered after a column of an item has been painted + FOnBeforeCellPaint: TVTBeforeCellPaintEvent; // triggered when a column of an item is about to be painted + FOnHeaderDraw: TVTHeaderPaintEvent; // Used when owner draw is enabled for the header and a column is set + // to owner draw mode. + FOnPrepareButtonImages : TVTPrepareButtonImagesEvent; //allow use to customise plus/minus bitmap images + FOnHeaderDrawQueryElements: TVTHeaderPaintQueryElementsEvent; // Used for advanced header painting to query the + // application for the elements, which are drawn by it and which should + // be drawn by the tree. + FOnAdvancedHeaderDraw: TVTAdvancedHeaderPaintEvent; // Used when owner draw is enabled for the header and a column + // is set to owner draw mode. But only if OnHeaderDrawQueryElements + // returns at least one element to be drawn by the application. + // In this case OnHeaderDraw is not used. + FOnGetLineStyle: TVTGetLineStyleEvent; // triggered when a custom line style is used and the pattern brush + // needs to be build + FOnPaintBackground: TVTBackgroundPaintEvent; // triggered if a part of the tree's background must be erased which is + // 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 + // even finer customization (kind of sub cell painting) + // drag'n drop events + FOnCreateDragManager: TVTCreateDragManagerEvent; // called to allow for app./descendant defined drag managers + FOnCreateDataObject: TVTCreateDataObjectEvent; // called to allow for app./descendant defined data objects + FOnDragAllowed: TVTDragAllowedEvent; // used to get permission for manual drag in mouse down + FOnDragOver: TVTDragOverEvent; // called for every mouse move + FOnDragDrop: TVTDragDropEvent; // called on release of mouse button (if drop was allowed) + FOnHeaderDragged: TVTHeaderDraggedEvent; // header (column) drag'n drop + FOnHeaderDraggedOut: TVTHeaderDraggedOutEvent; // header (column) drag'n drop, which did not result in a valid drop. + FOnHeaderDragging: TVTHeaderDraggingEvent; // header (column) drag'n drop + + // miscellanous events + FOnGetNodeDataSize: TVTGetNodeDataSizeEvent; // Called if NodeDataSize is -1. + FOnBeforeDrawLineImage: TVTBeforeDrawLineImageEvent; // Called to allow adjusting the indention of treelines. + FOnKeyAction: TVTKeyActionEvent; // Used to selectively prevent key actions (full expand on Ctrl+'+' etc.). + FOnScroll: TVTScrollEvent; // Called when one or both paint offsets changed. + FOnUpdating: TVTUpdatingEvent; // Called from BeginUpdate, EndUpdate, BeginSynch and EndSynch. + FOnGetCursor: TVTGetCursorEvent; // Called to allow the app. to set individual cursors. + FOnStateChange: TVTStateChangeEvent; // Called whenever a state in the tree changes. + FOnGetCellIsEmpty: TVTGetCellIsEmptyEvent; // Called when the tree needs to know if a cell is empty. + FOnShowScrollBar: TVTScrollBarShowEvent; // Called when a scrollbar is changed in its visibility. + FOnBeforeGetCheckState: TVTBeforeGetCheckStateEvent; // Called before a CheckState for a Node is obtained. + // Gives the application a chance to do special processing + // when a check state is actually required for the first time. + + // search, sort + FOnCompareNodes: TVTCompareEvent; // used during sort + FOnDrawHint: TVTDrawHintEvent; + FOnGetHintSize: TVTGetHintSizeEvent; + FOnGetHintKind: TVTHintKindEvent; + FOnIncrementalSearch: TVTIncrementalSearchEvent; // triggered on every key press (not key down) + FOnMouseEnter: TNotifyEvent; + FOnMouseLeave: TNotifyEvent; + + // operations + FOnStartOperation: TVTOperationEvent; // Called when an operation starts + FOnEndOperation: TVTOperationEvent; // Called when an operation ends + + FVclStyleEnabled: Boolean; + FSelectionCount: Integer; + + procedure CMStyleChanged(var Message: TMessage); message CM_STYLECHANGED; + procedure CMParentDoubleBufferedChange(var Message: TMessage); message CM_PARENTDOUBLEBUFFEREDCHANGED; + + procedure AdjustTotalCount(Node: PVirtualNode; Value: Integer; relative: Boolean = False); + function CalculateCacheEntryCount: Integer; + procedure CalculateVerticalAlignments(var PaintInfo: TVTPaintInfo; var VButtonAlign: TDimension); + function ChangeCheckState(Node: PVirtualNode; Value: TCheckState): Boolean; + function CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, NodeRight: TDimension; Alignment: TAlignment; OldRect, + NewRect: TRect): Boolean; + function CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, NodeRight: TDimension; Alignment: TAlignment; OldRect, + NewRect: TRect): Boolean; + 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: TNodeHeight): PVirtualNode; overload; + function FindInPositionCache(Position: TDimension; var CurrentPos: TNodeHeight): PVirtualNode; overload; + procedure FixupTotalCount(Node: PVirtualNode); + procedure FixupTotalHeight(Node: PVirtualNode); + function GetBottomNode: PVirtualNode; + function GetCheckState(Node: PVirtualNode): TCheckState; + function GetCheckType(Node: PVirtualNode): TCheckType; + function GetChildCount(Node: PVirtualNode): Cardinal; + function GetChildrenInitialized(Node: PVirtualNode): Boolean; inline; + function GetCutCopyCount: Integer; + function GetDisabled(Node: PVirtualNode): Boolean; + function GetSyncCheckstateWithSelection(Node: PVirtualNode): Boolean; + function GetDragManager: IVTDragManager; + function GetExpanded(Node: PVirtualNode): Boolean; + function GetFiltered(Node: PVirtualNode): Boolean; + function GetFullyVisible(Node: PVirtualNode): Boolean; + function GetHasChildren(Node: PVirtualNode): Boolean; + function GetMultiline(Node: PVirtualNode): Boolean; + function GetNodeHeight(Node: PVirtualNode): TNodeHeight; + function GetNodeParent(Node: PVirtualNode): PVirtualNode; + function GetOffsetXY: TPoint; + function GetRootNodeCount: Cardinal; + function GetSelected(Node: PVirtualNode): Boolean; + function GetTopNode: PVirtualNode; + function GetTotalCount: Cardinal; + function GetVerticalAlignment(Node: PVirtualNode): Byte; + function GetVisible(Node: PVirtualNode): Boolean; + function GetVisiblePath(Node: PVirtualNode): Boolean; + function HandleDrawSelection(X, Y: TDimension): Boolean; + procedure HandleCheckboxClick(pHitNode: PVirtualNode; pKeys: LongInt); + function HasVisibleNextSibling(Node: PVirtualNode): Boolean; + function HasVisiblePreviousSibling(Node: PVirtualNode): Boolean; + procedure ImageListChange(Sender: TObject); + procedure InitializeFirstColumnValues(var PaintInfo: TVTPaintInfo); + procedure InitRootNode(OldSize: Cardinal = 0); + function IsFirstVisibleChild(Parent, Node: PVirtualNode): Boolean; + function IsLastVisibleChild(Parent, Node: PVirtualNode): Boolean; + function MakeNewNode: PVirtualNode; + function PackArray({*}const TheArray: TNodeArray; Count: Integer): Integer; + procedure FakeReadIdent(Reader: TReader); + procedure SetAlignment(const Value: TAlignment); + procedure SetAnimationDuration(const Value: Cardinal); + procedure SetBackground(const Value: TVTBackground); + procedure SetBackGroundImageTransparent(const Value: Boolean); + procedure SetBackgroundOffset(const Index: Integer; const Value: TDimension); + procedure SetBorderStyle(Value: TBorderStyle); + procedure SetBottomNode(Node: PVirtualNode); + procedure SetBottomSpace(const Value: TDimension); + procedure SetButtonFillMode(const Value: TVTButtonFillMode); + procedure SetButtonStyle(const Value: TVTButtonStyle); + procedure SetCheckImageKind(Value: TCheckImageKind); + procedure SetCheckState(Node: PVirtualNode; Value: TCheckState); + procedure SetCheckType(Node: PVirtualNode; Value: TCheckType); + procedure SetClipboardFormats(const Value: TClipboardFormats); + procedure SetColors(const Value: TVTColors); + procedure SetCustomCheckImages(const Value: TCustomImageList); + procedure SetDefaultNodeHeight(Value: TDimension); + procedure SetDisabled(Node: PVirtualNode; Value: Boolean); + procedure SetEmptyListMessage(const Value: string); + procedure SetExpanded(Node: PVirtualNode; Value: Boolean); + procedure SetFocusedColumn(Value: TColumnIndex); + procedure SetFocusedNode(Value: PVirtualNode); + procedure SetFullyVisible(Node: PVirtualNode; Value: Boolean); + procedure SetHasChildren(Node: PVirtualNode; Value: Boolean); + procedure SetHeader(const Value: TVTHeader); + procedure SetHotNode(Value: PVirtualNode); + procedure SetFiltered(Node: PVirtualNode; Value: Boolean); + procedure SetImages(const Value: TCustomImageList); + procedure SetIndent(Value: TDimension); + procedure SetLineMode(const Value: TVTLineMode); + procedure SetLineStyle(const Value: TVTLineStyle); + procedure SetMargin(Value: TDimension); + procedure SetMultiline(Node: PVirtualNode; const Value: Boolean); + procedure SetNodeAlignment(const Value: TVTNodeAlignment); + procedure SetNodeDataSize(Value: Integer); + procedure SetNodeHeight(Node: PVirtualNode; Value: TNodeHeight); + procedure SetNodeParent(Node: PVirtualNode; const Value: PVirtualNode); + procedure SetOffsetX(const Value: TDimension); + procedure SetOffsetXY(const Value: TPoint); + procedure SetOffsetY(const Value: TDimension); + procedure SetOptions(const Value: TCustomVirtualTreeOptions); + procedure SetRootNodeCount(Value: Cardinal); + procedure SetScrollBarOptions(Value: TScrollBarOptions); + procedure SetSearchOption(const Value: TVTIncrementalSearch); + procedure SetSelected(Node: PVirtualNode; Value: Boolean); + procedure SetSelectionCurveRadius(const Value: Cardinal); + procedure SetStateImages(const Value: TCustomImageList); + procedure SetTextMargin(Value: TDimension); + procedure SetTopNode(Node: PVirtualNode); + procedure SetUpdateState(Updating: Boolean); + procedure SetVerticalAlignment(Node: PVirtualNode; Value: Byte); + procedure SetVisible(Node: PVirtualNode; Value: Boolean); + procedure SetVisiblePath(Node: PVirtualNode; Value: Boolean); + procedure PrepareBackGroundPicture(Source: TVTBackground; DrawingBitmap: TBitmap; DrawingBitmapWidth: TDimension; DrawingBitmapHeight: TDimension; ABkgcolor: TColor); + procedure StaticBackground(Source: TVTBackground; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); + procedure TileBackground(Source: TVTBackground; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); + function ToggleCallback(Step, StepSize: Integer; Data: Pointer): Boolean; + + procedure CMColorChange(var Message: TMessage); message CM_COLORCHANGED; + procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED; + procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED; + procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED; + procedure CMDenySubclassing(var Message: TMessage); message CM_DENYSUBCLASSING; + procedure CMDrag(var Message: TCMDrag); message CM_DRAG; + procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; + procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; + procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; + procedure CMHintShowPause(var Message: TCMHintShowPause); message CM_HINTSHOWPAUSE; + procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; + procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; + procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL; + procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; + procedure TVMGetItem(var Message: TMessage); message TVM_GETITEM; + procedure TVMGetItemRect(var Message: TMessage); message TVM_GETITEMRECT; + procedure TVMGetNextItem(var Message: TMessage); message TVM_GETNEXTITEM; + procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE; + procedure WMChar(var Message: TWMChar); message WM_CHAR; + procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU; + procedure WMCopy(var Message: TWMCopy); message WM_COPY; + procedure WMCut(var Message: TWMCut); message WM_CUT; + procedure WMEnable(var Message: TWMEnable); message WM_ENABLE; + procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; + procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; + procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL; + procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; + procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP; + procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; + procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; + procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; + procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; + procedure WMMButtonDblClk(var Message: TWMMButtonDblClk); message WM_MBUTTONDBLCLK; + procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN; + procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP; + procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; + procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY; + procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; + procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT; + procedure WMPaint(var Message: TWMPaint); message WM_PAINT; + procedure WMPaste(var Message: TWMPaste); message WM_PASTE; + procedure WMPrint(var Message: TWMPrint); message WM_PRINT; + procedure WMRButtonDblClk(var Message: TWMRButtonDblClk); message WM_RBUTTONDBLCLK; + procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; + procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP; + procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; + procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; + procedure WMSize(var Message: TWMSize); message WM_SIZE; + procedure WMTimer(var Message: TWMTimer); message WM_TIMER; + procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED; + procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; + function GetRangeX: TDimension; + procedure SetDoubleBuffered(const Value: Boolean); + function GetVclStyleEnabled: Boolean; inline; + procedure SetOnPrepareButtonImages(const Value: TVTPrepareButtonImagesEvent); + function IsStored_BackgroundOffsetXY(const Index: Integer): Boolean; + function IsStored_BottomSpace: Boolean; + function IsStored_DefaultNodeHeight: Boolean; + function IsStored_Indent: Boolean; + function IsStored_Margin: Boolean; + function IsStored_TextMargin: Boolean; + protected + FFontChanged: Boolean; // flag for keeping informed about font changes in the off screen buffer // [IPK] - private to protected + procedure AutoScale(); virtual; + 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: TNodeHeight; relative: Boolean = False); + procedure AdviseChangeEvent(StructureChange: Boolean; Node: PVirtualNode; Reason: TChangeReason); virtual; + procedure AdviseChangeCellEvent(const Cells: TVTCellArray); virtual; + function AllocateInternalDataArea(Size: Cardinal): Cardinal; virtual; + procedure Animate(Steps, Duration: Cardinal; Callback: TVTAnimationCallback; Data: Pointer); virtual; + function CalculateSelectionRect(X, Y: TDimension): Boolean; virtual; + function CanAutoScroll: Boolean; virtual; + function CanShowDragImage: Boolean; virtual; + function CanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex): Boolean; + procedure Change(Node: PVirtualNode); virtual; + + /// + /// Called to notify that cell selection have changed + /// + /// + /// The updated cells + /// + procedure ChangeCell(const Cells: TVTCellArray); virtual; + procedure ChangeTreeStatesAsync(EnterStates, LeaveStates: TVirtualTreeStates); + procedure ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; isDpiChange: Boolean{$ifend}); override; + function CheckParentCheckState(Node: PVirtualNode; NewCheckState: TCheckState): Boolean; virtual; + procedure ClearDragManager; + procedure ClearSelection(pFireChangeEvent: Boolean); overload; virtual; + procedure ClearTempCache; virtual; + function ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; + function ComputeRTLOffset(ExcludeScrollBar: Boolean = False): TDimension; virtual; + function CountLevelDifference(Node1, Node2: PVirtualNode): Integer; virtual; + function CountVisibleChildren(Node: PVirtualNode): Cardinal; virtual; + procedure CreateParams(var Params: TCreateParams); override; + procedure CreateWnd; override; + procedure DecVisibleCount; + procedure DefineProperties(Filer: TFiler); override; + procedure DeleteNode(Node: PVirtualNode; Reindex: Boolean; ParentClearing: Boolean); overload; + function DetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect): TDropMode; virtual; + procedure DetermineHiddenChildrenFlag(Node: PVirtualNode); virtual; + procedure DetermineHiddenChildrenFlagAllNodes; virtual; + procedure DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: TDimension; Alignment: TAlignment); virtual; + procedure DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: TDimension; Alignment: TAlignment); virtual; + function DetermineLineImageAndSelectLevel(Node: PVirtualNode; var LineImage: TLineImage): Integer; virtual; + function DetermineNextCheckState(CheckType: TCheckType; CheckState: TCheckState): TCheckState; virtual; + function DetermineScrollDirections(X, Y: TDimension): TScrollDirections; virtual; + procedure DoAddToSelection(Node: PVirtualNode); virtual; + procedure DoAdvancedHeaderDraw(var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements); virtual; + procedure DoAfterCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); virtual; + procedure DoAfterItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); virtual; + procedure DoAfterItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); virtual; + procedure DoAfterPaint(Canvas: TCanvas); virtual; + procedure DoAutoScroll(X, Y: TDimension); virtual; + function DoBeforeDrag(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; + procedure DoBeforeCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); virtual; + procedure DoBeforeItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; var Color: TColor; + var EraseAction: TItemEraseAction); virtual; + function DoBeforeItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect): Boolean; virtual; + procedure DoBeforePaint(Canvas: TCanvas); virtual; + function DoCancelEdit: Boolean; virtual; + procedure DoCanEdit(Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); virtual; + procedure DoCanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex; + var Allowed: Boolean); virtual; + procedure DoChange(Node: PVirtualNode); virtual; + + /// + /// Notifies that the selected cells have changed. Cells can be empty + /// + /// + /// Multiple events might be fired for the same selection + /// Do not assume that only 1 cell change event will be fired for the same + /// cell change + /// + /// + /// + procedure DoChangeCell(const Cells: TVTCellArray); virtual; + procedure DoCheckClick(Node: PVirtualNode; NewCheckState: TCheckState); virtual; + procedure DoChecked(Node: PVirtualNode); virtual; + function DoChecking(Node: PVirtualNode; var NewCheckState: TCheckState): Boolean; virtual; + procedure DoCollapsed(Node: PVirtualNode); virtual; + function DoCollapsing(Node: PVirtualNode): Boolean; virtual; + procedure DoColumnChecked(Column: TColumnIndex); virtual; + function DoColumnChecking(Column: TColumnIndex; var NewCheckState: TCheckState): Boolean; virtual; + procedure DoColumnClick(Column: TColumnIndex; Shift: TShiftState); virtual; + procedure DoColumnDblClick(Column: TColumnIndex; Shift: TShiftState); virtual; + procedure DoColumnResize(Column: TColumnIndex); virtual; + procedure DoColumnVisibilityChanged(const Column: TColumnIndex; Visible: Boolean); virtual; + function DoCompare(Node1, Node2: PVirtualNode; Column: TColumnIndex): Integer; virtual; + function DoCreateDataObject: IDataObject; virtual; + function DoCreateDragManager: IVTDragManager; virtual; + function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; virtual; + procedure DoDragging(P: TPoint); virtual; + procedure DoDragExpand; virtual; + procedure DoBeforeDrawLineImage(Node: PVirtualNode; Level: Integer; var XPos: TDimension); virtual; + function DoDragOver(Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; + var Effect: Integer): Boolean; virtual; + procedure DoDragDrop(Source: TObject; const DataObject: TVTDragDataObject; const Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; + var Effect: Integer; Mode: TDropMode); virtual; + procedure DoDrawHint(Canvas: TCanvas; Node: PVirtualNode; R: TRect; Column: + TColumnIndex); + procedure DoEdit; virtual; + procedure DoEndDrag(Target: TObject; X, Y: TDimension); override; + function DoEndEdit(pCancel: Boolean = False): Boolean; virtual; + procedure DoEndOperation(OperationKind: TVTOperationKind); virtual; + procedure DoEnter(); override; + procedure DoExpanded(Node: PVirtualNode); virtual; + function DoExpanding(Node: PVirtualNode): Boolean; virtual; + procedure DoFocusChange(Node: PVirtualNode; Column: TColumnIndex); virtual; + function DoFocusChanging(OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex): Boolean; virtual; + procedure DoFocusNode(Node: PVirtualNode; Ask: Boolean); virtual; + procedure DoFreeNode(Node: PVirtualNode); virtual; + function DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; + CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; virtual; + procedure DoGetCursor(var Cursor: TCursor); virtual; + procedure DoGetHeaderCursor(var Cursor: TVTCursor); virtual; + procedure DoGetHintSize(Node: PVirtualNode; Column: TColumnIndex; var R: + TRect); virtual; + procedure DoGetHintKind(Node: PVirtualNode; Column: TColumnIndex; var Kind: + TVTHintKind); + function DoGetImageIndex(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var Index: TImageIndex): TCustomImageList; virtual; + procedure DoGetImageText(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var ImageText: string); virtual; + procedure DoGetLineStyle(var Bits: Pointer); virtual; + function DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; virtual; + function DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; virtual; + function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; virtual; + function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; virtual; + function DoGetPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint): TPopupMenu; virtual; + procedure DoGetUserClipboardFormats(var Formats: TFormatEtcArray); virtual; + procedure DoHeaderAddPopupItem(const Column: TColumnIndex; var Cmd: TAddPopupItemType); + procedure DoHeaderClick(const HitInfo: TVTHeaderHitInfo); virtual; + procedure DoHeaderDblClick(const HitInfo: TVTHeaderHitInfo); virtual; + procedure DoHeaderDragged(Column: TColumnIndex; OldPosition: TColumnPosition); virtual; + procedure DoHeaderDraggedOut(Column: TColumnIndex; DropPosition: TPoint); virtual; + function DoHeaderDragging(Column: TColumnIndex): Boolean; virtual; + procedure DoHeaderDraw(Canvas: TCanvas; Column: TVirtualTreeColumn; R: TRect; Hover, Pressed: Boolean; + DropMark: TVTDropMarkMode); virtual; + procedure DoHeaderDrawQueryElements(var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); virtual; + procedure DoHeaderMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: TDimension); virtual; + procedure DoHeaderMouseMove(Shift: TShiftState; X, Y: TDimension); virtual; + procedure DoHeaderMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: TDimension); virtual; + procedure DoHotChange(Old, New: PVirtualNode); virtual; + function DoIncrementalSearch(Node: PVirtualNode; const Text: string): Integer; virtual; + function DoInitChildren(Node: PVirtualNode; var ChildCount: Cardinal): Boolean; virtual; + procedure DoInitNode(Parent, Node: PVirtualNode; var InitStates: TVirtualNodeInitStates); virtual; + function DoKeyAction(var CharCode: Word; var Shift: TShiftState): Boolean; virtual; + procedure DoLoadUserData(Node: PVirtualNode; Stream: TStream); virtual; + procedure DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: TDimension); virtual; + procedure DoMouseEnter(); override; + procedure DoMouseLeave(); override; + procedure DoNodeCopied(Node: PVirtualNode); virtual; + function DoNodeCopying(Node, NewParent: PVirtualNode): Boolean; virtual; + procedure DoNodeClick(const HitInfo: THitInfo); virtual; + procedure DoNodeDblClick(const HitInfo: THitInfo); virtual; + function DoNodeHeightDblClickResize(Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; + P: TPoint): Boolean; virtual; + function DoNodeHeightTracking(Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; + var TrackPoint: TPoint; P: TPoint): Boolean; virtual; + procedure DoNodeMoved(Node: PVirtualNode); virtual; + function DoNodeMoving(Node, NewParent: PVirtualNode): Boolean; virtual; + function DoPaintBackground(Canvas: TCanvas; R: TRect): Boolean; virtual; + procedure DoPaintDropMark(Canvas: TCanvas; Node: PVirtualNode; R: TRect); virtual; + procedure DoPaintNode(var PaintInfo: TVTPaintInfo); virtual; + procedure DoPaintText(Node: PVirtualNode; const Canvas: TCanvas; Column: TColumnIndex; TextType: TVSTTextType); virtual; + procedure DoPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint); virtual; + procedure DoRemoveFromSelection(Node: PVirtualNode); virtual; + procedure DoReset(Node: PVirtualNode); virtual; + procedure DoSaveUserData(Node: PVirtualNode; Stream: TStream); virtual; + procedure DoScroll(DeltaX, DeltaY: TDimension); virtual; + function DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOptions; ClipRect: PRect = nil): Boolean; virtual; + procedure DoShowScrollBar(Bar: Integer; Show: Boolean); virtual; + procedure DoStartDrag(var DragObject: TDragObject); override; + procedure DoStartOperation(OperationKind: TVTOperationKind); virtual; + procedure DoStateChange(Enter: TVirtualTreeStates; Leave: TVirtualTreeStates = []); override; + 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; + function DragDrop(const DataObject: TVTDragDataObject; KeyState: Integer; Pt: TPoint; + var Effect: Integer): HResult; reintroduce; virtual; + function DragEnter(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; virtual; + procedure DragFinished; virtual; + procedure DragLeave; virtual; + function DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint; + var Effect: Integer): HResult; reintroduce; virtual; + procedure DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension); virtual; + procedure DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: TDimension); virtual; + procedure DrawGridHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension); virtual; + procedure DrawGridVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: TDimension; pFixedColumn: Boolean = False); virtual; + procedure EndOperation(OperationKind: TVTOperationKind); + procedure EnsureNodeFocused(); virtual; + function FindNodeInSelection(P: PVirtualNode; var Index: Integer; LowBound, HighBound: Integer): Boolean; virtual; + procedure FinishChunkHeader(Stream: TStream; StartPos, EndPos: Integer); virtual; + procedure FontChanged(AFont: TObject); virtual; + function GetBorderDimensions: TSize; virtual; + function GetCheckedCount: Integer; + function GetCheckImage(Node: PVirtualNode; ImgCheckType: TCheckType = ctNone; + ImgCheckState: TCheckState = csUncheckedNormal; ImgEnabled: Boolean = True): Integer; virtual; + function GetColumnClass: TVirtualTreeColumnClass; virtual; + function GetDefaultHintKind: TVTHintKind; virtual; + function GetDoubleBuffered: Boolean; {$if CompilerVersion >= 36}override;{$ifend} + function GetHeaderClass: TVTHeaderClass; virtual; + function GetHintWindowClass: THintWindowClass; virtual; abstract; + procedure GetImageIndex(var Info: TVTPaintInfo; Kind: TVTImageKind; InfoIndex: TVTImageInfoIndex); virtual; + function GetImageSize(Node: PVirtualNode; Kind: TVTImageKind = TVTImageKind.ikNormal; Column: TColumnIndex = 0; IncludePadding: Boolean = True): TSize; virtual; + function GetNodeImageSize(Node: PVirtualNode): TSize; virtual; deprecated 'Use GetImageSize instead'; + function GetMaxRightExtend: TDimension; virtual; + procedure GetNativeClipboardFormats(var Formats: TFormatEtcArray); virtual; + function GetOperationCanceled: Boolean; + function GetOptionsClass: TTreeOptionsClass; virtual; + function GetSelectedCount(): Integer; override; + + // multicell support + function GetSelectedCellCount(): Integer; override; + + procedure HandleHotTrack(X, Y: TDimension); virtual; + procedure HandleIncrementalSearch(CharCode: Word); virtual; + procedure HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); virtual; + procedure HandleMouseDown(var Message: TWMMouse; var HitInfo: THitInfo); virtual; + procedure HandleMouseUp(var Message: TWMMouse; const HitInfo: THitInfo); virtual; + procedure HandleClickSelection(LastFocused, NewNode: PVirtualNode; Shift: TShiftState; DragPending: Boolean); + function HasImage(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex): Boolean; virtual; deprecated 'Use GetImageSize instead'; + function HasPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Pos: TPoint): Boolean; virtual; + procedure IncVisibleCount; + procedure InitChildren(Node: PVirtualNode); virtual; + procedure InitNode(Node: PVirtualNode); virtual; + procedure InternalAddFromStream(Stream: TStream; Version: Integer; Node: PVirtualNode); virtual; + function InternalAddToSelection(Node: PVirtualNode; ForceInsert: Boolean): Boolean; overload; + function InternalAddToSelection(const NewItems: TNodeArray; NewLength: Integer; + ForceInsert: Boolean): Boolean; overload; + + /// + /// Adds a cell to the existing selection + /// + /// + /// Cell to add to existing selection + /// + /// + /// + /// + /// True if added successfully, false if Cell already exists, or not added + /// + function InternalAddToCellSelection(const Cell: TVTCell; ForceInsert: Boolean): Boolean; + + /// + /// Removes a cell from the existing selection + /// + /// + /// Cell to remove from existing selection + /// + procedure InternalRemoveFromCellSelection(const Cell: TVTCell); virtual; + procedure InternalClearCellSelection; virtual; + + /// + /// + /// + /// With the current design, cell multi-selection hinges on the existing + /// toMultiSelect in addition to toExtendedFocus being present and + /// toFullRowSelect being absent. When overriding this function, + /// be sure to check that the logic is compatible with existing code + /// + /// + /// True if cell selection has been enabled, false otherwise + /// + function IsCellSelectionEnabled: Boolean; virtual; + procedure AddToCellSelection(const Cell: TVTCell; ForceInsert: Boolean); + procedure RemoveFromCellSelection(const Cell: TVTCell); + + // Internal functions do not check if cell selection is enabled, since they + // should already be performed by their wrapper functions + function InternalIsCellSelected(Node: PVirtualNode; Column: TColumnIndex): Boolean; overload; + function InternalIsCellSelected(const Cell: TVTCell): Boolean; overload; + procedure InternalSelectCells(StartCell, EndCell: TVTCell; AddOnly: Boolean); virtual; + procedure InternalUnselectCells(StartCell, EndCell: TVTCell); virtual; + + procedure ToggleCellSelection(StartCell, EndCell: TVTCell); virtual; + + procedure InternalCacheNode(Node: PVirtualNode); virtual; + procedure InternalClearSelection; virtual; + procedure InternalConnectNode(Node, Destination: PVirtualNode; Target: TBaseVirtualTree; Mode: TVTNodeAttachMode); virtual; + function InternalData(Node: PVirtualNode): Pointer; + procedure InternalDisconnectNode(Node: PVirtualNode; KeepFocus: Boolean; Reindex: Boolean = True; ParentClearing: Boolean = False); virtual; + procedure InternalSetFocusedColumn(const index : TColumnIndex); + procedure InternalRemoveFromSelection(Node: PVirtualNode); virtual; + procedure InterruptValidation(pWaitForValidationTermination: Boolean = True); + procedure InvalidateCache; + function LineWidth(): TDimension; + procedure Loaded; override; + procedure MainColumnChanged; virtual; + + // multicell support + procedure MarkCutCopyCells; override; + + procedure MarkCutCopyNodes; override; + + procedure MouseMove(Shift: TShiftState; X, Y: TDimension); override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure OriginalWMNCPaint(DC: HDC); virtual; + procedure Paint; override; + procedure PaintCheckImage(Canvas: TCanvas; const ImageInfo: TVTImageInfo; Selected: Boolean); virtual; + procedure PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean); virtual; + procedure PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect; ButtonX, + ButtonY: TDimension; BidiMode: TBiDiMode); virtual; + procedure PaintTreeLines(const PaintInfo: TVTPaintInfo; IndentSize: TDimension; const LineImage: TLineImage); virtual; + procedure PaintSelectionRectangle(Target: TCanvas; WindowOrgX: TDimension; const SelectionRect: TRect; + TargetRect: TRect); virtual; + procedure PrepareBitmaps(NeedButtons, NeedLines: Boolean); + procedure PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: TDimension); virtual; + function ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, + ChunkSize: Integer): Boolean; virtual; + procedure ReadNode(Stream: TStream; Version: Integer; Node: PVirtualNode); virtual; + procedure RedirectFontChangeEvent(Canvas: TCanvas); virtual; + procedure RemoveFromSelection(Node: PVirtualNode); virtual; + procedure UpdateNextNodeToSelect(Node: PVirtualNode); virtual; + procedure ResetRangeAnchor; virtual; + procedure RestoreFontChangeEvent(Canvas: TCanvas); virtual; + procedure SelectNodes(StartNode, EndNode: PVirtualNode; AddOnly: Boolean); virtual; + procedure SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal); virtual; + procedure SetFocusedNodeAndColumn(Node: PVirtualNode; Column: TColumnIndex); virtual; + procedure SetRangeX(value: TDimension); + procedure SetWindowTheme(const Theme: string); override; + procedure SetVisibleCount(value : Cardinal); + procedure SkipNode(Stream: TStream); virtual; + procedure StartOperation(OperationKind: TVTOperationKind); + procedure StartWheelPanning(Position: TPoint); virtual; + procedure StopTimer(ID: Integer); + procedure StopWheelPanning; virtual; + procedure StructureChange(Node: PVirtualNode; Reason: TChangeReason); virtual; + function SuggestDropEffect(Source: TObject; Shift: TShiftState; Pt: TPoint; AllowedEffects: Integer): Integer; virtual; + procedure ToggleSelection(StartNode, EndNode: PVirtualNode); virtual; + procedure TrySetFocus(); + procedure UnselectNodes(StartNode, EndNode: PVirtualNode); virtual; + procedure UpdateColumnCheckState(Col: TVirtualTreeColumn); + procedure UpdateDesigner; virtual; + procedure UpdateEditBounds; virtual; + procedure UpdateHeaderRect; virtual; + procedure UpdateStyleElements; override; + procedure ValidateCache; virtual; + procedure ValidateNodeDataSize(var Size: Integer); virtual; + procedure WndProc(var Message: TMessage); override; + procedure WriteChunks(Stream: TStream; Node: PVirtualNode); virtual; + procedure WriteNode(Stream: TStream; Node: PVirtualNode); override; + class procedure RaiseVTError(const Msg: string; HelpContext: Integer); static; + + procedure VclStyleChanged; virtual; + property VclStyleEnabled: Boolean read GetVclStyleEnabled; + property TotalInternalDataSize: Cardinal read FTotalInternalDataSize; + // Mitigator function to use the correct style service for this context (either the style assigned to the control for Delphi > 10.4 or the application style) + function StyleServices(AControl: TControl = nil): TCustomStyleServices; + property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; + property AnimationDuration: Cardinal read FAnimationDuration write SetAnimationDuration default 200; + property AutoExpandDelay: Cardinal read FAutoExpandDelay write FAutoExpandDelay default 1000; + property AutoScrollDelay: Cardinal read FAutoScrollDelay write FAutoScrollDelay default 1000; + property AutoScrollInterval: TAutoScrollInterval read FAutoScrollInterval write FAutoScrollInterval default 1; + property Background: TVTBackground read FBackground write SetBackground; + property BackGroundImageTransparent: Boolean read FBackGroundImageTransparent write SetBackGroundImageTransparent default False; + property BackgroundOffsetX: TDimension index 0 read FBackgroundOffsetX write SetBackgroundOffset stored IsStored_BackgroundOffsetXY; // default 0; + property BackgroundOffsetY: TDimension index 1 read FBackgroundOffsetY write SetBackgroundOffset stored IsStored_BackgroundOffsetXY; // default 0; + property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default TFormBorderStyle.bsSingle; + property BottomSpace: TDimension read FBottomSpace write SetBottomSpace stored IsStored_BottomSpace; //default 0; + property ButtonFillMode: TVTButtonFillMode read FButtonFillMode write SetButtonFillMode default fmTreeColor; + property ButtonStyle: TVTButtonStyle read FButtonStyle write SetButtonStyle default bsRectangle; + property ChangeDelay: Cardinal read FChangeDelay write FChangeDelay default 0; + property CheckImageKind: TCheckImageKind read FCheckImageKind write SetCheckImageKind stored False default ckSystemDefault; // deprecated, see issue #622 + property ClipboardFormats: TClipboardFormats read FClipboardFormats write SetClipboardFormats; + property Colors: TVTColors read FColors write SetColors; + property CustomCheckImages: TCustomImageList read FCustomCheckImages write SetCustomCheckImages; + property DefaultHintKind: TVTHintKind read GetDefaultHintKind; + property DefaultNodeHeight: TDimension read FDefaultNodeHeight write SetDefaultNodeHeight stored IsStored_DefaultNodeHeight; + property DefaultPasteMode: TVTNodeAttachMode read FDefaultPasteMode write FDefaultPasteMode default amAddChildLast; + property DragHeight: Integer read FDragHeight write FDragHeight default 350; + property DragImageKind: TVTDragImageKind read FDragImageKind write FDragImageKind default diComplete; + property DragOperations: TDragOperations read FDragOperations write FDragOperations default [doCopy, doMove]; + property DragSelection: TNodeArray read FDragSelection; + property LastDragEffect: Integer read FLastDragEffect; + property DragType: TVTDragType read FDragType write FDragType default dtOLE; + property DragWidth: Integer read FDragWidth write FDragWidth default 200; + property DrawSelectionMode: TVTDrawSelectionMode read FDrawSelectionMode write FDrawSelectionMode + default smDottedRectangle; + property EditColumn: TColumnIndex read FEditColumn write FEditColumn; + property EditDelay: Cardinal read FEditDelay write FEditDelay default 1000; + property EffectiveOffsetX: TDimension read FEffectiveOffsetX; + property HeaderRect: TRect read FHeaderRect; + property HintMode: TVTHintMode read FHintMode write FHintMode default hmDefault; + property HintData: TVTHintData read FHintData write FHintData; + property HotCursor: TCursor read FHotCursor write FHotCursor default crDefault; + property Images: TCustomImageList read FImages write SetImages; + property IncrementalSearch: TVTIncrementalSearch read FIncrementalSearch write SetSearchOption default isNone; + property IncrementalSearchDirection: TVTSearchDirection read FSearchDirection write FSearchDirection default sdForward; + property IncrementalSearchStart: TVTSearchStart read FSearchStart write FSearchStart default ssFocusedNode; + property IncrementalSearchTimeout: Cardinal read FSearchTimeout write FSearchTimeout default 1000; + property Indent: TDimension read FIndent write SetIndent stored IsStored_Indent; // default 18; + property LastClickPos: TPoint read FLastClickPos write FLastClickPos; + property LastDropMode: TDropMode read FLastDropMode write FLastDropMode; + property LastHintRect: TRect read FLastHintRect write FLastHintRect; + property LineMode: TVTLineMode read FLineMode write SetLineMode default lmNormal; + property LineStyle: TVTLineStyle read FLineStyle write SetLineStyle default lsDotted; + property Margin: TDimension read FMargin write SetMargin stored IsStored_Margin; // default 4; + property NextNodeToSelect: PVirtualNode read FNextNodeToSelect; // Next tree node that we would like to select if the current one gets deleted + property NodeAlignment: TVTNodeAlignment read FNodeAlignment write SetNodeAlignment default naProportional; + property NodeDataSize: Integer read FNodeDataSize write SetNodeDataSize default -1; + property OperationCanceled: Boolean read GetOperationCanceled; + property HotMinusBM: TBitmap read FHotMinusBM; + property HotPlusBM: TBitmap read FHotPlusBM; + 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: 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; + property SelectionCurveRadius: Cardinal read FSelectionCurveRadius write SetSelectionCurveRadius default 0; + property StateImages: TCustomImageList read FStateImages write SetStateImages; + property TextMargin: TDimension read FTextMargin write SetTextMargin stored IsStored_TextMargin; + property TreeOptions: TCustomVirtualTreeOptions read FOptions write SetOptions; + property WantTabs: Boolean read FWantTabs write FWantTabs default False; + property SyncCheckstateWithSelection[Node: PVirtualNode]: Boolean read GetSyncCheckstateWithSelection; + + property OnAddToSelection: TVTAddToSelectionEvent read FOnAddToSelection write FOnAddToSelection; + property OnAdvancedHeaderDraw: TVTAdvancedHeaderPaintEvent read FOnAdvancedHeaderDraw write FOnAdvancedHeaderDraw; + property OnAfterAutoFitColumn: TVTAfterAutoFitColumnEvent read FOnAfterAutoFitColumn write FOnAfterAutoFitColumn; + property OnAfterAutoFitColumns: TVTAfterAutoFitColumnsEvent read FOnAfterAutoFitColumns write FOnAfterAutoFitColumns; + property OnAfterCellPaint: TVTAfterCellPaintEvent read FOnAfterCellPaint write FOnAfterCellPaint; + property OnAfterColumnExport : TVTColumnExportEvent read FOnAfterColumnExport write FOnAfterColumnExport; + property OnAfterColumnWidthTracking: TVTAfterColumnWidthTrackingEvent read FOnAfterColumnWidthTracking write FOnAfterColumnWidthTracking; + property OnAfterGetMaxColumnWidth: TVTAfterGetMaxColumnWidthEvent read FOnAfterGetMaxColumnWidth write FOnAfterGetMaxColumnWidth; + property OnAfterHeaderExport: TVTTreeExportEvent read FOnAfterHeaderExport write FOnAfterHeaderExport; + property OnAfterHeaderHeightTracking: TVTAfterHeaderHeightTrackingEvent read FOnAfterHeaderHeightTracking + write FOnAfterHeaderHeightTracking; + property OnAfterItemErase: TVTAfterItemEraseEvent read FOnAfterItemErase write FOnAfterItemErase; + property OnAfterItemPaint: TVTAfterItemPaintEvent read FOnAfterItemPaint write FOnAfterItemPaint; + property OnAfterNodeExport: TVTNodeExportEvent read FOnAfterNodeExport write FOnAfterNodeExport; + property OnAfterPaint: TVTPaintEvent read FOnAfterPaint write FOnAfterPaint; + property OnAfterTreeExport: TVTTreeExportEvent read FOnAfterTreeExport write FOnAfterTreeExport; + property OnBeforeAutoFitColumn: TVTBeforeAutoFitColumnEvent read FOnBeforeAutoFitColumn write FOnBeforeAutoFitColumn; + property OnBeforeAutoFitColumns: TVTBeforeAutoFitColumnsEvent read FOnBeforeAutoFitColumns write FOnBeforeAutoFitColumns; + property OnBeforeCellPaint: TVTBeforeCellPaintEvent read FOnBeforeCellPaint write FOnBeforeCellPaint; + property OnBeforeColumnExport: TVTColumnExportEvent read FOnBeforeColumnExport write FOnBeforeColumnExport; + property OnBeforeColumnWidthTracking: TVTBeforeColumnWidthTrackingEvent read FOnBeforeColumnWidthTracking + write FOnBeforeColumnWidthTracking; + property OnBeforeDrawTreeLine: TVTBeforeDrawLineImageEvent read FOnBeforeDrawLineImage write FOnBeforeDrawLineImage; + property OnBeforeGetMaxColumnWidth: TVTBeforeGetMaxColumnWidthEvent read FOnBeforeGetMaxColumnWidth write FOnBeforeGetMaxColumnWidth; + property OnBeforeHeaderExport: TVTTreeExportEvent read FOnBeforeHeaderExport write FOnBeforeHeaderExport; + property OnBeforeHeaderHeightTracking: TVTBeforeHeaderHeightTrackingEvent read FOnBeforeHeaderHeightTracking + write FOnBeforeHeaderHeightTracking; + property OnBeforeItemErase: TVTBeforeItemEraseEvent read FOnBeforeItemErase write FOnBeforeItemErase; + property OnBeforeItemPaint: TVTBeforeItemPaintEvent read FOnBeforeItemPaint write FOnBeforeItemPaint; + property OnBeforeNodeExport: TVTNodeExportEvent read FOnBeforeNodeExport write FOnBeforeNodeExport; + property OnBeforePaint: TVTPaintEvent read FOnBeforePaint write FOnBeforePaint; + property OnBeforeTreeExport: TVTTreeExportEvent read FOnBeforeTreeExport write FOnBeforeTreeExport; + property OnCanSplitterResizeColumn: TVTCanSplitterResizeColumnEvent read FOnCanSplitterResizeColumn write FOnCanSplitterResizeColumn; + property OnCanSplitterResizeHeader: TVTCanSplitterResizeHeaderEvent read FOnCanSplitterResizeHeader write FOnCanSplitterResizeHeader; + property OnCanSplitterResizeNode: TVTCanSplitterResizeNodeEvent read FOnCanSplitterResizeNode write FOnCanSplitterResizeNode; + property OnChange: TVTChangeEvent read FOnChange write FOnChange; + + /// + /// Notifies that the selected cells have changed. Cells can be empty + /// + /// + /// Multiple events might be fired for the same selection + /// Do not assume that only 1 cell change event will be fired for the same + /// cell change + /// + property OnChangeCell: TVTChangeCellEvent read FOnChangeCell write FOnChangeCell; + property OnChecked: TVTChangeEvent read FOnChecked write FOnChecked; + property OnChecking: TVTCheckChangingEvent read FOnChecking write FOnChecking; + property OnCollapsed: TVTChangeEvent read FOnCollapsed write FOnCollapsed; + property OnCollapsing: TVTChangingEvent read FOnCollapsing write FOnCollapsing; + property OnColumnChecked: TVTHeaderNotifyEvent read FOnColumnChecked write FOnColumnChecked; + property OnColumnChecking: TVTColumnCheckChangingEvent read FOnColumnChecking write FOnColumnChecking; + property OnColumnClick: TVTColumnClickEvent read FOnColumnClick write FOnColumnClick; + property OnColumnDblClick: TVTColumnDblClickEvent read FOnColumnDblClick write FOnColumnDblClick; + property OnColumnExport : TVTColumnExportEvent read FOnColumnExport write FOnColumnExport; + property OnColumnResize: TVTHeaderNotifyEvent read FOnColumnResize write FOnColumnResize; + property OnColumnVisibilityChanged: TColumnChangeEvent read fOnColumnVisibilityChanged write fOnColumnVisibilityChanged; + property OnColumnWidthDblClickResize: TVTColumnWidthDblClickResizeEvent read FOnColumnWidthDblClickResize + write FOnColumnWidthDblClickResize; + property OnColumnWidthTracking: TVTColumnWidthTrackingEvent read FOnColumnWidthTracking write FOnColumnWidthTracking; + property OnCompareNodes: TVTCompareEvent read FOnCompareNodes write FOnCompareNodes; + property OnCreateDataObject: TVTCreateDataObjectEvent read FOnCreateDataObject write FOnCreateDataObject; + property OnCreateDragManager: TVTCreateDragManagerEvent read FOnCreateDragManager write FOnCreateDragManager; + property OnCreateEditor: TVTCreateEditorEvent read FOnCreateEditor write FOnCreateEditor; + property OnDragAllowed: TVTDragAllowedEvent read FOnDragAllowed write FOnDragAllowed; + property OnDragOver: TVTDragOverEvent read FOnDragOver write FOnDragOver; + property OnDragDrop: TVTDragDropEvent read FOnDragDrop write FOnDragDrop; + property OnDrawHint: TVTDrawHintEvent read FOnDrawHint write FOnDrawHint; + property OnEditCancelled: TVTEditCancelEvent read FOnEditCancelled write FOnEditCancelled; + property OnEditing: TVTEditChangingEvent read FOnEditing write FOnEditing; + property OnEdited: TVTEditChangeEvent read FOnEdited write FOnEdited; + property OnEndOperation: TVTOperationEvent read FOnEndOperation write FOnEndOperation; + property OnExpanded: TVTChangeEvent read FOnExpanded write FOnExpanded; + property OnExpanding: TVTChangingEvent read FOnExpanding write FOnExpanding; + property OnFocusChanged: TVTFocusChangeEvent read FOnFocusChanged write FOnFocusChanged; + property OnFocusChanging: TVTFocusChangingEvent read FOnFocusChanging write FOnFocusChanging; + property OnFreeNode: TVTFreeNodeEvent read FOnFreeNode write FOnFreeNode; + property OnGetCellIsEmpty: TVTGetCellIsEmptyEvent read FOnGetCellIsEmpty write FOnGetCellIsEmpty; + property OnGetCursor: TVTGetCursorEvent read FOnGetCursor write FOnGetCursor; + property OnGetHeaderCursor: TVTGetHeaderCursorEvent read FOnGetHeaderCursor write FOnGetHeaderCursor; + property OnGetHelpContext: TVTHelpContextEvent read FOnGetHelpContext write FOnGetHelpContext; + property OnGetHintSize: TVTGetHintSizeEvent read FOnGetHintSize write + FOnGetHintSize; + property OnGetHintKind: TVTHintKindEvent read FOnGetHintKind write + FOnGetHintKind; + property OnGetImageIndex: TVTGetImageEvent read FOnGetImage write FOnGetImage; + property OnGetImageIndexEx: TVTGetImageExEvent read FOnGetImageEx write FOnGetImageEx; + property OnGetImageText: TVTGetImageTextEvent read FOnGetImageText write FOnGetImageText; + property OnGetLineStyle: TVTGetLineStyleEvent read FOnGetLineStyle write FOnGetLineStyle; + property OnGetNodeDataSize: TVTGetNodeDataSizeEvent read FOnGetNodeDataSize write FOnGetNodeDataSize; + property OnGetPopupMenu: TVTPopupEvent read FOnGetPopupMenu write FOnGetPopupMenu; + property OnGetUserClipboardFormats: TVTGetUserClipboardFormatsEvent read FOnGetUserClipboardFormats + write FOnGetUserClipboardFormats; + property OnHeaderAddPopupItem: TVTHeaderAddPopupItemEvent read FOnHeaderAddPopupItem write FOnHeaderAddPopupItem; + property OnHeaderClick: TVTHeaderClickEvent read FOnHeaderClick write FOnHeaderClick; + property OnHeaderDblClick: TVTHeaderClickEvent read FOnHeaderDblClick write FOnHeaderDblClick; + property OnHeaderDragged: TVTHeaderDraggedEvent read FOnHeaderDragged write FOnHeaderDragged; + property OnHeaderDraggedOut: TVTHeaderDraggedOutEvent read FOnHeaderDraggedOut write FOnHeaderDraggedOut; + property OnHeaderDragging: TVTHeaderDraggingEvent read FOnHeaderDragging write FOnHeaderDragging; + property OnHeaderDraw: TVTHeaderPaintEvent read FOnHeaderDraw write FOnHeaderDraw; + property OnHeaderDrawQueryElements: TVTHeaderPaintQueryElementsEvent read FOnHeaderDrawQueryElements + write FOnHeaderDrawQueryElements; + property OnHeaderHeightTracking: TVTHeaderHeightTrackingEvent read FOnHeaderHeightTracking + write FOnHeaderHeightTracking; + property OnHeaderHeightDblClickResize: TVTHeaderHeightDblClickResizeEvent read FOnHeaderHeightDblClickResize + write FOnHeaderHeightDblClickResize; + property OnHeaderMouseDown: TVTHeaderMouseEvent read FOnHeaderMouseDown write FOnHeaderMouseDown; + property OnHeaderMouseMove: TVTHeaderMouseMoveEvent read FOnHeaderMouseMove write FOnHeaderMouseMove; + property OnHeaderMouseUp: TVTHeaderMouseEvent read FOnHeaderMouseUp write FOnHeaderMouseUp; + property OnHotChange: TVTHotNodeChangeEvent read FOnHotChange write FOnHotChange; + property OnIncrementalSearch: TVTIncrementalSearchEvent read FOnIncrementalSearch write FOnIncrementalSearch; + property OnInitChildren: TVTInitChildrenEvent read FOnInitChildren write FOnInitChildren; + property OnInitNode: TVTInitNodeEvent read FOnInitNode write FOnInitNode; + property OnKeyAction: TVTKeyActionEvent read FOnKeyAction write FOnKeyAction; + property OnLoadNode: TVTSaveNodeEvent read FOnLoadNode write FOnLoadNode; + property OnLoadTree: TVTSaveTreeEvent read FOnLoadTree write FOnLoadTree; + property OnMeasureItem: TVTMeasureItemEvent read FOnMeasureItem write FOnMeasureItem; + property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; + property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave; + property OnNodeClick: TVTNodeClickEvent read FOnNodeClick write FOnNodeClick; + property OnNodeCopied: TVTNodeCopiedEvent read FOnNodeCopied write FOnNodeCopied; + property OnNodeCopying: TVTNodeCopyingEvent read FOnNodeCopying write FOnNodeCopying; + property OnNodeDblClick: TVTNodeClickEvent read FOnNodeDblClick write FOnNodeDblClick; + property OnNodeExport: TVTNodeExportEvent read FOnNodeExport write FOnNodeExport; + property OnNodeHeightTracking: TVTNodeHeightTrackingEvent read FOnNodeHeightTracking write FOnNodeHeightTracking; + property OnNodeHeightDblClickResize: TVTNodeHeightDblClickResizeEvent read FOnNodeHeightDblClickResize + write FOnNodeHeightDblClickResize; + property OnNodeMoved: TVTNodeMovedEvent read FOnNodeMoved write FOnNodeMoved; + property OnNodeMoving: TVTNodeMovingEvent read FOnNodeMoving write FOnNodeMoving; + property OnPaintBackground: TVTBackgroundPaintEvent read FOnPaintBackground write FOnPaintBackground; + property OnPaintText: TVTPaintText read FOnPaintText write FOnPaintText; + property OnPrepareButtonBitmaps : TVTPrepareButtonImagesEvent read FOnPrepareButtonImages write SetOnPrepareButtonImages; + property OnRemoveFromSelection: TVTRemoveFromSelectionEvent read FOnRemoveFromSelection write FOnRemoveFromSelection; + property OnResetNode: TVTChangeEvent read FOnResetNode write FOnResetNode; + property OnSaveNode: TVTSaveNodeEvent read FOnSaveNode write FOnSaveNode; + property OnSaveTree: TVTSaveTreeEvent read FOnSaveTree write FOnSaveTree; + property OnScroll: TVTScrollEvent read FOnScroll write FOnScroll; + property OnShowScrollBar: TVTScrollBarShowEvent read FOnShowScrollBar write FOnShowScrollBar; + property OnBeforeGetCheckState: TVTBeforeGetCheckStateEvent read FOnBeforeGetCheckState write FOnBeforeGetCheckState; + property OnStartOperation: TVTOperationEvent read FOnStartOperation write FOnStartOperation; + 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; + function AbsoluteIndex(Node: PVirtualNode): Cardinal; + function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; overload; virtual; + function AddChild(Parent: PVirtualNode; const UserData: IInterface): PVirtualNode; overload; + function AddChild(Parent: PVirtualNode; const UserData: TObject): PVirtualNode; overload; + procedure AddFromStream(Stream: TStream; TargetNode: PVirtualNode); + procedure AddToSelection(Node: PVirtualNode; NotifySynced: Boolean); overload; virtual; + procedure AfterConstruction; override; + procedure Assign(Source: TPersistent); override; + procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1); + procedure BeginSynch; + procedure BeginUpdate; virtual; + procedure CancelCutOrCopy; + function CancelEditNode: Boolean; + procedure CancelOperation; + function CanEdit(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; + function CanFocus: Boolean; override; + procedure Clear; virtual; + procedure ClearChecked; + procedure ClearSelection(); overload; inline; + function CopyTo(Source: PVirtualNode; Tree: TBaseVirtualTree; Mode: TVTNodeAttachMode; + ChildrenOnly: Boolean): PVirtualNode; overload; + function CopyTo(Source, Target: PVirtualNode; Mode: TVTNodeAttachMode; + ChildrenOnly: Boolean): PVirtualNode; overload; + procedure CutToClipboard(); override; + procedure DeleteChildren(Node: PVirtualNode; ResetHasChildren: Boolean = False); + procedure DeleteNode(Node: PVirtualNode; pReIndex: Boolean = True); overload; inline; + procedure DeleteNodes(const pNodes: TNodeArray); + procedure DeleteSelectedNodes; virtual; + function Dragging: Boolean; + procedure DrawGridLine(Canvas: TCanvas; R: TRect); virtual; + function EditNode(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; + function EndEditNode: Boolean; + procedure EndSynch; + procedure EndUpdate; virtual; + procedure EnsureNodeSelected(pAfterDeletion: Boolean); virtual; + function ExecuteAction(Action: TBasicAction): Boolean; override; + procedure FinishCutOrCopy; + procedure FlushClipboard; + procedure FullCollapse(Node: PVirtualNode = nil); virtual; + procedure FullExpand(Node: PVirtualNode = nil); virtual; + function GetControlsAlignment: TAlignment; override; + function GetDisplayRect(Node: PVirtualNode; Column: TColumnIndex; TextOnly: Boolean; Unclipped: Boolean = False; + ApplyCellContentMargin: Boolean = False): TRect; + function GetEffectivelyFiltered(Node: PVirtualNode): Boolean; + function GetEffectivelyVisible(Node: PVirtualNode): Boolean; + function GetFirst(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetFirstChecked(State: TCheckState = csCheckedNormal; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetFirstChild(Node: PVirtualNode): PVirtualNode; + function GetFirstChildNoInit(Node: PVirtualNode): PVirtualNode; + function GetFirstCutCopy(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetFirstInitialized(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetFirstLeaf: PVirtualNode; + function GetFirstLevel(NodeLevel: Cardinal): PVirtualNode; + function GetFirstNoInit(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetFirstSelected(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetFirstVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeFiltered: Boolean = False): PVirtualNode; + function GetFirstVisibleChild(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + function GetFirstVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + function GetFirstVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeFiltered: Boolean = False): PVirtualNode; + procedure GetHitTestInfoAt(X, Y: TDimension; Relative: Boolean; var HitInfo: THitInfo; ShiftState: TShiftState=[]); virtual; + function GetLast(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetLastInitialized(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetLastNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetLastChild(Node: PVirtualNode): PVirtualNode; + function GetLastChildNoInit(Node: PVirtualNode): PVirtualNode; + function GetLastSelected(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetLastVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeFiltered: Boolean = False): PVirtualNode; + function GetLastVisibleChild(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + function GetLastVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + function GetLastVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeFiltered: Boolean = False): PVirtualNode; + function GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): TDimension; virtual; + function GetNext(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetNextChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; + ConsiderChildrenAbove: Boolean = False): PVirtualNode; overload; + function GetNextChecked(Node: PVirtualNode; ConsiderChildrenAbove: Boolean): PVirtualNode; overload; + function GetNextCutCopy(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetNextInitialized(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetNextLeaf(Node: PVirtualNode): PVirtualNode; + function GetNextLevel(Node: PVirtualNode; NodeLevel: Cardinal): PVirtualNode; + function GetNextNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetNextSelected(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetNextSibling(Node: PVirtualNode): PVirtualNode; + function GetNextSiblingNoInit(Node: PVirtualNode): PVirtualNode; + function GetNextVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; + function GetNextVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; + function GetNextVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + function GetNextVisibleSiblingNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + function GetNodeAt(const P: TPoint): PVirtualNode; overload; inline; + function GetNodeAt(X, Y: TDimension): PVirtualNode; overload; + function GetNodeAt(X, Y: TDimension; Relative: Boolean; var NodeTop: TDimension): PVirtualNode; overload; + function GetNodeData(Node: PVirtualNode): Pointer; overload; + function GetNodeData(pNode: PVirtualNode): T; overload; inline; + function GetSelectedData(): TArray; overload; + function GetInterfaceFromNodeData(pNode: PVirtualNode): T; overload; inline; + function GetNodeDataAt(pXCoord: Integer; pYCoord: Integer): T; + function GetFirstSelectedNodeData(): T; + function GetNodeLevel(Node: PVirtualNode): Cardinal; + function GetNodeLevelForSelectConstraint(Node: PVirtualNode): integer; + function GetOffset(pElement: TVTElement; pNode: PVirtualNode): TDimension; + procedure GetOffsets(pNode: PVirtualNode; out pOffsets: TVTOffsets; pElement: TVTElement = TVTElement.ofsEndOfClientArea; pColumn: Integer = NoColumn); + function GetPrevious(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetPreviousChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; + ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetPreviousCutCopy(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetPreviousInitialized(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetPreviousLeaf(Node: PVirtualNode): PVirtualNode; + function GetPreviousLevel(Node: PVirtualNode; NodeLevel: Cardinal): PVirtualNode; + function GetPreviousNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetPreviousSelected(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + function GetPreviousSibling(Node: PVirtualNode): PVirtualNode; + function GetPreviousSiblingNoInit(Node: PVirtualNode): PVirtualNode; + function GetPreviousVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; + function GetPreviousVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; + function GetPreviousVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + function GetPreviousVisibleSiblingNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + function GetSortedCutCopySet(Resolve: Boolean): TNodeArray; override; + function GetSortedSelection(Resolve: Boolean): TNodeArray; override; + procedure GetTextInfo(Node: PVirtualNode; Column: TColumnIndex; const AFont: TFont; var R: TRect; + 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); + procedure InvalidateColumn(Column: TColumnIndex); + function InvalidateNode(Node: PVirtualNode): TRect; virtual; + procedure InvalidateToBottom(Node: PVirtualNode); + procedure InvertSelection(VisibleOnly: Boolean); + function IsEditing: Boolean; + function IsMouseSelecting: Boolean; + function IsEmpty: Boolean; inline; + function IsUpdating(): Boolean; + 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; + procedure MeasureItemHeight(const Canvas: TCanvas; Node: PVirtualNode); virtual; + procedure MoveTo(Source, Target: PVirtualNode; Mode: TVTNodeAttachMode; ChildrenOnly: Boolean); overload; + procedure MoveTo(Node: PVirtualNode; Tree: TBaseVirtualTree; Mode: TVTNodeAttachMode; + ChildrenOnly: Boolean); overload; + procedure PaintTree(TargetCanvas: TCanvas; Window: TRect; Target: TPoint; PaintOptions: TVTInternalPaintOptions; + PixelFormat: TPixelFormat = pfDevice); virtual; + procedure PrepareDragImage(HotSpot: TPoint; const DataObject: TVTDragDataObject); + procedure Print(Printer: TPrinter; PrintHeader: Boolean); + function ProcessDrop(const DataObject: TVTDragDataObject; TargetNode: PVirtualNode; var Effect: Integer; Mode: + TVTNodeAttachMode): Boolean; + function ProcessOLEData(Source: TBaseVirtualTree; const DataObject: IDataObject; TargetNode: PVirtualNode; + Mode: TVTNodeAttachMode; Optimized: Boolean): Boolean; + procedure RepaintNode(Node: PVirtualNode); + procedure ReinitChildren(Node: PVirtualNode; Recursive: Boolean; ForceReinit: Boolean = False); virtual; + procedure InitRecursive(Node: PVirtualNode; Levels: Cardinal = MaxInt; pVisibleOnly: Boolean = True); + procedure ReinitNode(Node: PVirtualNode; Recursive: Boolean; ForceReinit: Boolean = False); virtual; + procedure ResetNode(Node: PVirtualNode); virtual; + procedure SaveToFile(const FileName: TFileName); + procedure SaveToStream(Stream: TStream; Node: PVirtualNode = nil); virtual; + function ScaledPixels(pPixels: TDimension): TDimension; + procedure ScaleNodeHeights(M, D: TDimension); + function ScrollIntoView(Node: PVirtualNode; Center: Boolean; Horizontally: Boolean = False): Boolean; overload; + function ScrollIntoView(Column: TColumnIndex; Center: Boolean; Node: PVirtualNode = nil): Boolean; overload; + procedure SelectAll(VisibleOnly: Boolean); + procedure SetCheckStateForAll(aCheckState: TCheckState; pSelectedOnly: Boolean; pExcludeDisabled: Boolean = True); + procedure SetNodeData(pNode: PVirtualNode; pUserData: Pointer); overload; inline; + procedure SetNodeData(pNode: PVirtualNode; const pUserData: IInterface); overload; inline; + procedure SetNodeData(pNode: PVirtualNode; pUserData: T); overload; + procedure Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); override; + procedure SortTree(Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; + procedure ToggleNode(Node: PVirtualNode); + procedure UpdateHorizontalRange; virtual; + procedure UpdateHorizontalScrollBar(DoRepaint: Boolean); + procedure UpdateRanges; + procedure UpdateScrollBars(DoRepaint: Boolean); virtual; + procedure UpdateVerticalRange; + procedure UpdateVerticalScrollBar(DoRepaint: Boolean); + function UseRightToLeftReading: Boolean; + procedure ValidateChildren(Node: PVirtualNode; Recursive: Boolean); + procedure ValidateNode(Node: PVirtualNode; Recursive: Boolean); + + { Multiple cell selection / multicell } + /// + /// Clears the currently selected cells. + /// + procedure ClearCellSelection; + + /// + /// Determines whether the specified cell is selected. + /// + /// + /// The node containing the cell to test. + /// + /// + /// The column index of the cell to test. + /// + /// + /// True if the specified cell is selected; otherwise, False. + /// + function IsCellSelected(Node: PVirtualNode; Column: TColumnIndex): Boolean; + + /// + /// Selects a rectangular range of cells. + /// + /// + /// The node where the selection starts. + /// + /// + /// The column index where the selection starts. + /// + /// + /// The node where the selection ends. + /// + /// + /// The column index where the selection ends. + /// + /// + /// If True, adds the range to the existing selection without clearing it. + /// + procedure SelectCells(StartNode: PVirtualNode; StartColumn: + TColumnIndex; EndNode: PVirtualNode; EndColumn: TColumnIndex; AddOnly: Boolean); overload; + + procedure SelectCells(const StartCell, EndCell: TVTCell; AddOnly: Boolean); overload; + + /// + /// Unselects the rectangular range of cells specified by the rest of the + /// parameters + /// + /// + /// The node where the selection starts. + /// + /// + /// The column index where the selection starts. + /// + /// + /// The node where the selection ends. + /// + /// + /// The column index where the selection ends. + /// + procedure UnselectCells(StartNode: PVirtualNode; StartColumn: TColumnIndex; + EndNode: PVirtualNode; EndColumn: TColumnIndex); + + { Enumerations } + function Nodes(ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; + function CheckedNodes(State: TCheckState = csCheckedNormal; ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; + function ChildNodes(Node: PVirtualNode): TVTVirtualNodeEnumeration; + function CutCopyNodes(ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; + function InitializedNodes(ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; + function LeafNodes: TVTVirtualNodeEnumeration; + function LevelNodes(NodeLevel: Cardinal): TVTVirtualNodeEnumeration; + function NoInitNodes(ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; + function SelectedCells: TVTCellArray; // multicell support + function SelectedNodes(ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; + function VisibleNodes(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeFiltered: Boolean = False): TVTVirtualNodeEnumeration; + function VisibleChildNodes(Node: PVirtualNode; IncludeFiltered: Boolean = False): TVTVirtualNodeEnumeration; + function VisibleChildNoInitNodes(Node: PVirtualNode; IncludeFiltered: Boolean = False): TVTVirtualNodeEnumeration; + function VisibleNoInitNodes(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeFiltered: Boolean = False): TVTVirtualNodeEnumeration; + property BottomNode: PVirtualNode read GetBottomNode write SetBottomNode; + property CheckedCount: Integer read GetCheckedCount; + property CheckImages: TCustomImageList read FCheckImages; + property CheckState[Node: PVirtualNode]: TCheckState read GetCheckState write SetCheckState; + property CheckType[Node: PVirtualNode]: TCheckType read GetCheckType write SetCheckType; + property ChildCount[Node: PVirtualNode]: Cardinal read GetChildCount write SetChildCount; + property ChildrenInitialized[Node: PVirtualNode]: Boolean read GetChildrenInitialized; + property CutCopyCount: Integer read GetCutCopyCount; + property DragManager: IVTDragManager read GetDragManager; + property DropTargetNode: PVirtualNode read FDropTargetNode write FDropTargetNode; + property EditLink: IVTEditLink read FEditLink; + property EmptyListMessage: string read FEmptyListMessage write SetEmptyListMessage; + property Expanded[Node: PVirtualNode]: Boolean read GetExpanded write SetExpanded; + property FocusedColumn: TColumnIndex read FFocusedColumn write SetFocusedColumn default InvalidColumn; + property FocusedNode: PVirtualNode read FFocusedNode write SetFocusedNode; + property Font; + property FullyVisible[Node: PVirtualNode]: Boolean read GetFullyVisible write SetFullyVisible; + property HasChildren[Node: PVirtualNode]: Boolean read GetHasChildren write SetHasChildren; + property Header: TVTHeader read FHeader write SetHeader; + property HotNode: PVirtualNode read FCurrentHotNode write SetHotNode; + property HotColumn: TColumnIndex read FCurrentHotColumn; + property IsDisabled[Node: PVirtualNode]: Boolean read GetDisabled write SetDisabled; + property IsEffectivelyFiltered[Node: PVirtualNode]: Boolean read GetEffectivelyFiltered; + property IsEffectivelyVisible[Node: PVirtualNode]: Boolean read GetEffectivelyVisible; + 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]: 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; + property OffsetY: TDimension read FOffsetY write SetOffsetY; + property OperationCount: Cardinal read FOperationCount; + property RootNode: PVirtualNode read FRoot; + property SearchBuffer: string read FSearchBuffer; + property Selected[Node: PVirtualNode]: Boolean read GetSelected write SetSelected; + property SelectionLocked: Boolean read FSelectionLocked write FSelectionLocked; + property TotalCount: Cardinal read GetTotalCount; + property TreeStates: TVirtualTreeStates read FStates write FStates; + property SelectedCount: Integer read FSelectionCount; + property TopNode: PVirtualNode read GetTopNode write SetTopNode; + property VerticalAlignment[Node: PVirtualNode]: Byte read GetVerticalAlignment write SetVerticalAlignment; + property VisibleCount: Cardinal read FVisibleCount; + property VisiblePath[Node: PVirtualNode]: Boolean read GetVisiblePath write SetVisiblePath; + property UpdateCount: Cardinal read FUpdateCount; + property DoubleBuffered: Boolean read GetDoubleBuffered write SetDoubleBuffered default True; + end; + + TVTDrawNodeEvent = procedure(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo) of object; + TVTGetCellContentMarginEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; + Column: TColumnIndex; CellContentMarginType: TVTCellContentMarginType; var CellContentMargin: TPoint) of object; + TVTGetNodeWidthEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; + Column: TColumnIndex; var NodeWidth: TDimension) of object; + + +// utility routines +function TreeFromNode(Node: PVirtualNode): TBaseVirtualTree; + + +//---------------------------------------------------------------------------------------------------------------------- + +implementation + +uses + Winapi.MMSystem, // for animation timer (does not include further resources) + System.Math, + System.SyncObjs, + System.StrUtils, + Vcl.Clipbrd, + Vcl.Consts, + Vcl.ExtCtrls, + Vcl.AxCtrls, // TOLEStream + Vcl.StdActns, // for standard action support + Vcl.GraphUtil, // accessibility helper class + VirtualTrees.StyleHooks, + VirtualTrees.WorkerThread, + VirtualTrees.ClipBoard, + VirtualTrees.Utils, + VirtualTrees.DragnDrop; + +resourcestring + // Localizable strings. + SEditLinkIsNil = 'Edit link must not be nil.'; + SWrongMoveError = 'Target node cannot be a child node of the node to be moved.'; + SWrongStreamFormat = 'Unable to load tree structure, the format is wrong.'; + SWrongStreamVersion = 'Unable to load tree structure, the version is unknown.'; + SStreamTooSmall = 'Unable to load tree structure, not enough data available.'; + SCorruptStream1 = 'Stream data corrupt. A node''s anchor chunk is missing.'; + SCorruptStream2 = 'Stream data corrupt. Unexpected data after node''s end position.'; + +const + ClipboardStates = [tsCopyPending, tsCutPending]; + DefaultScrollUpdateFlags = [suoRepaintHeader, suoRepaintScrollBars, suoScrollClientArea, suoUpdateNCArea]; + TreeNodeSize = (SizeOf(TVirtualNode) + (SizeOf(Pointer) - 1)) and not (SizeOf(Pointer) - 1); // used for node allocation and access to internal data + /// Default value of the DefaultText property + MouseButtonDown = [tsLeftButtonDown, tsMiddleButtonDown, tsRightButtonDown]; + + // Do not modify the copyright in any way! Usage of this unit is prohibited without the copyright notice + // in the compiled binary file. + Copyright: string = 'Virtual Treeview © 1999-2021 Mike Lischke, Joachim Marder'; + + + +type + //These allow us access to protected members in the classes + TVirtualTreeColumnsCracker = class(TVirtualTreeColumns); + TVTHeaderCracker = class(TVTHeader); + TVirtualTreeColumnCracker = class(TVirtualTreeColumn); + TBaseVirtualTreeCracker = class(TBaseVirtualTree); + + // streaming support + TMagicID = array[0..5] of WideChar; + + // base information about a node + TBaseChunkBody = packed record + ChildCount: Cardinal; + NodeHeight: TDimension; + States: TVirtualNodeStates; + Align: Byte; + CheckState: TCheckState; + CheckType: TCheckType; + Reserved: Cardinal; + end; + + TBaseChunk = packed record + Header: TChunkHeader; + Body: TBaseChunkBody; + end; + + // Toggle animation modes. + TToggleAnimationMode = ( + tamScrollUp, + tamScrollDown, + tamNoScroll + ); + + // Internally used data for animations. + TToggleAnimationData = record + Window: HWND; // copy of the tree's window handle + DC: TControlCanvas; // the DC of the window to erase uncovered parts + Brush: TBrush; // the brush to be used to erase uncovered parts + R1, + R2: TRect; // animation rectangles + Mode1, + Mode2: TToggleAnimationMode; // animation modes + ScaleFactor: Double; // the factor between the missing step size when doing two animations + MissedSteps: Double; + end; + + +const + MagicID: TMagicID = (#$2045, 'V', 'T', WideChar(VTTreeStreamVersion), ' ', #$2046); + +var + gWatcher: TCriticalSection = nil; + gInitialized: Integer = 0; // >0 if global structures have been initialized; otherwise 0 + NeedToUnitialize: Boolean = False; // True if the OLE subsystem could be initialized successfully. + +//---------------------------------------------------------------------------------------------------------------------- + +function TreeFromNode(Node: PVirtualNode): TBaseVirtualTree; + +// Returns the tree the node currently belongs to or nil if the node is not attached to a tree. + +begin + Assert(Assigned(Node), 'Node must not be nil.'); + + // The root node is marked by having its NextSibling (and PrevSibling) pointing to itself. + while Assigned(Node) and (Node.NextSibling <> Node) do + Node := Node.Parent; + if Assigned(Node) then + Result := TBaseVirtualTree(Node.Parent) + else + Result := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SelectCells(StartNode: PVirtualNode; StartColumn: TColumnIndex; EndNode: PVirtualNode; EndColumn: TColumnIndex; AddOnly: Boolean); +var + S, E: TVTCell; +begin + S := TVTCell.Create(StartNode, StartColumn); + E := TVTCell.Create(EndNode, EndColumn); + SelectCells(S, E, AddOnly); +end; + +procedure TBaseVirtualTree.SelectCells(const StartCell, EndCell: TVTCell; AddOnly: Boolean); +begin + InternalSelectCells(StartCell, EndCell, AddOnly); + ChangeCell(FSelectedCells); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UnselectCells(StartNode: PVirtualNode; StartColumn: TColumnIndex; EndNode: PVirtualNode; EndColumn: TColumnIndex); +var + S, E: TVTCell; +begin + S := TVTCell.Create(StartNode, StartColumn); + E := TVTCell.Create(EndNode, EndColumn); + InternalUnselectCells(S, E); + ChangeCell(FSelectedCells); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ClearCellSelection; +begin + InternalClearCellSelection; + ChangeCell([]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsCellSelected(Node: PVirtualNode; Column: TColumnIndex): Boolean; +begin + Result := InternalIsCellSelected(Node, Column); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure QuickSort(const TheArray: TNodeArray; L, R: Integer); + +var + I, J: Integer; + P, T: Pointer; + +begin + repeat + I := L; + J := R; + P := TheArray[(L + R) shr 1]; + repeat + while PAnsiChar(TheArray[I]) < PAnsiChar(P) do + System.Inc(I); + while PAnsiChar(TheArray[J]) > PAnsiChar(P) do + System.Dec(J); + if I <= J then + begin + T := TheArray[I]; + TheArray[I] := TheArray[J]; + TheArray[J] := T; + System.Inc(I); + System.Dec(J); + end; + until I > J; + if L < J then + QuickSort(TheArray, L, J); + L := I; + until I >= R; +end; + +//----------------- TVTVirtualNodeEnumerator --------------------------------------------------------------------------- + +function TVTVirtualNodeEnumerator.GetCurrent: PVirtualNode; + +begin + Result := FNode; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTVirtualNodeEnumerator.MoveNext: Boolean; + +begin + Result := FCanMoveNext; + if Result then + begin + FNode := FEnumeration.GetNext(FNode); + Result := FNode <> nil; + FCanMoveNext := Result; + end; +end; + +//----------------- TVTVirtualNodeEnumeration -------------------------------------------------------------------------- + +function TVTVirtualNodeEnumeration.GetEnumerator: TVTVirtualNodeEnumerator; + +begin + Result.FNode := nil; + Result.FCanMoveNext := True; + Result.FEnumeration := @Self; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTVirtualNodeEnumeration.GetNext(Node: PVirtualNode): PVirtualNode; +begin + case FMode of + vneAll: + if Node = nil then + Result := FTree.GetFirst(FConsiderChildrenAbove) + else + Result := FTree.GetNext(Node, FConsiderChildrenAbove); + + vneChecked: + if Node = nil then + Result := FTree.GetFirstChecked(FState, FConsiderChildrenAbove) + else + Result := FTree.GetNextChecked(Node, FState, FConsiderChildrenAbove); + + vneChild: + if Node = nil then + Result := FTree.GetFirstChild(FNode) + else + Result := FTree.GetNextSibling(Node); + + vneCutCopy: + if Node = nil then + Result := FTree.GetFirstCutCopy(FConsiderChildrenAbove) + else + Result := FTree.GetNextCutCopy(Node, FConsiderChildrenAbove); + + vneInitialized: + if Node = nil then + Result := FTree.GetFirstInitialized(FConsiderChildrenAbove) + else + Result := FTree.GetNextInitialized(Node, FConsiderChildrenAbove); + + vneLeaf: + if Node = nil then + Result := FTree.GetFirstLeaf + else + Result := FTree.GetNextLeaf(Node); + + vneLevel: + if Node = nil then + Result := FTree.GetFirstLevel(FNodeLevel) + else + Result := FTree.GetNextLevel(Node, FNodeLevel); + + vneNoInit: + if Node = nil then + Result := FTree.GetFirstNoInit(FConsiderChildrenAbove) + else + Result := FTree.GetNextNoInit(Node, FConsiderChildrenAbove); + + vneSelected: + if Node = nil then + Result := FTree.GetFirstSelected(FConsiderChildrenAbove) + else + Result := FTree.GetNextSelected(Node, FConsiderChildrenAbove); + + vneVisible: + begin + if Node = nil then + begin + Result := FTree.GetFirstVisible(FNode, FConsiderChildrenAbove, FIncludeFiltered); + if FIncludeFiltered or not FTree.IsEffectivelyFiltered[Result] then + Exit; + end; + repeat + Result := FTree.GetNextVisible(Node{, FConsiderChildrenAbove}); + until not Assigned(Result) or FIncludeFiltered or not FTree.IsEffectivelyFiltered[Result]; + end; + + vneVisibleChild: + if Node = nil then + Result := FTree.GetFirstVisibleChild(FNode, FIncludeFiltered) + else + Result := FTree.GetNextVisibleSibling(Node, FIncludeFiltered); + + vneVisibleNoInitChild: + if Node = nil then + Result := FTree.GetFirstVisibleChildNoInit(FNode, FIncludeFiltered) + else + Result := FTree.GetNextVisibleSiblingNoInit(Node, FIncludeFiltered); + + vneVisibleNoInit: + begin + if Node = nil then + begin + Result := FTree.GetFirstVisibleNoInit(FNode, FConsiderChildrenAbove, FIncludeFiltered); + if FIncludeFiltered or not FTree.IsEffectivelyFiltered[Result] then + Exit; + end; + repeat + Result := FTree.GetNextVisibleNoInit(Node, FConsiderChildrenAbove); + until not Assigned(Result) or FIncludeFiltered or not FTree.IsEffectivelyFiltered[Result]; + end; + else + Result := nil; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure InitializeGlobalStructures(); + +// initialization of stuff global to the unit +begin + if (gInitialized > 0) or (AtomicIncrement(gInitialized) <> 1) then // Ensure threadsafe that this code is executed only once + exit; + + // This watcher is used whenever a global structure could be modified by more than one thread. + gWatcher := TCriticalSection.Create(); + + // Initialize OLE subsystem for drag'n drop and clipboard operations. + NeedToUnitialize := not IsLibrary and Succeeded(OleInitialize(nil)); + + // 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. + // This format is supposed to use the IStream storage format but unfortunately this does not work when + // OLEFlushClipboard is used. Hence it is disabled until somebody finds a solution. + CF_VIRTUALTREE := RegisterVTClipboardFormat(CFSTR_VIRTUALTREE, TBaseVirtualTree, 50, TYMED_HGLOBAL {or TYMED_ISTREAM}); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure FinalizeGlobalStructures(); + +var + HintWasEnabled: Boolean; + +begin + if gInitialized = 0 then + exit; // Was not initialized + + if NeedToUnitialize then + OleUninitialize; + + // If VT is used in a package and its special hint window was used then the last instance of this + // window is not freed correctly (bug in the VCL). We explicitely tell the application to free it + // otherwise an AV is raised due to access to an invalid memory area. + if ModuleIsPackage then + begin + HintWasEnabled := Application.ShowHint; + Application.ShowHint := False; + if HintWasEnabled then + Application.ShowHint := True; + end; + gWatcher.Free; + gWatcher := nil; +end; + +//----------------- TClipboardFormats ---------------------------------------------------------------------------------- + +constructor TClipboardFormats.Create(AOwner: TBaseVirtualTree); + +begin + FOwner := AOwner; + Sorted := True; + Duplicates := dupIgnore; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TClipboardFormats.Add(const S: string): Integer; + +// Restrict additions to the clipbard formats to only those which are registered with the owner tree or one of its +// ancestors. + +var + Format: Word; + RegisteredClass: TVirtualTreeClass; + +begin + RegisteredClass := TClipboardFormatList.FindFormat(S, Format); + if Assigned(RegisteredClass) and FOwner.ClassType.InheritsFrom(RegisteredClass) then + Result := inherited Add(S) + else + Result := -1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TClipboardFormats.Insert(Index: Integer; const S: string); + +// Restrict additions to the clipbard formats to only those which are registered with the owner tree or one of its +// ancestors. + +var + Format: Word; + RegisteredClass: TVirtualTreeClass; + +begin + RegisteredClass := TClipboardFormatList.FindFormat(S, Format); + if Assigned(RegisteredClass) and FOwner.ClassType.InheritsFrom(RegisteredClass) then + inherited Insert(Index, S); +end; + +//----------------- TBaseVirtualTree ----------------------------------------------------------------------------------- + +constructor TBaseVirtualTree.Create(AOwner: TComponent); + +begin + InitializeGlobalStructures(); + + inherited; + + ControlStyle := ControlStyle - [csSetCaption] + [csCaptureMouse, csOpaque, csReplicatable, csDisplayDragImage, + csReflector]; + FTotalInternalDataSize := 0; + FNodeDataSize := -1; + Width := 200; + Height := 100; + TabStop := True; + ParentColor := False; + FDefaultNodeHeight := cInitialDefaultNodeHeight; + FDragOperations := [doCopy, doMove]; + FHotCursor := crDefault; + FScrollBarOptions := TScrollBarOptions.Create(Self); + FFocusedColumn := NoColumn; + FDragImageKind := diComplete; + FLastSelectionLevel := -1; + FSelectionBlendFactor := 128; + + FIndent := 18; + + FPlusBM := TBitmap.Create; + FHotPlusBM := TBitmap.Create; + FMinusBM := TBitmap.Create; + FHotMinusBM := TBitmap.Create; + FSelectedHotPlusBM := TBitmap.Create; + FSelectedHotMinusBM := TBitmap.Create; + + FBorderStyle := TFormBorderStyle.bsSingle; + FButtonStyle := bsRectangle; + FButtonFillMode := fmTreeColor; + + FHeader := GetHeaderClass.Create(Self); + + // we have an own double buffer handling + inherited DoubleBuffered := False; + + FCheckImageKind := ckSystemDefault; + + FImageChangeLink := TChangeLink.Create; + FImageChangeLink.OnChange := ImageListChange; + FStateChangeLink := TChangeLink.Create; + FStateChangeLink.OnChange := ImageListChange; + FCustomCheckChangeLink := TChangeLink.Create; + FCustomCheckChangeLink.OnChange := ImageListChange; + + FAutoExpandDelay := 1000; + FAutoScrollDelay := 1000; + FAutoScrollInterval := 1; + + FBackground := TVTBackground.Create; + // Similar to the Transparent property of TImage, + // this flag is Off by default. + FBackGroundImageTransparent := False; + + FDefaultPasteMode := amAddChildLast; + FMargin := 4; + FTextMargin := cDefaultTextMargin; + FImagesMargin := 2; + FLastDragEffect := DROPEFFECT_NONE; + FDragType := dtOLE; + FDragHeight := 350; + FDragWidth := 200; + + FColors := TVTColors.Create(Self); + FEditDelay := 1000; + + FAnimationDuration := 200; + FSearchTimeout := 1000; + FSearchStart := ssFocusedNode; + FNodeAlignment := naProportional; + FLineStyle := lsDotted; + FIncrementalSearch := isNone; + FClipboardFormats := TClipboardFormats.Create(Self); + FOptions := GetOptionsClass.Create(Self); + + Touch.InteractiveGestures := [igPan, igPressAndTap]; + Touch.InteractiveGestureOptions := [igoPanInertia, + igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, + igoPanGutter, igoParentPassthrough]; + + if not (csDesigning in ComponentState) then //Don't create worker thread in IDE, there is no use for it + TWorkerThread.AddThreadReference(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +destructor TBaseVirtualTree.Destroy(); +var + WasValidating: Boolean; +begin + WasValidating := (tsValidating in FStates) or (tsValidationNeeded in FStates); // Checking tsValidating is not enough, the TWorkerThread may be stuck in the first call to ChangeTreeStatesAsync() + InterruptValidation(True); + if WasValidating then + begin + // Make sure we dequeue the two synchronized calls from ChangeTreeStatesAsync(), fixes mem leak and AV reported in issue #1001, but is more a workaround. + while CheckSynchronize() and (FPendingSyncProcs>0) do + Sleep(1); + end;// if + FOptions.InternalSetMiscOptions(FOptions.MiscOptions - [toReadOnly]); //SetMiscOptions has side effects + // Make sure there is no reference remaining to the releasing tree. + TWorkerThread.ReleaseThreadReference(IsLibrary); // see issue #1245 + StopWheelPanning; + CancelEditNode; + + // Just in case it didn't happen already release the edit link. + FEditLink := nil; + FClipboardFormats.Free; + // Clear will also free the drag manager if it is still alive. + Clear; + FColors.Free; + FBackground.Free; + + if CheckImageKind = ckSystemDefault then + FCheckImages.Free; + FScrollBarOptions.Free; + + // The window handle must be destroyed before the header is freed because it is needed in WM_NCDESTROY. + if HandleAllocated then + DestroyWindowHandle; + + // Release FDottedBrush in case WM_NCDESTROY hasn't been triggered. + if Assigned(DottedBrushTreeLines) then + begin + DottedBrushTreeLines.Bitmap.Free(); + DottedBrushTreeLines.Free; + DottedBrushTreeLines:= nil; + end; + + FHeader.Free; + FHeader := nil; // Do not use FreeAndNil() before checking issue #497 + FreeAndNil(FOptions); // WM_NCDESTROY accesses FOptions + + FreeMem(FRoot); + + FPlusBM.Free; + FHotPlusBM.Free; + FMinusBM.Free; + FHotMinusBM.Free; + FSelectedHotPlusBM.Free; + FSelectedHotMinusBM.Free; + + // Fixes issue #1002 + Images := nil; + StateImages := nil; + CustomCheckImages := nil; + + FImageChangeLink.Free; + FStateChangeLink.Free; + FCustomCheckChangeLink.Free; + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AdjustTotalCount(Node: PVirtualNode; Value: Integer; Relative: Boolean = False); + +// Sets a node's total count to the given value and recursively adjusts the parent's total count +// (actually, the adjustment is done iteratively to avoid function call overheads). + +var + Difference: Integer; + Run: PVirtualNode; + +begin + if Relative then + Difference := Value + else + Difference := Value - Integer(Node.TotalCount); + if Difference <> 0 then + begin + Run := Node; + // Root node has as parent the tree view. + while Assigned(Run) and (Run <> Pointer(Self)) do + begin + System.Inc(Integer(Run.TotalCount), Difference); + Run := Run.Parent; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +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: TNodeHeight; + Run: PVirtualNode; + +begin + if Relative then + Difference := Value + else + Difference := Value - Node.TotalHeight; + if Difference <> 0 then + begin + Run := Node; + repeat + Inc(Run.TotalHeight, Difference); + + // If the node is not visible or the parent node is not expanded or we are already at the top + // then nothing more remains to do. + if not (vsVisible in Run.States) or (Run = FRoot) or + (Run.Parent = nil) or not (vsExpanded in Run.Parent.States) then + Break; + + Run := Run.Parent; + until False; + end; + + UpdateVerticalRange; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CalculateCacheEntryCount: Integer; + +// Calculates the size of the position cache. + +begin + if FVisibleCount > 1 then + Result := Ceil(FVisibleCount / CacheThreshold) + else + Result := 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CalculateVerticalAlignments(var PaintInfo: TVTPaintInfo; var VButtonAlign: TDimension); + +// Calculates the vertical alignment of the given node and its associated expand/collapse button during +// a node paint cycle depending on the required node alignment style. + +begin + With PaintInfo do begin + // For absolute alignment the calculation is trivial. + case FNodeAlignment of + naFromTop: + VAlign := Node.Align; + naFromBottom: + VAlign := NodeHeight[Node] - Node.Align; + else // naProportional + // Consider button and line alignment, but make sure neither the image nor the button (whichever is taller) + // go out of the entire node height (100% means bottom alignment to the node's bounds). + if (ImageInfo[iiNormal].Index >= 0) or (ImageInfo[iiState].Index >= 0) then + begin + if (ImageInfo[iiNormal].Index >= 0) then + VAlign := ImageInfo[iiNormal].Images.Height + else + VAlign := ImageInfo[iiState].Images.Height; + VAlign := MulDiv((NodeHeight[Node] - VAlign), Node.Align, 100) + Divide(VAlign, 2); + end + else + if toShowButtons in FOptions.PaintOptions then + VAlign := MulDiv((NodeHeight[Node] - FPlusBM.Height), Node.Align, 100) + Divide(FPlusBM.Height, 2) + else + VAlign := MulDiv(Node.NodeHeight, Node.Align, 100); + end; + + VButtonAlign := VAlign - FPlusBM.Height div 2 - (FPlusBM.Height and 1); + end;// With PaintInfo +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ChangeCheckState(Node: PVirtualNode; Value: TCheckState): Boolean; + +// Sets the check state of the node according to the given value and the node's check type. +// If the check state must be propagated to the parent nodes and one of them refuses to change then +// nothing happens and False is returned, otherwise True. + +var + Run: PVirtualNode; + UncheckedCount, + MixedCheckCount, + CheckedCount: Cardinal; + +begin + Result := not (vsChecking in Node.States); + with Node^ do + if Result then + begin + Include(States, vsChecking); + try + if not (vsInitialized in States) then + InitNode(Node) + else if CheckState = Value then + begin + // Value didn't change and node was initialized, so nothing to do + Result := False; + Exit; + end;//if + + // Indicate that we are going to propagate check states up and down the hierarchy. + if FCheckPropagationCount = 0 then begin + // Do not enter tsCheckPropagation more than once + DoStateChange([tsCheckPropagation]); + BeginUpdate(); + end; + System.Inc(FCheckPropagationCount); + try + // Do actions which are associated with the given check state. + case CheckType of + // Check state change with additional consequences for check states of the children. + ctTriStateCheckBox: + begin + // Propagate state down to the children. + if toAutoTristateTracking in FOptions.AutoOptions then + case Value of + csUncheckedNormal: + if Node.ChildCount > 0 then + begin + Run := FirstChild; + CheckedCount := 0; + MixedCheckCount := 0; + UncheckedCount := 0; + while Assigned(Run) do + begin + if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then + begin + if not Self.GetCheckState(Run).IsDisabled() then + SetCheckState(Run, csUncheckedNormal); + // Check if the new child state was set successfully, otherwise we have to adjust the + // node's new check state accordingly. + case Self.GetCheckState(Run) of + csCheckedNormal, csCheckedDisabled: + System.Inc(CheckedCount); + csMixedNormal: + System.Inc(MixedCheckCount); + csUncheckedNormal, csUncheckedDisabled: + System.Inc(UncheckedCount); + end; + end; + Run := Run.NextSibling; + end; + + // If there is still a mixed state child node checkbox then this node must be mixed checked too. + if MixedCheckCount > 0 then + Value := csMixedNormal + else + // If nodes are normally checked child nodes then the unchecked count determines what + // to set for the node itself. + if CheckedCount > 0 then + if UncheckedCount > 0 then + Value := csMixedNormal + else + Value := csCheckedNormal; + end; + csCheckedNormal: + if Node.ChildCount > 0 then + begin + Run := FirstChild; + CheckedCount := 0; + MixedCheckCount := 0; + UncheckedCount := 0; + while Assigned(Run) do + begin + if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then + begin + if not Self.GetCheckState(Run).IsDisabled() then + SetCheckState(Run, csCheckedNormal); + // Check if the new child state was set successfully, otherwise we have to adjust the + // node's new check state accordingly. + case Self.GetCheckState(Run) of + csCheckedNormal: + System.Inc(CheckedCount); + csMixedNormal: + System.Inc(MixedCheckCount); + csUncheckedNormal: + System.Inc(UncheckedCount); + end; + end; + Run := Run.NextSibling; + end; + + // If there is still a mixed state child node checkbox then this node must be mixed checked too. + if MixedCheckCount > 0 then + Value := csMixedNormal + else + // If nodes are normally checked child nodes then the unchecked count determines what + // to set for the node itself. + if CheckedCount > 0 then + if UncheckedCount > 0 then + Value := csMixedNormal + else + Value := csCheckedNormal; + end; + end; + end; + // radio button check state change + ctRadioButton: + if Value = csCheckedNormal then + begin + Value := csCheckedNormal; + // Make sure only this node is checked. + Run := Parent.FirstChild; + while Assigned(Run) do + begin + if Run.CheckType = ctRadioButton then + Run.CheckState := csUncheckedNormal; + Run := Run.NextSibling; + end; + Invalidate; + end; + end; + + if Result then + CheckState := Value // Set new check state + else + CheckState := Self.GetCheckState(Node).GetUnpressed(); // Reset dynamic check state. + + // Propagate state up to the parent. + if not (vsInitialized in Parent.States) then + InitNode(Parent); + if (toAutoTristateTracking in FOptions.AutoOptions) and ([vsChecking, vsDisabled] * Parent.States = []) and + (CheckType in [ctCheckBox, ctTriStateCheckBox]) and (Parent <> FRoot) and + (Parent.CheckType = ctTriStateCheckBox) then + Result := CheckParentCheckState(Node, Value) + else + Result := True; + + InvalidateNode(Node); + finally + System.Dec(FCheckPropagationCount); // WL, 05.02.2004 + if FCheckPropagationCount = 0 then begin + // Allow state change event after all check operations finished + DoStateChange([], [tsCheckPropagation]); + EndUpdate(); + end; + end; + finally + Exclude(States, vsChecking); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn: Integer; NodeLeft, NodeRight: TDimension; Alignment: TAlignment; + OldRect, NewRect: TRect): Boolean; + +// Helper routine used when a draw selection takes place. This version handles left-to-right directionality. +// In the process of adding or removing nodes the current selection is modified which requires to pack it after +// the function returns. Another side effect of this method is that a temporary list of nodes will be created +// (see also InternalCacheNode) which must be inserted into the current selection by the caller. + +var + Run, + NextNode: PVirtualNode; + TextRight, + TextLeft, + CurrentTop, + CurrentRight, + NextTop: TDimension; + NextColumn, + Dummy: Integer; + DummyLeft: TDimension; + + MinY, MaxY: TDimension; + LabelOffset: TDimension; + IsInOldRect, + IsInNewRect: Boolean; + NodeWidth: TDimension; + + // quick check variables for various parameters + DoSwitch, + AutoSpan: Boolean; + SimpleSelection: Boolean; + +begin + // A priori nothing changes. + Result := False; + + // Determine minimum and maximum vertical coordinates to limit iteration to. + MinY := Min(OldRect.Top, NewRect.Top); + MaxY := Max(OldRect.Bottom, NewRect.Bottom); + + // Initialize short hand variables to speed up tests below. + DoSwitch := ssCtrl in FDrawSelShiftState; + AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.AutoOptions); + SimpleSelection := toSimpleDrawSelection in FOptions.SelectionOptions; + // This is the node to start with. + Run := GetNodeAt(0, MinY, False, CurrentTop); + + if Assigned(Run) then + begin + LabelOffset := GetOffset(TVTElement.ofsLabel, Run); + + // ----- main loop + // Change selection depending on the node's rectangle being in the selection rectangle or not, but + // touch only those nodes which overlap either the old selection rectangle or the new one but not both. + repeat + // Collect offsets for check, normal and state images. + TextLeft := NodeLeft + LabelOffset; + NextTop := CurrentTop + NodeHeight[Run]; + + // Simple selection allows to draw the selection rectangle anywhere. No intersection with node captions is + // required. Only top and bottom bounds of the rectangle matter. + if SimpleSelection or (toFullRowSelect in FOptions.SelectionOptions) then + begin + IsInOldRect := (NextTop > OldRect.Top) and (CurrentTop < OldRect.Bottom) and + ((FHeader.Columns.Count = 0) or (FHeader.Columns.TotalWidth > OldRect.Left)) and ((NodeLeft + LabelOffset) < OldRect.Right); + IsInNewRect := (NextTop > NewRect.Top) and (CurrentTop < NewRect.Bottom) and + ((FHeader.Columns.Count = 0) or (FHeader.Columns.TotalWidth > NewRect.Left)) and ((NodeLeft + LabelOffset) < NewRect.Right); + end + else + begin + // The right column border might be extended if column spanning is enabled. + if AutoSpan then + begin + with FHeader.Columns do + begin + NextColumn := MainColumn; + repeat + Dummy := GetNextVisibleColumn(NextColumn); + if (Dummy = InvalidColumn) or not ColumnIsEmpty(Run, Dummy) or + (Items[Dummy].BidiMode <> bdLeftToRight) then + Break; + NextColumn := Dummy; + until False; + if NextColumn = MainColumn then + CurrentRight := NodeRight + else + GetColumnBounds(NextColumn, DummyLeft, CurrentRight); + end; + end + else + CurrentRight := NodeRight; + // Check if we need the node's width. This is the case when the node is not left aligned or the + // left border of the selection rectangle is to the right of the left node border. + if (TextLeft < OldRect.Left) or (TextLeft < NewRect.Left) or (Alignment <> taLeftJustify) then + begin + NodeWidth := DoGetNodeWidth(Run, MainColumn); + if NodeWidth >= (CurrentRight - TextLeft) then + TextRight := CurrentRight + else + case Alignment of + taLeftJustify: + TextRight := TextLeft + NodeWidth; + taCenter: + begin + TextLeft := Divide(TextLeft + CurrentRight - NodeWidth, 2); + TextRight := TextLeft + NodeWidth; + end; + else + // taRightJustify + TextRight := CurrentRight; + TextLeft := TextRight - NodeWidth; + end; + end + else + TextRight := CurrentRight; + + // Now determine whether we need to change the state. + IsInOldRect := (OldRect.Left <= TextRight) and (OldRect.Right >= TextLeft) and + (NextTop > OldRect.Top) and (CurrentTop < OldRect.Bottom); + IsInNewRect := (NewRect.Left <= TextRight) and (NewRect.Right >= TextLeft) and + (NextTop > NewRect.Top) and (CurrentTop < NewRect.Bottom); + end; + + if IsInOldRect xor IsInNewRect then + begin + Result := True; + if DoSwitch then + begin + if vsSelected in Run.States then + InternalRemoveFromSelection(Run) + else + InternalCacheNode(Run); + end + else + begin + if IsInNewRect then + InternalCacheNode(Run) + else + InternalRemoveFromSelection(Run); + end; + end; + CurrentTop := NextTop; + // Get next visible node and update left node position. + NextNode := GetNextVisibleNoInit(Run, True); + if NextNode = nil then + Break; + Inc(NodeLeft, CountLevelDifference(Run, NextNode) * FIndent); + Run := NextNode; + until CurrentTop > MaxY; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn: Integer; NodeLeft, NodeRight: TDimension; Alignment: TAlignment; + OldRect, NewRect: TRect): Boolean; + +// Helper routine used when a draw selection takes place. This version handles right-to-left directionality. +// See also comments in CollectSelectedNodesLTR. + +var + Run, + NextNode: PVirtualNode; + NextColumn, + Dummy: Integer; + + DummyRight, + TextRight, + TextLeft, + CheckOffset, + CurrentTop, + CurrentLeft, + NextTop, + NodeWidth, + MinY, MaxY: TDimension; + IsInOldRect, + IsInNewRect: Boolean; + + // quick check variables for various parameters + WithCheck, + WithStateImages, + DoSwitch, + AutoSpan: Boolean; + SimpleSelection: Boolean; + +begin + // A priori nothing changes. + Result := False; + // Switch the alignment to the opposite value in RTL context. + ChangeBiDiModeAlignment(Alignment); + + // Determine minimum and maximum vertical coordinates to limit iteration to. + MinY := Min(OldRect.Top, NewRect.Top); + MaxY := Max(OldRect.Bottom, NewRect.Bottom); + + // Initialize short hand variables to speed up tests below. + DoSwitch := ssCtrl in FDrawSelShiftState; + WithCheck := (toCheckSupport in FOptions.MiscOptions) and Assigned(FCheckImages); + // Don't check the events here as descendant trees might have overriden the DoGetImageIndex method. + WithStateImages := Assigned(FStateImages) or Assigned(OnGetImageIndexEx); + if WithCheck then + CheckOffset := FCheckImages.Width + FImagesMargin + else + CheckOffset := 0; + AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.AutoOptions); + SimpleSelection := toSimpleDrawSelection in FOptions.SelectionOptions; + // This is the node to start with. + Run := GetNodeAt(0, MinY, False, CurrentTop); + + if Assigned(Run) then + begin + // The initial minimal left border is determined by the identation level of the node and is dynamically adjusted. + if toShowRoot in FOptions.PaintOptions then + Dec(NodeRight, (TDimension((GetNodeLevel(Run) + 1)) * FIndent) + FMargin) + else + Dec(NodeRight, (TDimension(GetNodeLevel(Run)) * FIndent) + FMargin); + + // ----- main loop + // Change selection depending on the node's rectangle being in the selection rectangle or not, but + // touch only those nodes which overlap either the old selection rectangle or the new one but not both. + repeat + // Collect offsets for check, normal and state images. + TextRight := NodeRight; + if WithCheck and (Run.CheckType <> ctNone) then + Dec(TextRight, CheckOffset); + Dec(TextRight, GetImageSize(Run, ikNormal, MainColumn).cx); + if WithStateImages then + Dec(TextRight, GetImageSize(Run, ikState, MainColumn).cx); + NextTop := CurrentTop + NodeHeight[Run]; + + // Simple selection allows to draw the selection rectangle anywhere. No intersection with node captions is + // required. Only top and bottom bounds of the rectangle matter. + if SimpleSelection then + begin + IsInOldRect := (NextTop > OldRect.Top) and (CurrentTop < OldRect.Bottom); + IsInNewRect := (NextTop > NewRect.Top) and (CurrentTop < NewRect.Bottom); + end + else + begin // The left column border might be extended if column spanning is enabled. + if AutoSpan then + begin + NextColumn := MainColumn; + repeat + Dummy := FHeader.Columns.GetPreviousVisibleColumn(NextColumn); + if (Dummy = InvalidColumn) or not ColumnIsEmpty(Run, Dummy) or + (FHeader.Columns[Dummy].BiDiMode = bdLeftToRight) then + Break; + NextColumn := Dummy; + until False; + if NextColumn = MainColumn then + CurrentLeft := NodeLeft + else + FHeader.Columns.GetColumnBounds(NextColumn, CurrentLeft, DummyRight); + end + else + CurrentLeft := NodeLeft; + // Check if we need the node's width. This is the case when the node is not left aligned (in RTL context this // means actually right aligned) or the right border of the selection rectangle is to the left + // of the right node border. + if (TextRight > OldRect.Right) or (TextRight > NewRect.Right) or (Alignment <> taRightJustify) then + begin + NodeWidth := DoGetNodeWidth(Run, MainColumn); + if NodeWidth >= (TextRight - CurrentLeft) then + TextLeft := CurrentLeft + else + case Alignment of + taLeftJustify: + begin + TextLeft := CurrentLeft; + TextRight := TextLeft + NodeWidth; + end; + taCenter: + begin + TextLeft := Divide(TextRight + CurrentLeft - NodeWidth, 2); + TextRight := TextLeft + NodeWidth; + end; + else + // taRightJustify + TextLeft := TextRight - NodeWidth; + end; + end + else + TextLeft := CurrentLeft; + + // Now determine whether we need to change the state. + IsInOldRect := (OldRect.Right >= TextLeft) and (OldRect.Left <= TextRight) and + (NextTop > OldRect.Top) and (CurrentTop < OldRect.Bottom); + IsInNewRect := (NewRect.Right >= TextLeft) and (NewRect.Left <= TextRight) and + (NextTop > NewRect.Top) and (CurrentTop < NewRect.Bottom); + end; + + if IsInOldRect xor IsInNewRect then + begin + Result := True; + if DoSwitch then + begin + if vsSelected in Run.States then + InternalRemoveFromSelection(Run) + else + InternalCacheNode(Run); + end + else + begin + if IsInNewRect then + InternalCacheNode(Run) + else + InternalRemoveFromSelection(Run); + end; + end; + CurrentTop := NextTop; + // Get next visible node and update left node position. + NextNode := GetNextVisibleNoInit(Run, True); + if NextNode = nil then + Break; + Dec(NodeRight, CountLevelDifference(Run, NextNode) * FIndent); + Run := NextNode; + until CurrentTop > MaxY; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ClearNodeBackground(const PaintInfo: TVTPaintInfo; UseBackground, Floating: Boolean; + R: TRect); + +// Erases a node's background depending on what the application decides to do. +// UseBackground determines whether or not to use the background picture, while Floating indicates +// that R is given in coordinates of the small node bitmap or the superordinated target bitmap used in PaintTree. + +var + BackColor: TColor; + EraseAction: TItemEraseAction; + Offset: TPoint; + +begin + BackColor := FColors.BackGroundColor; + with PaintInfo do + begin + EraseAction := eaDefault; + + if Floating then + begin + Offset := Point(-FEffectiveOffsetX, R.Top); + OffsetRect(R, 0, -Offset.Y); + end + else + Offset := Point(0, 0); + + DoBeforeItemErase(Canvas, Node, R, BackColor, EraseAction); + + with Canvas do + begin + case EraseAction of + eaNone: + ; + eaColor: + begin + // User has given a new background color. + Brush.Color := BackColor; + FillRect(R); + end; + else // eaDefault + if UseBackground then + begin + if toStaticBackground in TreeOptions.PaintOptions then + StaticBackground(FBackground, Canvas, Offset, R, FColors.BackGroundColor) + else + TileBackground(FBackground, Canvas, Offset, R, FColors.BackGroundColor); + end + else + begin + if (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.SelectionOptions) and + (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) and not + (tsUseExplorerTheme in FStates) then + begin + if toShowHorzGridLines in FOptions.PaintOptions then + begin + Brush.Color := BackColor; + FillRect(Rect(R.Left, R.Bottom - 1, R.Right, R.Bottom)); + Dec(R.Bottom); + end; + if Focused or (toPopupMode in FOptions.PaintOptions) then + begin + Brush.Color := FColors.FocusedSelectionColor; + Pen.Color := FColors.FocusedSelectionBorderColor; + end + else + begin + Brush.Color := FColors.UnfocusedSelectionColor; + Pen.Color := FColors.UnfocusedSelectionBorderColor; + end; + + RoundRect(R.Left, R.Top, R.Right, R.Bottom, FSelectionCurveRadius, FSelectionCurveRadius); + end + else + begin + Brush.Color := BackColor; + FillRect(R); + end; + end; + end; + DoAfterItemErase(Canvas, Node, R); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CompareNodePositions(Node1, Node2: PVirtualNode; ConsiderChildrenAbove: Boolean = False): Integer; + +// Tries hard and smart to quickly determine whether Node1's structural position is before Node2's position. +// If ConsiderChildrenAbove is True, the nodes will be compared with their visual order in mind. +// Returns 0 if Node1 = Node2, < 0 if Node1 is located before Node2 else > 0. + +var + Run1, + Run2: PVirtualNode; + Level1, + Level2: Cardinal; + +begin + Assert(Assigned(Node1) and Assigned(Node2), 'Nodes must never be nil.'); + + if Node1 = Node2 then + Result := 0 + else + begin + if HasAsParent(Node1, Node2) then + Result := IfThen(ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions), -1, 1) + else + if HasAsParent(Node2, Node1) then + Result := IfThen(ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions), 1, -1) + else + begin + // the given nodes are neither equal nor are they parents of each other, so go up to FRoot + // for each node and compare the child indices of the top level parents + // Note: neither Node1 nor Node2 can be FRoot at this point as this (a bit strange) circumstance would + // be caught by the previous code. + + // start lookup at the same level + Level1 := GetNodeLevel(Node1); + Level2 := GetNodeLevel(Node2); + Run1 := Node1; + while Level1 > Level2 do + begin + Run1 := Run1.Parent; + System.Dec(Level1); + end; + Run2 := Node2; + while Level2 > Level1 do + begin + Run2 := Run2.Parent; + System.Dec(Level2); + end; + + // now go up until we find a common parent node (loop will safely stop at FRoot if the nodes + // don't share a common parent) + while Run1.Parent <> Run2.Parent do + begin + Run1 := Run1.Parent; + Run2 := Run2.Parent; + end; + Result := Integer(Run1.Index) - Integer(Run2.Index); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: TDimension; Style: TVTLineType; + Reverse: Boolean); + +// Draws (depending on Style) one of the 5 line types of the tree. +// If Reverse is True then a right-to-left column is being drawn, hence horizontal lines must be mirrored. +// X and Y describe the left upper corner of the line image rectangle, while H denotes its height (and width). + +var + HalfWidth, + TargetX: TDimension; + +begin + HalfWidth := Divide(FIndent, 2); + if Reverse then + TargetX := 0 + else + TargetX := FIndent - 1; + + with PaintInfo.Canvas do + begin + case Style of + ltBottomRight: + begin + DrawDottedVLine(PaintInfo, Y + VAlign, Y + H, X + HalfWidth); + DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); + end; + ltTopDown: + DrawDottedVLine(PaintInfo, Y, Y + H, X + HalfWidth); + ltTopDownRight: + begin + DrawDottedVLine(PaintInfo, Y, Y + H, X + HalfWidth); + DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); + end; + ltRight: + DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); + ltTopRight: + begin + DrawDottedVLine(PaintInfo, Y, Y + VAlign, X + HalfWidth); + DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); + end; + ltLeft: // left can also mean right for RTL context + if Reverse then + DrawDottedVLine(PaintInfo, Y, Y + H, X + FIndent) + else + DrawDottedVLine(PaintInfo, Y, Y + H, X); + ltLeftBottom: + if Reverse then + begin + DrawDottedVLine(PaintInfo, Y, Y + H, X + FIndent); + DrawDottedHLine(PaintInfo, X, X + FIndent, Y + H); + end + else + begin + DrawDottedVLine(PaintInfo, Y, Y + H, X); + DrawDottedHLine(PaintInfo, X, X + FIndent, Y + H); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +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. + +var + L, H, I: Integer; + +begin + L := 0; + H := High(FPositionCache); + while L <= H do + begin + I := (L + H) shr 1; + if CompareNodePositions(FPositionCache[I].Node, Node) <= 0 then + L := I + 1 + else + H := I - 1; + end; + if L = 0 then // High(FPositionCache) = -1 + begin + Result := nil; + CurrentPos := 0; + end + else + begin + Result := FPositionCache[L - 1].Node; + CurrentPos := FPositionCache[L - 1].AbsoluteTop; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +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. +// The returned node does not necessarily occupy the given position but is the nearest one to start +// iterating from to approach the real node for a given position. CurrentPos receives the actual position of the found +// node which is needed for further iteration. + +var + L, H, I: Integer; + +begin + L := 0; + H := High(FPositionCache); + while L <= H do + begin + I := (L + H) shr 1; + if FPositionCache[I].AbsoluteTop <= Position then + L := I + 1 + else + H := I - 1; + end; + if L = 0 then // High(FPositionCache) = -1 + begin + Result := nil; + CurrentPos := 0; + end + else + begin + Result := FPositionCache[L - 1].Node; + CurrentPos := FPositionCache[L - 1].AbsoluteTop; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.FixupTotalCount(Node: PVirtualNode); + +// Called after loading a subtree from stream. The child count in each node is already set but not +// their total count. + +var + Child: PVirtualNode; + +begin + // Initial total count is set to one on node creation. + Child := Node.FirstChild; + while Assigned(Child) do + begin + FixupTotalCount(Child); + System.Inc(Node.TotalCount, Child.TotalCount); + Child := Child.NextSibling; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.FixupTotalHeight(Node: PVirtualNode); + +// Called after loading a subtree from stream. The individual height of each node is set already, +// but their total height needs an adjustment depending on their visibility state. + +var + Child: PVirtualNode; + +begin + // Initial total height is set to the node height on load. + Child := Node.FirstChild; + + if vsExpanded in Node.States then + begin + while Assigned(Child) do + begin + FixupTotalHeight(Child); + if vsVisible in Child.States then + Inc(Node.TotalHeight, Child.TotalHeight); + Child := Child.NextSibling; + end; + end + else + begin + // The node is collapsed, so just update the total height of its child nodes. + while Assigned(Child) do + begin + FixupTotalHeight(Child); + Child := Child.NextSibling; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetBottomNode: PVirtualNode; + +begin + Result := GetNodeAt(0, ClientHeight - 1); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetCheckedCount: Integer; + +var + Node: PVirtualNode; + +begin + Result := 0; + Node := GetFirstChecked; + while Assigned(Node) do + begin + System.Inc(Result); + Node := GetNextChecked(Node); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetCheckState(Node: PVirtualNode): TCheckState; + +begin + if Assigned(FOnBeforeGetCheckState) then + FOnBeforeGetCheckState(Self, Node); + + Result := Node.CheckState; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetCheckType(Node: PVirtualNode): TCheckType; + +begin + Result := Node.CheckType; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetChildCount(Node: PVirtualNode): Cardinal; +begin + if (Node = nil) or (Node = FRoot) then + Exit(FRoot.ChildCount); + if not GetChildrenInitialized(Node) then + InitChildren(Node); + Exit(Node.ChildCount); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetChildrenInitialized(Node: PVirtualNode): Boolean; + +begin + Result := not (vsHasChildren in Node.States) or (Node.ChildCount > 0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetCutCopyCount: Integer; + +var + Node: PVirtualNode; + +begin + Result := 0; + Node := GetFirstCutCopy; + while Assigned(Node) do + begin + System.Inc(Result); + Node := GetNextCutCopy(Node); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetDisabled(Node: PVirtualNode): Boolean; + +begin + Result := Assigned(Node) and (vsDisabled in Node.States); +end; + +//---------------------------------------------------------------------------------------------------------------------- +// whether the sync of checkbox with selection is allowed for this node +function TBaseVirtualTree.GetSyncCheckstateWithSelection(Node: PVirtualNode): Boolean; + +begin + Result := (toSyncCheckboxesWithSelection in FOptions.SelectionOptions) + and (toCheckSupport in FOptions.MiscOptions) + and Assigned(FCheckImages) + and (Node.CheckType = ctCheckBox); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetDragManager: IVTDragManager; + +// Returns the internal drag manager interface. If this does not yet exist then it is created here. + +begin + if FDragManager = nil then + begin + FDragManager := DoCreateDragManager; + if FDragManager = nil then + FDragManager := TVTDragManager.Create(Self) as IVTDragManager; + end; + + Result := FDragManager; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetExpanded(Node: PVirtualNode): Boolean; + +begin + if Assigned(Node) then + Result := vsExpanded in Node.States + else + Result := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFiltered(Node: PVirtualNode): Boolean; + +begin + Result := vsFiltered in Node.States; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFullyVisible(Node: PVirtualNode): Boolean; + +// Determines whether the given node has the visibility flag set as well as all its parents are expanded. + +begin + Assert(Assigned(Node), 'Invalid parameter.'); + Result := vsVisible in Node.States; + if Result and (Node <> FRoot) then + Result := VisiblePath[Node]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetHasChildren(Node: PVirtualNode): Boolean; + +begin + if Assigned(Node) then + Result := vsHasChildren in Node.States + else + Result := vsHasChildren in FRoot.States; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetMultiline(Node: PVirtualNode): Boolean; + +begin + Result := Assigned(Node) and (Node <> FRoot) and (vsMultiline in Node.States); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNodeHeight(Node: PVirtualNode): TNodeHeight; + +begin + if Assigned(Node) and (Node <> FRoot) then + begin + if (toVariableNodeHeight in FOptions.MiscOptions) and not (vsDeleting in Node.States) then + begin + if not (vsInitialized in Node.States) then + InitNode(Node); + + // Ensure the node's height is determined. + MeasureItemHeight(Self.Canvas, Node); + end; + Result := Node.NodeHeight; + end + else + Result := 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNodeParent(Node: PVirtualNode): PVirtualNode; + +begin + if Assigned(Node) and (Node.Parent <> FRoot) then + Result := Node.Parent + else + Result := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetOffset(pElement: TVTElement; pNode: PVirtualNode): TDimension; +// Calculates the offset of the given element +var + lOffsets: TVTOffsets; +begin + GetOffsets(pNode, lOffsets, pElement); + Exit(lOffsets[pElement]); +end; + +procedure TBaseVirtualTree.GetOffsets(pNode: PVirtualNode; out pOffsets: TVTOffsets; pElement: TVTElement = TVTElement.ofsEndOfClientArea; pColumn: Integer = NoColumn); +// Calculates the offset up to the given element and supplies them in an array. +var + lNodeLevel: Integer; + lNodeIndent: TDimension; +begin + // If no specific column was given, assume the main column + if pColumn = -1 then + pColumn := Header.MainColumn; + + // Left Margin + pOffsets[TVTElement.ofsMargin] := FMargin; + if pElement = ofsMargin then + exit; + + pOffsets[TVTElement.ofsToggleButton] := pOffsets[TVTElement.ofsMargin]; + pOffsets[TVTElement.ofsCheckBox] := pOffsets[TVTElement.ofsMargin]; + if (pColumn = Header.MainColumn) then + begin + if not (toFixedIndent in TreeOptions.PaintOptions) then + begin + // plus Indent + lNodeLevel := GetNodeLevel(pNode); + if toShowRoot in FOptions.PaintOptions then + System.Inc(lNodeLevel); + end + else + lNodeLevel := 1; + lNodeIndent := lNodeLevel * TDimension(FIndent); + // toggle buttons + Inc(pOffsets[TVTElement.ofsToggleButton], lNodeIndent); + Dec(pOffsets[TVTElement.ofsToggleButton], Divide((TDimension(FIndent) - FPlusBM.Width), 2) - 1 + FPlusBM.Width); //Compare PaintTree() relative line 107 + // checkbox + Inc(pOffsets[TVTElement.ofsCheckBox], lNodeIndent); + end;//if MainColumn + + // The area in which the toggle buttons are painted must have exactly the size of one indent level + if pElement <= TVTElement.ofsToggleButton then + exit; + + if (toCheckSupport in TreeOptions.MiscOptions) and Assigned(FCheckImages) and (pNode.CheckType <> ctNone) and (pColumn = Header.MainColumn) then + begin + Inc(pOffsets[TVTElement.ofsCheckBox], fImagesMargin); + + // right of checkbox, left of state image + pOffsets[TVTElement.ofsStateImage] := pOffsets[TVTElement.ofsCheckBox] + FCheckImages.Width + fImagesMargin; + end else + pOffsets[TVTElement.ofsStateImage] := pOffsets[TVTElement.ofsCheckBox]; + if pElement <= TVTElement.ofsStateImage then + exit; + + // right of left image, left of normal image + pOffsets[TVTElement.ofsImage] := pOffsets[TVTElement.ofsStateImage] + GetImageSize(pNode, TVTImageKind.ikState, pColumn).cx; + if pElement = TVTElement.ofsImage then + exit; + + // label + pOffsets[TVTElement.ofsLabel] := pOffsets[TVTElement.ofsImage] + GetImageSize(pNode, TVTImageKind.ikNormal, pColumn).cx; + pOffsets[TVTElement.ofsText] := pOffsets[TVTElement.ofsLabel] + FTextMargin; + Dec(pOffsets[TVTElement.ofsText]); //TODO: This should no longer be necessary once issue #369 is resolved. + if pElement <= TVTElement.ofsText then + exit; + + // End of text + pOffsets[TVTElement.ofsRightOfText] := pOffsets[TVTElement.ofsText] + DoGetNodeWidth(pNode, pColumn) + DoGetNodeExtraWidth(pNode, pColumn); + + // end of client area + pOffsets[TVTElement.ofsEndOfClientArea] := Max(FRangeX, ClientWidth) - FTextMargin; +end; + +function TBaseVirtualTree.GetOffsetXY: TPoint; + +begin + Result := Point(FOffsetX, FOffsetY); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetRangeX: TDimension; +begin + Result := Max(0, FRangeX); +end; + +function TBaseVirtualTree.GetRootNodeCount: Cardinal; + +begin + Result := FRoot.ChildCount; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetSelected(Node: PVirtualNode): Boolean; + +begin + Result := Assigned(Node) and (vsSelected in Node.States); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetSelectedCount: Integer; +begin + Exit(FSelectionCount); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetSelectedCellCount: Integer; +begin + Exit(FSelectedCellCount); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetSelectedData: TArray; +var + lItem: PVirtualNode; + i: Integer; +begin + SetLEngth(Result, Self.SelectedCount); + i := 0; + lItem := Self.GetFirstSelected; + while Assigned(lItem) do + begin + Result[i] := Self.GetNodeData(lItem); + lItem := Self.GetNextSelected(lItem); + System.Inc(i); + end; + SetLength(Result, i); // See issue #927, SelectedCount may not yet be updated. +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetTopNode: PVirtualNode; + +var + Dummy: TDimension; + +begin + Result := GetNodeAt(0, 0, True, Dummy); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetTotalCount(): Cardinal; + +begin + Assert(GetCurrentThreadId = MainThreadId, 'UI controls may only be used in UI thread.'); // FUpdateCount is not thread-safe! So do not write it in non-UI threads. + System.Inc(FUpdateCount); + try + ValidateNode(FRoot, True); + finally + System.Dec(FUpdateCount); + end; + // The root node itself doesn't count as node. + Result := FRoot.TotalCount - 1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetVclStyleEnabled: Boolean; +begin + Exit(FVclStyleEnabled); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetVerticalAlignment(Node: PVirtualNode): Byte; + +begin + Result := Node.Align; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetVisible(Node: PVirtualNode): Boolean; + +// Determines if the given node is marked as being visible. + +begin + if Node = nil then + Node := FRoot; + + if not (vsInitialized in Node.States) then + InitNode(Node); + + Result := vsVisible in Node.States; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetVisiblePath(Node: PVirtualNode): Boolean; + +// Determines if all parents of the given node are expanded and have the visibility flag set. + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameters.'); + + // FRoot is always expanded + repeat + Node := Node.Parent; + until (Node = FRoot) or not (vsExpanded in Node.States) or not (vsVisible in Node.States); + + Result := Node = FRoot; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.HandleClickSelection(LastFocused, NewNode: PVirtualNode; Shift: TShiftState; + DragPending: Boolean); +var + ClickedCell: TVTCell; + +// Handles multi-selection with mouse click. + LCellSelectionEnabled: LongBool; +begin + LCellSelectionEnabled := IsCellSelectionEnabled; + // Support cell selection when clicking a specific column (and full-row-select is off) + if (FLastHitInfo.HitColumn > NoColumn) and LCellSelectionEnabled then + begin + // build the clicked cell (use ClickIndex as it reflects the saved hit column) + ClickedCell.Node := NewNode; + ClickedCell.Column := FHeader.Columns.ClickIndex; + + // Ctrl key down + if ssCtrl in Shift then + begin + if ssShift in Shift then + begin + if FCellRangeAnchor.Node = nil then + begin + if Assigned(FRoot.FirstChild) then + begin + FCellRangeAnchor.Node := FRoot.FirstChild; + FCellRangeAnchor.Column := 0; + end + else + FCellRangeAnchor := ClickedCell; + end; + SelectCells(FCellRangeAnchor, ClickedCell, True); + Invalidate; + end + else + begin + if not (toSiblingSelectConstraint in FOptions.SelectionOptions) then + FCellRangeAnchor := ClickedCell; + if DragPending then + DoStateChange([tsToggleFocusedSelection]) + else + if InternalIsCellSelected(ClickedCell.Node, ClickedCell.Column) then + RemoveFromCellSelection(ClickedCell) + else + AddToCellSelection(ClickedCell, True); + end; + end + else + // Shift key down + if ssShift in Shift then + begin + if FCellRangeAnchor.Node = nil then + begin + if Assigned(FRoot.FirstChild) then + begin + FCellRangeAnchor.Node := FRoot.FirstChild; + FCellRangeAnchor.Column := 0; + end + else + FCellRangeAnchor := ClickedCell; + end; + SelectCells(FCellRangeAnchor, ClickedCell, True); + Invalidate; + end + else + begin + // Clear any existing cell selection and select the clicked cell. + InternalClearCellSelection; + AddToCellSelection(ClickedCell, True); + FCellRangeAnchor := ClickedCell; + end; + Exit; + end; + // Ctrl key down + if ssCtrl in Shift then + begin + if ssShift in Shift then + begin + SelectNodes(FRangeAnchor, NewNode, True); + end + else + begin + if not (toSiblingSelectConstraint in FOptions.SelectionOptions) then + FRangeAnchor := NewNode; + // Delay selection change if a drag operation is pending. + // Otherwise switch selection state here. + if DragPending then + DoStateChange([tsToggleFocusedSelection]) + else + if vsSelected in NewNode.States then + RemoveFromSelection(NewNode) + else + AddToSelection(NewNode, True); + end; + end + else + // Shift key down + if ssShift in Shift then + begin + if FRangeAnchor = nil then + FRangeAnchor := FRoot.FirstChild; + + // select node range + if Assigned(FRangeAnchor) then + begin + SelectNodes(FRangeAnchor, NewNode, False); + Invalidate; + end; + end + else + begin + // any other case + if not (vsSelected in NewNode.States) then + AddToSelection(NewNode, True); + // assign new reference item + FRangeAnchor := NewNode; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.HandleDrawSelection(X, Y: TDimension): Boolean; + +// Handles multi-selection with a focus rectangle. +// Result is True if something changed in selection. + +var + OldRect, + NewRect: TRect; + MainColumn: TColumnIndex; + MaxValue: Integer; + + // limits of a node and its text + NodeLeft, + NodeRight: TDimension; + + // alignment and directionality + CurrentBidiMode: TBidiMode; + CurrentAlignment: TAlignment; + +begin + Result := False; + + // Selection changes are only done if the user drew a selection rectangle large + // enough to exceed the threshold. + if (FRoot.TotalCount > 1) and (tsDrawSelecting in FStates) then + begin + // Effective handling of node selection is done by using two rectangles stored in FSelectRec. + OldRect := OrderRect(FLastSelRect); + NewRect := OrderRect(FNewSelRect); + ClearTempCache; + + MainColumn := FHeader.MainColumn; + + // Alignment and bidi mode determine where the node text is located within a node. + if MainColumn <= NoColumn then + begin + CurrentBidiMode := BidiMode; + CurrentAlignment := Alignment; + end + else + begin + CurrentBidiMode := FHeader.Columns[MainColumn].BidiMode; + CurrentAlignment := FHeader.Columns[MainColumn].Alignment; + end; + + // Determine initial left border of first node (take column reordering into account). + if FHeader.UseColumns then + begin + // The mouse coordinates don't include any horizontal scrolling hence take this also + // out from the returned column position. + NodeLeft := FHeader.Columns[MainColumn].Left + FEffectiveOffsetX; + NodeRight := NodeLeft + FHeader.Columns[MainColumn].Width; + end + else + begin + NodeLeft := 0 + FEffectiveOffsetX; + NodeRight := NodeLeft + ClientWidth; + end; + if CurrentBidiMode = bdLeftToRight then + Result := CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRight, CurrentAlignment, OldRect, NewRect) + else + Result := CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRight, CurrentAlignment, OldRect, NewRect); + end; + + if Result then + begin + // Do some housekeeping if there was a change. + MaxValue := PackArray(FSelection, FSelectionCount); + if MaxValue > -1 then + begin + FSelectionCount := MaxValue; + SetLength(FSelection, FSelectionCount); + end; + if FTempNodeCount > 0 then + begin + if tsClearOnNewSelection in fStates then + begin + DoStateChange([], [tsClearOnNewSelection]); + ClearSelection(False); + end; + + AddToSelection(FTempNodeCache, FTempNodeCount); + ClearTempCache; + end; + + Change(nil); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.HasVisibleNextSibling(Node: PVirtualNode): Boolean; + +// Helper method to determine if the given node has a visible next sibling. This is needed to +// draw correct tree lines. + +begin + // Check if there is a sibling at all. + Result := Assigned(Node.NextSibling); + + if Result then + begin + repeat + Node := Node.NextSibling; + Result := IsEffectivelyVisible[Node]; + until Result or (Node.NextSibling = nil); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.HasVisiblePreviousSibling(Node: PVirtualNode): Boolean; + +// Helper method to determine if the given node has a visible previous sibling. This is needed to +// draw correct tree lines. + +begin + // Check if there is a sibling at all. + Result := Assigned(Node.PrevSibling); + + if Result then + begin + repeat + Node := Node.PrevSibling; + Result := IsEffectivelyVisible[Node]; + until Result or (Node.PrevSibling = nil); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ImageListChange(Sender: TObject); + +begin + if not (csDestroying in ComponentState) then + Invalidate; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InitializeFirstColumnValues(var PaintInfo: TVTPaintInfo); + +// Determines initial index, position and cell size of the first visible column. + +begin + PaintInfo.Column := FHeader.Columns.GetFirstVisibleColumn; + with FHeader.Columns, PaintInfo do + begin + if Column > NoColumn then + begin + CellRect.Right := CellRect.Left + Items[Column].Width; + Position := Items[Column].Position; + end + else + Position := 0; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InitRecursive(Node: PVirtualNode; Levels: Cardinal = MaxInt; pVisibleOnly: Boolean = True); + +// Initializes a node and optionally its children up to a certain level. +// The sepcified number of levels are latrive to the givne Node. + +var + Run: PVirtualNode; +begin + if not Assigned(Node) then + Node := FRoot; + + if (Node <> FRoot) and not (vsInitialized in Node.States) then + InitNode(Node); + if (Levels = 0) or (pVisibleOnly and not (vsExpanded in Node.States)) then + exit; + Run := Node.FirstChild; + + while Assigned(Run) do + begin + InitRecursive(Run, Levels - 1, pVisibleOnly); + Run := Run.NextSibling; + end; +end; + +procedure TBaseVirtualTree.InitRootNode(OldSize: Cardinal = 0); + +// Reinitializes the root node. + +var + NewSize: Cardinal; + +begin + NewSize := TreeNodeSize + FTotalInternalDataSize; + if FRoot = nil then + FRoot := AllocMem(NewSize) + else + begin + ReallocMem(FRoot, NewSize); + ZeroMemory(PByte(FRoot) + OldSize, NewSize - OldSize); + end; + + with FRoot^ do + begin + // Indication that this node is the root node. + SetPrevSibling(FRoot); + SetNextSibling(FRoot); + SetParent(Pointer(Self)); + States := [vsInitialized, vsExpanded, vsHasChildren, vsVisible]; + TotalHeight := FDefaultNodeHeight; + TotalCount := 1; + SetNodeHeight(FDefaultNodeHeight); + Align := 50; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InterruptValidation(pWaitForValidationTermination: Boolean = True); + +var + WasValidating: Boolean; +begin + DoStateChange([tsStopValidation], [tsUseCache]); + + // Check the worker thread existance. It might already be gone (usually on destruction of the last tree). + WasValidating := (tsValidating in FStates); + TWorkerThread.RemoveTree(Self, pWaitForValidationTermination); + if WasValidating then + InvalidateCache(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsFirstVisibleChild(Parent, Node: PVirtualNode): Boolean; + +// Helper method to check if Node is the same as the first visible child of Parent. + +var + Run: PVirtualNode; + +begin + // Find first visible child. + Run := Parent.FirstChild; + while Assigned(Run) and not IsEffectivelyVisible[Run] do + Run := Run.NextSibling; + + Result := Assigned(Run) and (Run = Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsLastVisibleChild(Parent, Node: PVirtualNode): Boolean; + +// Helper method to check if Node is the same as the last visible child of Parent. + +var + Run: PVirtualNode; + +begin + // Find last visible child. + Run := Parent.LastChild; + while Assigned(Run) and not IsEffectivelyVisible[Run] do + Run := Run.PrevSibling; + + Result := Assigned(Run) and (Run = Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.MakeNewNode: PVirtualNode; + +var + Size: Cardinal; + +begin + Size := TreeNodeSize; + if (csDesigning in ComponentState) and (FNodeDataSize < 0) then + System.Inc(Size, SizeOf(Pointer)) // Fixes #702 + else + begin // Make sure FNodeDataSize is valid. + if FNodeDataSize < 0 then // NodeDataSize may be 0 for descendant controls that use only InternalData. + ValidateNodeDataSize(FNodeDataSize); + + // Take record alignment into account. + System.Inc(Size, FNodeDataSize); + end; + + Result := AllocMem(Size + FTotalInternalDataSize); + + // Fill in some default values. + with Result^ do + begin + TotalCount := 1; + TotalHeight := FDefaultNodeHeight; + SetNodeHeight(FDefaultNodeHeight); + States := [vsVisible]; + Align := 50; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.PackArray({*}const TheArray: TNodeArray; Count: Integer): Integer; assembler; +// *This is an optimization to get as near as possible with the PUREPASCAL code without the +// compiler generating a _DynArrayAddRef call. We still modify the array's content via pointers. + +// Removes all entries from the selection array which are no longer in use. The selection array must be sorted for this +// algo to work. Values which must be removed are marked with bit 0 (LSB) set. This little trick works because memory +// is always allocated DWORD aligned. Since the selection array must be sorted while determining the entries to be +// removed it is much more efficient to increment the entry in question instead of setting it to nil (which would break +// the ordered appearance of the list). +// +// On enter EAX contains self reference, EDX the address to TheArray and ECX Count +// The returned value is the number of remaining entries in the array, so the caller can reallocate (shorten) +// the selection array if needed or -1 if nothing needs to be changed. + +{$IF Defined(CPUX64) or not Defined(ASSEMBLER)} +var + Source, Dest: ^PVirtualNode; + ConstOne: NativeInt; +begin + Source := Pointer(TheArray); + ConstOne := 1; + Result := 0; + // Do the fastest scan possible to find the first entry + while (Count <> 0) and {not Odd(NativeInt(Source^))} (NativeInt(Source^) and ConstOne = 0) do + begin + System.Inc(Result); + System.Inc(Source); + System.Dec(Count); + end; + + if Count <> 0 then + begin + Dest := Source; + repeat + // Skip odd entries + if {not Odd(NativeInt(Source^))} NativeInt(Source^) and ConstOne = 0 then + begin + Dest^ := Source^; + System.Inc(Result); + System.Inc(Dest); + end; + System.Inc(Source); // Point to the next entry + System.Dec(Count); + until Count = 0; + end; +end; +{$else} +asm + PUSH EBX + PUSH EDI + PUSH ESI + MOV ESI, EDX + MOV EDX, -1 + JCXZ @@Finish // Empty list? + INC EDX // init remaining entries counter + MOV EDI, ESI // source and destination point to the list memory + MOV EBX, 1 // use a register instead of immediate operant to check against +@@PreScan: + TEST [ESI], EBX // do the fastest scan possible to find the first entry + // which must be removed + JNZ @@DoMainLoop + INC EDX + ADD ESI, 4 + DEC ECX + JNZ @@PreScan + JMP @@Finish + +@@DoMainLoop: + MOV EDI, ESI +@@MainLoop: + TEST [ESI], EBX // odd entry? + JNE @@Skip // yes, so skip this one + MOVSD // else move the entry to new location + INC EDX // count the moved entries + DEC ECX + JNZ @@MainLoop // do it until all entries are processed + JMP @@Finish + +@@Skip: + ADD ESI, 4 // point to the next entry + DEC ECX + JNZ @@MainLoop // do it until all entries are processed +@@Finish: + MOV EAX, EDX // prepare return value + POP ESI + POP EDI + POP EBX +end; +{$IFEND} + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); + +// initializes the contents of the internal bitmaps + +const + LineBitsDotted: array [0..8] of Word = ($55, $AA, $55, $AA, $55, $AA, $55, $AA, $55); + LineBitsSolid: array [0..7] of Word = (0, 0, 0, 0, 0, 0, 0, 0); + +var + Bits: Pointer; + Size: TSize; + Theme: HTHEME; + R: TRect; + BitsLinesCount: Word; + + //--------------- local function -------------------------------------------- + + procedure FillBitmap (ABitmap: TBitmap); + begin + with ABitmap, Canvas do + begin + SetSize(Size.cx, Size.cy); + + if (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.PaintOptions) or VclStyleEnabled then + begin + if (FHeader.MainColumn > NoColumn) then + Brush.Color := FHeader.Columns[FHeader.MainColumn].GetEffectiveColor + else + Brush.Color := FColors.BackGroundColor; + end + else + Brush.Color := clFuchsia; + + Transparent := True; + TransparentColor := Brush.Color; + + FillRect(Rect(0, 0, Width, Height)); + end; + end; + + //--------------- end local function ---------------------------------------- + +const + cMinExpandoHeight = 11; // pixels @100% +begin + if VclStyleEnabled and (seClient in StyleElements) then + begin + if NeedButtons then begin + if StyleServices.GetElementSize(FPlusBM.Canvas.Handle, StyleServices.GetElementDetails(tcbCategoryGlyphClosed), TElementSize.esActual, Size) then + begin + Size.cx := Max(Size.cx, cMinExpandoHeight); // Use min size of 11, see issue #1035 / RSP-33715 + Size.cx := ScaledPixels(Size.cx) // I would have expected that the returned value is dpi-sclaed, but this is not the case in RAD Studio 10.4.1. See issue #984 + end + else + Size.cx := ScaledPixels(cMinExpandoHeight); + Size.cy := Size.cx; + FillBitmap(FPlusBM); + FillBitmap(FHotPlusBM); + FillBitmap(FSelectedHotPlusBM); + FillBitmap(FMinusBM); + FillBitmap(FHotMinusBM); + FillBitmap(FSelectedHotMinusBM); + R := Rect(0,0,Size. cx,Size.cy); + // tcbCategoryGlyphClosed, tcbCategoryGlyphOpened from CategoryButtons + StyleServices.DrawElement(FPlusBM.Canvas.Handle, StyleServices.GetElementDetails(tcbCategoryGlyphClosed), R {$IF CompilerVersion >= 34}, nil, FCurrentPPI{$IFEND}); + StyleServices.DrawElement(FMinusBM.Canvas.Handle, StyleServices.GetElementDetails(tcbCategoryGlyphOpened), R {$IF CompilerVersion >= 34}, nil, FCurrentPPI{$IFEND}); + FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); + FSelectedHotMinusBM.Canvas.Draw(0, 0, FMinusBM); + FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); + FSelectedHotPlusBM.Canvas.Draw(0, 0, FPlusBM); + if Assigned(FOnPrepareButtonImages) then + FOnPrepareButtonImages(Self, FPlusBM, FHotPlusBM, FSelectedHotPlusBM, FMinusBM, FHotMinusBM, FSelectedHotMinusBM, size); + end;//if NeedButtons + end// if VclStyleEnabled + else + begin // No stlye + Size.cx := ScaledPixels(9); + Size.cy := ScaledPixels(9); + if tsUseThemes in FStates then + begin + R := Rect(0, 0, 100, 100); + {$if CompilerVersion >= 33} + if TOSVersion.Check(10) and (TOSVersion.Build >= 15063) then + Theme := OpenThemeDataForDPI(Handle, 'TREEVIEW', Self.FCurrentPPI) + else + Theme := OpenThemeData(Handle, 'TREEVIEW'); + {$else} + Theme := OpenThemeData(Handle, 'TREEVIEW'); + {$ifend} + GetThemePartSize(Theme, FPlusBM.Canvas.Handle, TVP_GLYPH, GLPS_OPENED, @R, TS_TRUE, Size); + end + else + Theme := 0; + + if NeedButtons then + begin + //VCL Themes do not really have ability to provide tree plus/minus images when not using the + //windows theme. The bitmap style designer doesn't have any elements for them, and you + //cannot name any elements you add, which makes it useless. + //To mitigate this, Hook up the OnPrepareButtonImages and draw them yourself. + if Assigned(FOnPrepareButtonImages) then + begin + FillBitmap(FPlusBM); + FillBitmap(FHotPlusBM); + FillBitmap(FSelectedHotPlusBM); + FillBitmap(FMinusBM); + FillBitmap(FHotMinusBM); + FillBitmap(FSelectedHotMinusBM); + FOnPrepareButtonImages(Self, FPlusBM, FHotPlusBM, FSelectedHotPlusBM, FMinusBM, FHotMinusBM, FSelectedHotMinusBM, size); + end + else + begin + with FMinusBM, Canvas do + begin + // box is always of odd size + FillBitmap(FMinusBM); + FillBitmap(FHotMinusBM); + FillBitmap(FSelectedHotMinusBM); + // Weil die selbstgezeichneten Bitmaps sehen im Vcl Style scheiße aus + // Because the self-drawn bitmaps view Vcl Style shit + if Theme = 0 then + begin + if not(tsUseExplorerTheme in FStates) then + begin + if FButtonStyle = bsTriangle then + begin + FMinusBM.Canvas.Brush.Color := clBlack; + FMinusBM.Canvas.Pen.Color := clBlack; + FMinusBM.Canvas.Polygon([Point(0, 2), Point(8, 2), Point(4, 6)]); + end + else + begin + // Button style is rectangular. Now ButtonFillMode determines how to fill the interior. + if FButtonFillMode in [fmTreeColor, fmWindowColor, fmTransparent] then + begin + case FButtonFillMode of + fmTreeColor: + FMinusBM.Canvas.Brush.Color := FColors.BackGroundColor; + fmWindowColor: + FMinusBM.Canvas.Brush.Color := clWindow; + end; + Pen.Color := FColors.TreeLineColor; + Rectangle(0, 0, Width, Height); + Pen.Color := FColors.NodeFontColor; + MoveTo(2, Width div 2); + LineTo(Width - 2, Width div 2); + end + end; + FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); + FSelectedHotMinusBM.Canvas.Draw(0, 0, FMinusBM); + end; + end; + end; + with FPlusBM, Canvas do + begin + FillBitmap(FPlusBM); + FillBitmap(FHotPlusBM); + FillBitmap(FSelectedHotPlusBM); + if Theme = 0 then + begin + if not(tsUseExplorerTheme in FStates) then + begin + if FButtonStyle = bsTriangle then + begin + FPlusBM.Canvas.Brush.Color := clBlack; + FPlusBM.Canvas.Pen.Color := clBlack; + FPlusBM.Canvas.Polygon([Point(2, 0), Point(6, 4), Point(2, 8)]); + end + else + begin + // Button style is rectangular. Now ButtonFillMode determines how to fill the interior. + if FButtonFillMode in [fmTreeColor, fmWindowColor, fmTransparent] then + begin + case FButtonFillMode of + fmTreeColor: + FPlusBM.Canvas.Brush.Color := FColors.BackGroundColor; + fmWindowColor: + FPlusBM.Canvas.Brush.Color := clWindow; + end; + Pen.Color := FColors.TreeLineColor; + Rectangle(0, 0, Width, Height); + Pen.Color := FColors.NodeFontColor; + MoveTo(2, Width div 2); + LineTo(Width - 2, Width div 2); + MoveTo(Width div 2, 2); + LineTo(Width div 2, Width - 2); + end + end; + FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); + FSelectedHotPlusBM.Canvas.Draw(0, 0, FPlusBM); + end; + end; + end; + + + // Overwrite glyph images if theme is active. + if (tsUseThemes in FStates) and (Theme <> 0) then + begin + R := Rect(0, 0, Size.cx, Size.cy); + DrawThemeBackground(Theme, FPlusBM.Canvas.Handle, TVP_GLYPH, GLPS_CLOSED, R, nil); + DrawThemeBackground(Theme, FMinusBM.Canvas.Handle, TVP_GLYPH, GLPS_OPENED, R, nil); + if tsUseExplorerTheme in FStates then + begin + DrawThemeBackground(Theme, FHotPlusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_CLOSED, R, nil); + DrawThemeBackground(Theme, FSelectedHotPlusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_CLOSED, R, nil); + DrawThemeBackground(Theme, FHotMinusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_OPENED, R, nil); + DrawThemeBackground(Theme, FSelectedHotMinusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_OPENED, R, nil); + end + else + begin + FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); + FSelectedHotPlusBM.Canvas.Draw(0, 0, FPlusBM); + FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); + FSelectedHotMinusBM.Canvas.Draw(0, 0, FMinusBM); + end; + end; + end; + if tsUseThemes in FStates then + CloseThemeData(Theme); + end;// if NeedButtons + end;// else + + if NeedLines then + begin + case FLineStyle of + lsDotted: + begin + Bits := @LineBitsDotted; + BitsLinesCount:= Length(LineBitsDotted); + end; + lsSolid: + begin + Bits := @LineBitsSolid; + BitsLinesCount:= Length(LineBitsSolid); + end; + else // lsCustomStyle + Bits := @LineBitsDotted; + DoGetLineStyle(Bits); + BitsLinesCount:= Length(LineBitsDotted); + end; + DottedBrushTreeLines:= PrepareDottedBrush(DottedBrushTreeLines, Bits, BitsLinesCount); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetAlignment(const Value: TAlignment); + +begin + if FAlignment <> Value then + begin + FAlignment := Value; + if not (csLoading in ComponentState) then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetAnimationDuration(const Value: Cardinal); + +begin + FAnimationDuration := Value; + if FAnimationDuration = 0 then + FOptions.AnimationOptions := FOptions.AnimationOptions - [toAnimatedToggle] + else + FOptions.AnimationOptions := FOptions.AnimationOptions + [toAnimatedToggle] +end; + +//---------------------------------------------------------------------------------------------------------------------- +{ New, Support for transparent background: + * Image types: BMP, PNG, GIF, ICO, EMF, TIFF and WMF are automatically identified to support transparent background + * Also detects certain third party image classes registered for PNG, GIF and other image types so that the + transparency related code is used for them. See the code below. + * If some other third party image class is registered that is not detected, + set the flag BackgroundTransparentExternalType explicitly in order to properly do + transparent painting. +} +procedure TBaseVirtualTree.SetBackground(const Value: TVTBackground); + +begin + FBackground.Assign(Value); + Invalidate; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetBackGroundImageTransparent(const Value: Boolean); + +begin + if Value <> FBackGroundImageTransparent then + begin + FBackGroundImageTransparent := Value; + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetBackgroundOffset(const Index: Integer; const Value: TDimension); + +begin + case Index of + 0: + if FBackgroundOffsetX <> Value then + begin + FBackgroundOffsetX := Value; + Invalidate; + end; + 1: + if FBackgroundOffsetY <> Value then + begin + FBackgroundOffsetY := Value; + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetBorderStyle(Value: TBorderStyle); + +begin + if FBorderStyle <> Value then + begin + FBorderStyle := Value; + RecreateWnd; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetBottomNode(Node: PVirtualNode); + +var + Run: PVirtualNode; + R: TRect; + +begin + if Assigned(Node) then + begin + // make sure all parents of the node are expanded + Run := Node.Parent; + while Run <> FRoot do + begin + if not (vsExpanded in Run.States) then + ToggleNode(Run); + Run := Run.Parent; + end; + R := GetDisplayRect(Node, FHeader.MainColumn, True); + DoSetOffsetXY(Point(FOffsetX, FOffsetY + ClientHeight - R.Top - NodeHeight[Node]), + [suoRepaintScrollBars, suoUpdateNCArea]); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetBottomSpace(const Value: TDimension); + +begin + if FBottomSpace <> Value then + begin + FBottomSpace := Value; + UpdateVerticalScrollBar(True); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetButtonFillMode(const Value: TVTButtonFillMode); + +begin + if FButtonFillMode <> Value then + begin + if Value = TVTButtonFillMode.fmShaded then // no longer supported + FButtonFillMode := TVTButtonFillMode.fmTreeColor + else + FButtonFillMode := Value; + if not (csLoading in ComponentState) then + begin + PrepareBitmaps(True, False); + if HandleAllocated then + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetButtonStyle(const Value: TVTButtonStyle); + +begin + if FButtonStyle <> Value then + begin + FButtonStyle := Value; + if not (csLoading in ComponentState) then + begin + PrepareBitmaps(True, False); + if HandleAllocated then + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetCheckState(Node: PVirtualNode; Value: TCheckState); + +begin + if (Node.CheckState <> Value) and DoChecking(Node, Value) then + DoCheckClick(Node, Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetCheckStateForAll(aCheckState: TCheckState; pSelectedOnly: Boolean; pExcludeDisabled: Boolean = True); + +// Changes the check state for all or for all seledcted nodes. +// aCheckState: The new check state. +// pSelectedOnly: If passed True, only the selected nodes will bechnaged, if passed False all nodes in the control will be changed. +// pExcludeDisabled: Optiopnal. If passed True (the default value), disabled checkboxes won't be changed, if passed False disabled checkboxes will be altered too. + +var + lItem : PVirtualNode; +begin + With Self do begin + Screen.Cursor := crHourGlass; + BeginUpdate; + try + if pSelectedOnly then + lItem := GetFirstSelected + else + lItem := GetFirst; + //for i:=0 to List.Items.Count-1 do begin + while Assigned(lItem) do begin + if not pExcludeDisabled or not CheckState[lItem].IsDisabled() then + CheckState[lItem] := aCheckState; + if pSelectedOnly then + lItem := GetNextSelected(lItem) + else + lItem := GetNext(lItem); + end;//while + finally + Screen.Cursor := crDefault; + EndUpdate; + end;//try..finally + end;//With +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetCheckType(Node: PVirtualNode; Value: TCheckType); + +begin + if (Node.CheckType <> Value) and not (toReadOnly in FOptions.MiscOptions) then + begin + Node.CheckType := Value; + if (Value <> ctTriStateCheckBox) and (Node.CheckState in [csMixedNormal, csMixedPressed]) then + Node.CheckState := csUncheckedNormal;// reset check state if it doesn't fit the new check type + // For check boxes with tri-state check box parents we have to initialize differently. + if (toAutoTriStateTracking in FOptions.AutoOptions) and (Value in [ctCheckBox, ctTriStateCheckBox]) and + (Node.Parent <> FRoot) then + begin + if not (vsInitialized in Node.Parent.States) then + InitNode(Node.Parent); + if (Node.Parent.CheckType = ctTriStateCheckBox) then begin + if (GetCheckState(Node.Parent) in [csUncheckedNormal, csUncheckedDisabled]) then + CheckState[Node] := csUncheckedNormal + else if (GetCheckState(Node.Parent) in [csCheckedNormal, csCheckedDisabled]) then + CheckState[Node] := csCheckedNormal; + end;//if + end;//if + InvalidateNode(Node); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal); + +// Changes a node's child structure to accomodate the new child count. This is used to add or delete +// child nodes to/from the end of the node's child list. To insert or delete a specific node a separate +// routine is used. + +var + Remaining: Cardinal; + Index: Cardinal; + Child: PVirtualNode; + Count: Integer; + NewHeight: TNodeHeight; +begin + if not (toReadOnly in FOptions.MiscOptions) then + begin + if Node = nil then + Node := FRoot; + + Assert(GetCurrentThreadId = MainThreadId, 'UI controls may only be changed in UI thread.'); + if NewChildCount = 0 then + DeleteChildren(Node) + else + begin + // If nothing changed then do nothing. + if NewChildCount <> Node.ChildCount then + begin + InterruptValidation; + + if NewChildCount > Node.ChildCount then + begin + Remaining := NewChildCount - Node.ChildCount; + Count := Remaining; + NewHeight := Node.TotalHeight; + + // New nodes to add. + if Assigned(Node.LastChild) then + Index := Node.LastChild.Index + 1 + else + begin + Index := 0; + Include(Node.States, vsHasChildren); + end; + Node.States := Node.States - [vsAllChildrenHidden, vsHeightMeasured]; + if (vsExpanded in Node.States) and FullyVisible[Node] then + System.Inc(FVisibleCount, Count); // Do this before a possible init of the sub-nodes in DoMeasureItem() + + // New nodes are by default always visible, so we don't need to check the visibility. + while Remaining > 0 do + begin + Child := MakeNewNode; + Child.SetIndex(Index); + Child.SetPrevSibling(Node.LastChild); + if Assigned(Node.LastChild) then + Node.LastChild.SetNextSibling(Child); + Child.SetParent(Node); + Node.SetLastChild(Child); + if Node.FirstChild = nil then + Node.SetFirstChild(Child); + System.Dec(Remaining); + System.Inc(Index); + + if (toVariableNodeHeight in FOptions.MiscOptions) then + GetNodeHeight(Child); + Inc(NewHeight, Child.TotalHeight); + end; + + if vsExpanded in Node.States then + AdjustTotalHeight(Node, NewHeight, False); + + AdjustTotalCount(Node, Count, True); + Node.SetChildCount(NewChildCount); + if (FUpdateCount = 0) and (toAutoSort in FOptions.AutoOptions) and (FHeader.SortColumn > InvalidColumn) then + Sort(Node, FHeader.SortColumn, FHeader.SortDirection, True); + + InvalidateCache; + end//if NewChildCount > Node.ChildCount + else + begin + // Nodes have to be deleted. + Remaining := Node.ChildCount - NewChildCount; + while Remaining > 0 do + begin + DeleteNode(Node.LastChild); + System.Dec(Remaining); + end; + end; + + if FUpdateCount = 0 then + begin + ValidateCache; + UpdateScrollBars(True); + Invalidate; + end; + + if Node = FRoot then + StructureChange(nil, crChildAdded) + else + StructureChange(Node, crChildAdded); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetClipboardFormats(const Value: TClipboardFormats); + +var + I: Integer; + +begin + // Add string by string instead doing an Assign or AddStrings because the list may return -1 for + // invalid entries which cause trouble for the standard implementation. + FClipboardFormats.Clear; + for I := 0 to Value.Count - 1 do + FClipboardFormats.Add(Value[I]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetColors(const Value: TVTColors); + +begin + FColors.Assign(Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetCheckImageKind(Value: TCheckImageKind); +begin + if (Value < Low(Value)) or (Value> High(Value)) then + Value := ckSystemDefault; + // property is deprecated. See issue #622 + if FCheckImageKind <> Value then + begin + if FCheckImageKind = ckSystemDefault then + FreeAndNil(FCheckImages); + FCheckImageKind := Value; + if Value = ckCustom then + FCheckImages := FCustomCheckImages + else if HandleAllocated then + FCheckImages := CreateSystemImageSet(); + if HandleAllocated and (FUpdateCount = 0) and not (csLoading in ComponentState) then + InvalidateRect(nil, False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetCustomCheckImages(const Value: TCustomImageList); + +begin + if FCustomCheckImages <> Value then + begin + if Assigned(FCustomCheckImages) then + begin + FCustomCheckImages.UnRegisterChanges(FCustomCheckChangeLink); + FCustomCheckImages.RemoveFreeNotification(Self); + // Reset the internal check image list reference too, if necessary. + if FCheckImages = FCustomCheckImages then + FCheckImages := nil; + end; + FCustomCheckImages := Value; + if Assigned(FCustomCheckImages) then + begin + // If custom check images are assigned, we switch the property CheckImageKind to ckCustom so that they are actually used + CheckImageKind := ckCustom; + FCustomCheckImages.RegisterChanges(FCustomCheckChangeLink); + FCustomCheckImages.FreeNotification(Self); + end + else + CheckImageKind := ckSystemDefault; + if not (csLoading in ComponentState) then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetDefaultNodeHeight(Value: TDimension); + +begin + if Value = 0 then + Value := cInitialDefaultNodeHeight; + if FDefaultNodeHeight <> Value then + begin + Inc(FRoot.TotalHeight, Value - FDefaultNodeHeight); + FRoot.SetNodeHeight(FRoot.NodeHeight + Value - FDefaultNodeHeight); + FDefaultNodeHeight := Value; + InvalidateCache; + if (FUpdateCount = 0) and HandleAllocated and not (csLoading in ComponentState) then + begin + ValidateCache; + UpdateScrollBars(True); + ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions, True); + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetDisabled(Node: PVirtualNode; Value: Boolean); + +begin + if Assigned(Node) and (Value xor (vsDisabled in Node.States)) then + begin + if Value then + Include(Node.States, vsDisabled) + else + Exclude(Node.States, vsDisabled); + + if FUpdateCount = 0 then + InvalidateNode(Node); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetDoubleBuffered(const Value: Boolean); +begin + // empty by intention, we do our own buffering +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetDoubleBuffered: Boolean; +begin + Result := True; // we do our own buffering +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetEmptyListMessage(const Value: string); + +begin + if Value <> EmptyListMessage then + begin + FEmptyListMessage := Value; + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetExpanded(Node: PVirtualNode; Value: Boolean); + +begin + if Assigned(Node) and (Node <> FRoot) and (Value xor (vsExpanded in Node.States)) then + ToggleNode(Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetFocusedColumn(Value: TColumnIndex); + +begin + if (FFocusedColumn <> Value) and + DoFocusChanging(FFocusedNode, FFocusedNode, FFocusedColumn, Value) then + begin + CancelEditNode; + InvalidateColumn(FFocusedColumn); + InvalidateColumn(Value); + FFocusedColumn := Value; + if Assigned(FFocusedNode) and not (toDisableAutoscrollOnFocus in FOptions.AutoOptions) then + begin + if ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions, True) then + InvalidateNode(FFocusedNode); + end; + + if Assigned(FDropTargetNode) then + InvalidateNode(FDropTargetNode); + + DoFocusChange(FFocusedNode, FFocusedColumn); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetFocusedNode(Value: PVirtualNode); + +var + WasDifferent: Boolean; + +begin + WasDifferent := Value <> FFocusedNode; + DoFocusNode(Value, True); + // Do change event only if there was actually a change. + if WasDifferent and (FFocusedNode = Value) then + DoFocusChange(FFocusedNode, FFocusedColumn); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetFullyVisible(Node: PVirtualNode; Value: Boolean); + +// This method ensures that a node is visible and all its parent nodes are expanded and also visible +// if Value is True. Otherwise the visibility flag of the node is reset but the expand state +// of the parent nodes stays untouched. + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter'); + + IsVisible[Node] := Value; + if Value then + begin + repeat + Node := Node.Parent; + if Node = FRoot then + Break; + if not (vsExpanded in Node.States) then + ToggleNode(Node); + if not (vsVisible in Node.States) then + IsVisible[Node] := True; + until False; + end; + ScrollIntoView(Node, False); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetHasChildren(Node: PVirtualNode; Value: Boolean); + +begin + if Assigned(Node) and not (toReadOnly in FOptions.MiscOptions) then + begin + if Value then + Include(Node.States, vsHasChildren) + else + begin + Exclude(Node.States, vsHasChildren); + DeleteChildren(Node); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetHeader(const Value: TVTHeader); + +begin + FHeader.Assign(Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetHotNode(Value: PVirtualNode); + +begin + FCurrentHotNode := Value; +end; + + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetFiltered(Node: PVirtualNode; Value: Boolean); + +// Sets the 'filtered' flag of the given node according to Value and updates all dependent states. + +var + NeedUpdate: Boolean; + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); + + // Initialize the node if necessary as this might change the filtered state. + if not (vsInitialized in Node.States) then + InitNode(Node); + + if Value <> (vsFiltered in Node.States) then + begin + InterruptValidation; + NeedUpdate := False; + if Value then + begin + Include(Node.States, vsFiltered); + if not (toShowFilteredNodes in FOptions.PaintOptions) then + begin + if (vsInitializing in Node.States) and not (vsHasChildren in Node.States) then + AdjustTotalHeight(Node, 0, False) + else + AdjustTotalHeight(Node, -NodeHeight[Node], True); + if FullyVisible[Node] then + begin + System.Dec(FVisibleCount); + NeedUpdate := True; + end; + if FocusedNode = Node then + FocusedNode := nil; + end; + + if FUpdateCount = 0 then + DetermineHiddenChildrenFlag(Node.Parent) + else + Include(FStates, tsUpdateHiddenChildrenNeeded); + end + else + begin + Exclude(Node.States, vsFiltered); + if not (toShowFilteredNodes in FOptions.PaintOptions) then + begin + AdjustTotalHeight(Node, NodeHeight[Node], True); + if FullyVisible[Node] then + begin + System.Inc(FVisibleCount); + NeedUpdate := True; + end; + end; + + if vsVisible in Node.States then + // Update the hidden children flag of the parent. + // Since this node is now visible we simply have to remove the flag. + Exclude(Node.Parent.States, vsAllChildrenHidden); + end; + + InvalidateCache; + if NeedUpdate and (FUpdateCount = 0) then + begin + ValidateCache; + UpdateScrollBars(True); + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- +procedure TBaseVirtualTree.SetImages(const Value: TCustomImageList); + +begin + if FImages <> Value then + begin + if Assigned(FImages) then + begin + FImages.UnRegisterChanges(FImageChangeLink); + FImages.RemoveFreeNotification(Self); + end; + FImages := Value; + if Assigned(FImages) then + begin + FImages.RegisterChanges(FImageChangeLink); + FImages.FreeNotification(Self); + end; + if not (csLoading in ComponentState) then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetIndent(Value: TDimension); + +begin + if FIndent <> Value then + begin + FIndent := Value; + if not (csLoading in ComponentState) and (FUpdateCount = 0) and HandleAllocated then + begin + UpdateScrollBars(True); + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetLineMode(const Value: TVTLineMode); + +begin + if FLineMode <> Value then + begin + FLineMode := Value; + if HandleAllocated and not (csLoading in ComponentState) then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetLineStyle(const Value: TVTLineStyle); + +begin + if FLineStyle <> Value then + begin + FLineStyle := Value; + if not (csLoading in ComponentState) then + begin + PrepareBitmaps(False, True); + if HandleAllocated then + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetMargin(Value: TDimension); + +begin + if FMargin <> Value then + begin + FMargin := Value; + if HandleAllocated and not (csLoading in ComponentState) then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetMultiline(Node: PVirtualNode; const Value: Boolean); + +begin + if Assigned(Node) and (Node <> FRoot) then + if Value <> (vsMultiline in Node.States) then + begin + if Value then + Include(Node.States, vsMultiline) + else + Exclude(Node.States, vsMultiline); + + if FUpdateCount = 0 then + InvalidateNode(Node); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetNodeAlignment(const Value: TVTNodeAlignment); + +begin + if FNodeAlignment <> Value then + begin + FNodeAlignment := Value; + if HandleAllocated and not (csReading in ComponentState) then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetNodeData(pNode: PVirtualNode; pUserData: Pointer); + + // Can be used to set user data of a PVirtualNode with the size of a pointer, useful for setting + // A pointer to a record or a reference to a class instance. + +var + NodeData: PPointer; +begin + // Check if there is initial user data and there is also enough user data space allocated. + Assert(FNodeDataSize >= SizeOf(Pointer), Self.Classname + ': Cannot set initial user data because there is not enough user data space allocated.'); + NodeData := pNode.GetData(); + NodeData^ := pUserData; + Include(pNode.States, vsOnFreeNodeCallRequired); +end; + +procedure TBaseVirtualTree.SetNodeData(pNode: PVirtualNode; pUserData: T); + + // Can be used to set user data of a PVirtualNode to a class instance. + +begin + pNode.SetData(pUserData); +end; + +procedure TBaseVirtualTree.SetNodeData(pNode: PVirtualNode; const pUserData: IInterface); + + // Can be used to set user data of a PVirtualNode to a class instance, + // will take care about reference counting. + +begin + pNode.SetData(pUserData); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetNodeDataSize(Value: Integer); + +var + LastRootCount: Cardinal; + +begin + if Value < -1 then + Value := -1; + if FNodeDataSize <> Value then + begin + FNodeDataSize := Value; + if not (csLoading in ComponentState) and not (csDesigning in ComponentState) then + begin + LastRootCount := FRoot.ChildCount; + Clear; + SetRootNodeCount(LastRootCount); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetNodeHeight(Node: PVirtualNode; Value: TNodeHeight); + +var + Difference: TDimension; + +begin + Assert(Assigned(Node), 'SetNodeHeight() cannot be called with Node = nil'); + Assert((Node <> FRoot), 'SetNodeHeight() cannot be called for the root node FRoot'); + if (Node.NodeHeight <> Value) then + begin + Difference := Value - Node.NodeHeight; + Node.SetNodeHeight(Value); + + // If the node is effectively filtered out, nothing else has to be done, as it is not visible anyway. + if not IsEffectivelyFiltered[Node] then + begin + AdjustTotalHeight(Node, Difference, True); + + // If an edit operation is currently active then update the editors boundaries as well. + UpdateEditBounds; + + InvalidateCache; + // Stay away from touching the node cache while it is being validated. + if not (tsValidating in FStates) and FullyVisible[Node] then + begin + if (FUpdateCount = 0) and ([tsPainting, tsSizing] * FStates = []) then + begin + ValidateCache; + InvalidateToBottom(Node); + UpdateScrollBars(True); + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetNodeParent(Node: PVirtualNode; const Value: PVirtualNode); + +begin + if Assigned(Node) and Assigned(Value) and (Node.Parent <> Value) then + MoveTo(Node, Value, amAddChildLast, False); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetOffsetX(const Value: TDimension); + +begin + DoSetOffsetXY(Point(Value, FOffsetY), DefaultScrollUpdateFlags); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetOffsetXY(const Value: TPoint); + +begin + DoSetOffsetXY(Value, DefaultScrollUpdateFlags); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetOffsetY(const Value: TDimension); + +begin + DoSetOffsetXY(Point(FOffsetX, Value), DefaultScrollUpdateFlags); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetOnPrepareButtonImages(const Value: TVTPrepareButtonImagesEvent); +begin + FOnPrepareButtonImages := Value; + PrepareBitmaps(True, False); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetOptions(const Value: TCustomVirtualTreeOptions); + +begin + FOptions.Assign(Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetRangeX(value: TDimension); +begin + FRangeX := value; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetRootNodeCount(Value: Cardinal); + +begin + // Don't set the root node count until all other properties (in particular the OnInitNode event) have been set. + if csLoading in ComponentState then + begin + FRoot.SetChildCount(Value); + DoStateChange([tsNeedRootCountUpdate]); + end + else + if FRoot.ChildCount <> Value then + begin + BeginUpdate; + InterruptValidation; + SetChildCount(FRoot, Value); + EndUpdate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetScrollBarOptions(Value: TScrollBarOptions); + +begin + FScrollBarOptions.Assign(Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetSearchOption(const Value: TVTIncrementalSearch); + +begin + if FIncrementalSearch <> Value then + begin + FIncrementalSearch := Value; + if FIncrementalSearch = isNone then + begin + StopTimer(SearchTimer); + FSearchBuffer := ''; + FLastSearchNode := nil; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetSelected(Node: PVirtualNode; Value: Boolean); + +begin + if not FSelectionLocked and Assigned(Node) and (Node <> FRoot) and (Value xor (vsSelected in Node.States)) then + begin + if Value then + begin + if FSelectionCount = 0 then + FRangeAnchor := Node + else begin + if not (toMultiSelect in FOptions.SelectionOptions) then + ClearSelection; + if FRangeAnchor = nil then + FRangeAnchor := Node; + end; + + AddToSelection(Node, True); + + if not (toMultiSelect in FOptions.SelectionOptions) then + FocusedNode := GetFirstSelected; // if only one node can be selected, make sure the focused node changes with the selected node + // Make sure there is a valid column selected (if there are columns at all). + if ((FFocusedColumn < 0) or not (coVisible in FHeader.Columns[FFocusedColumn].Options)) and + (FHeader.MainColumn > NoColumn) then + if ([coVisible, coAllowFocus] * FHeader.Columns[FHeader.MainColumn].Options = [coVisible, coAllowFocus]) then + FFocusedColumn := FHeader.MainColumn + else + FFocusedColumn := FHeader.Columns.GetFirstVisibleColumn(True); + end + else + begin + RemoveFromSelection(Node); + if FSelectionCount = 0 then + ResetRangeAnchor; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetSelectionCurveRadius(const Value: Cardinal); + +begin + if FSelectionCurveRadius <> Value then + begin + FSelectionCurveRadius := Value; + if HandleAllocated and not (csLoading in ComponentState) then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetStateImages(const Value: TCustomImageList); + +begin + if FStateImages <> Value then + begin + if Assigned(FStateImages) then + begin + FStateImages.UnRegisterChanges(FStateChangeLink); + FStateImages.RemoveFreeNotification(Self); + end; + FStateImages := Value; + if Assigned(FStateImages) then + begin + FStateImages.RegisterChanges(FStateChangeLink); + FStateImages.FreeNotification(Self); + end; + if HandleAllocated and not (csLoading in ComponentState) then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetTextMargin(Value: TDimension); + +begin + if FTextMargin <> Value then + begin + FTextMargin := Value; + if not (csLoading in ComponentState) then + begin + AutoScale(); + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetTopNode(Node: PVirtualNode); + +var + R: TRect; + Run: PVirtualNode; + +begin + if Assigned(Node) then + begin + // make sure all parents of the node are expanded + Run := Node.Parent; + while Run <> FRoot do + begin + if not (vsExpanded in Run.States) then + ToggleNode(Run); + Run := Run.Parent; + end; + R := GetDisplayRect(Node, FHeader.MainColumn, True); + SetOffsetY(FOffsetY - R.Top); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetUpdateState(Updating: Boolean); + +begin + // The check for visibility is necessary otherwise the tree is automatically shown when + // updating is allowed. As this happens internally the VCL does not get notified and + // still assumes the control is hidden. This results in weird "cannot focus invisible control" errors. + if Visible and HandleAllocated and (FUpdateCount = 0) then + SendWM_SETREDRAW(Updating); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetVerticalAlignment(Node: PVirtualNode; Value: Byte); + +begin + if Value > 100 then + Value := 100; + if Node.Align <> Value then + begin + Node.Align := Value; + if FullyVisible[Node] and not IsEffectivelyFiltered[Node] then + InvalidateNode(Node); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetVisible(Node: PVirtualNode; Value: Boolean); + +// Sets the visibility style of the given node according to Value. + +var + NeedUpdate: Boolean; + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); + + if Value <> (vsVisible in Node.States) then + begin + InterruptValidation; + NeedUpdate := False; + if Value then + begin + Include(Node.States, vsVisible); + if vsExpanded in Node.Parent.States then + AdjustTotalHeight(Node.Parent, Node.TotalHeight, True); + if VisiblePath[Node] then + begin + System.Inc(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); + NeedUpdate := True; + end; + + // Update the hidden children flag of the parent. + // Since this node is now visible we simply have to remove the flag. + if not IsEffectivelyFiltered[Node] then + Exclude(Node.Parent.States, vsAllChildrenHidden); + end + else + begin + if vsExpanded in Node.Parent.States then + AdjustTotalHeight(Node.Parent, -Node.TotalHeight, True); + if VisiblePath[Node] then + begin + System.Dec(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); + NeedUpdate := True; + end; + Exclude(Node.States, vsVisible); + + if FUpdateCount = 0 then + DetermineHiddenChildrenFlag(Node.Parent) + else + Include(FStates, tsUpdateHiddenChildrenNeeded); + end; + + InvalidateCache; + if NeedUpdate and (FUpdateCount = 0) then + begin + ValidateCache; + UpdateScrollBars(True); + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetVisiblePath(Node: PVirtualNode; Value: Boolean); + +// If Value is True then all parent nodes of Node are expanded. + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); + + if Value then + begin + repeat + Node := Node.Parent; + if Node = FRoot then + Break; + if not (vsExpanded in Node.States) then + ToggleNode(Node); + until False; + end; +end; + +// ---------------------------------------------------------------------------------------------------------------------- +procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: TVTBackground; + DrawingBitmap: TBitmap; DrawingBitmapWidth: TDimension; DrawingBitmapHeight: TDimension; ABkgcolor: TColor); +const + DST = $00AA0029; // Ternary Raster Operation - Destination unchanged + + // fill background will work for transparent images and + // will not disturb non-transparent ones + procedure FillDrawBitmapWithBackGroundColor; + begin + DrawingBitmap.Canvas.Brush.Color := ABkgcolor; + DrawingBitmap.Canvas.FillRect(Rect(0, 0, DrawingBitmap.Width, DrawingBitmap.Height)); + end; + +begin + DrawingBitmap.SetSize(DrawingBitmapWidth, DrawingBitmapHeight); + + if (Source.Graphic is TBitmap) and + (FBackGroundImageTransparent or Source.Bitmap.TRANSPARENT) + then + begin + FillDrawBitmapWithBackGroundColor; + MaskBlt(DrawingBitmap.Canvas.Handle, 0, 0, Source.Width, Source.Height, + Source.Bitmap.Canvas.Handle, 0, 0, Source.Bitmap.MaskHandle, 0, 0, + MakeROP4(DST, SRCCOPY)); + end + else + begin + // Similar to TImage's Transparent property behavior, we don't want + // to draw transparent if the following flag is OFF. + if FBackGroundImageTransparent then + FillDrawBitmapWithBackGroundColor; + DrawingBitmap.Canvas.Draw(0, 0, Source.Graphic); + end +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.StaticBackground(Source: TVTBackground; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); + +// Draws the given source graphic so that it stays static in the given rectangle which is relative to the target bitmap. +// The graphic is aligned so that it always starts at the upper left corner of the target canvas. +// Offset gives the position of the target window as a possible superordinated surface. + +const + DST = $00AA0029; // Ternary Raster Operation - Destination unchanged + +var + PicRect: TRect; + AreaRect: TRect; + DrawRect: TRect; + DrawingBitmap: TBitmap; +begin + DrawingBitmap := TBitmap.Create; + try + // clear background + Target.Brush.Color := aBkgColor; + Target.FillRect(R); + + // Picture rect in relation to client viewscreen. + PicRect := Rect(FBackgroundOffsetX, FBackgroundOffsetY, FBackgroundOffsetX + Source.Width, FBackgroundOffsetY + Source.Height); + + // Area to be draw in relation to client viewscreen. + AreaRect := Rect(OffsetPosition.X + R.Left, OffsetPosition.Y + R.Top, OffsetPosition.X + R.Right, OffsetPosition.Y + R.Bottom); + + // If picture falls in AreaRect, return intersection (DrawRect). + if IntersectRect(DrawRect, PicRect, AreaRect) then + begin + PrepareBackGroundPicture(Source, DrawingBitmap, Source.Width, Source.Height, aBkgColor); + // copy image to destination + BitBlt(Target.Handle, DrawRect.Left - OffsetPosition.X, DrawRect.Top - OffsetPosition.Y, (DrawRect.Right - OffsetPosition.X) - (DrawRect.Left - OffsetPosition.X), + (DrawRect.Bottom - OffsetPosition.Y) - (DrawRect.Top - OffsetPosition.Y) + R.Top, DrawingBitmap.Canvas.Handle, DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top, + SRCCOPY); + end; + finally + DrawingBitmap.Free; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.StopTimer(ID: Integer); + +begin + if HandleAllocated then + KillTimer(Handle, ID); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetWindowTheme(const Theme: string); + +begin + FChangingTheme := True; + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +//used by TCustomVirtualTreeOptions +procedure TBaseVirtualTree.SetVisibleCount(value : Cardinal); +begin + FVisibleCount := value; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.TileBackground(Source: TVTBackground; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); + +// Draws the given source graphic so that it tiles into the given rectangle which is relative to the target bitmap. +// The graphic is aligned so that it always starts at the upper left corner of the target canvas. +// Offset gives the position of the target window in an possible superordinated surface. + +var + SourceX, + SourceY, + TargetX, + DeltaY: TDimension; + DrawingBitmap: TBitmap; +begin + DrawingBitmap := TBitmap.Create; + try + PrepareBackGroundPicture(Source, DrawingBitmap, Source.Width, Source.Height, aBkgColor); + with Target do + begin + SourceY := (R.Top + Offset.Y + FBackgroundOffsetY) mod Source.Height; + // Always wrap the source coordinates into positive range. + if SourceY < 0 then + SourceY := Source.Height + SourceY; + + // Tile image vertically until target rect is filled. + while R.Top < R.Bottom do + begin + SourceX := (R.Left + Offset.X + FBackgroundOffsetX) mod Source.Width; + // always wrap the source coordinates into positive range + if SourceX < 0 then + SourceX := Source.Width + SourceX; + + TargetX := R.Left; + // height of strip to draw + DeltaY := Min(R.Bottom - R.Top, Source.Height - SourceY); + + // tile the image horizontally + while TargetX < R.Right do + begin + BitBlt(Handle, TargetX, R.Top, Min(R.Right - TargetX, Source.Width - SourceX), DeltaY, + DrawingBitmap.Canvas.Handle, SourceX, SourceY, SRCCOPY); + Inc(TargetX, Source.Width - SourceX); + SourceX := 0; + end; + Inc(R.Top, Source.Height - SourceY); + SourceY := 0; + end; + end; + finally + DrawingBitmap.Free; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ToggleCallback(Step, StepSize: Integer; Data: Pointer): Boolean; + +var + Column: TColumnIndex; + Run: TRect; + SecondaryStepSize: Integer; + + //--------------- local functions ------------------------------------------- + + procedure EraseLine; + + var + LocalBrush: TBrush; + + begin + with TToggleAnimationData(Data^), FHeader.Columns do + begin + // Iterate through all columns and erase background in their local color. + // LocalBrush is a brush in the color of the particular column. + Column := GetFirstVisibleColumn; + while (Column > InvalidColumn) and (Run.Left < ClientWidth) do + begin + GetColumnBounds(Column, Run.Left, Run.Right); + if coParentColor in Items[Column].Options then + begin + DC.Brush := Brush; + DC.FillRect(Run); + end + else + begin + LocalBrush := TBrush.Create; + if VclStyleEnabled then + LocalBrush.Color := FColors.BackGroundColor + else + LocalBrush.Color := Items[Column].Color; + DC.Brush := LocalBrush; + DC.FillRect(Run); + LocalBrush.Free; + end; + Column := GetNextVisibleColumn(Column); + end; + end; + end; + + //--------------------------------------------------------------------------- + + procedure DoScrollUp(DC: TCanvas; Brush: TBrush; Area: TRect; Steps: Integer); + + begin + ScrollDC(DC.Handle, 0, -Steps, Area, Area, 0, nil); + + if Step = 0 then + if not FHeader.UseColumns then + begin + DC.Brush := Brush; + DC.FillRect(Rect(Area.Left, Area.Bottom - Steps - 1, Area.Right, Area.Bottom)); + end + else + begin + Run := Rect(Area.Left, Area.Bottom - Steps - 1, Area.Right, Area.Bottom); + EraseLine; + end; + end; + + //--------------------------------------------------------------------------- + + procedure DoScrollDown(DC: TCanvas; Brush: TBrush; Area: TRect; Steps: Integer); + + begin + ScrollDC(DC.Handle, 0, Steps, Area, Area, 0, nil); + + if Step = 0 then + if not FHeader.UseColumns then + begin + DC.Brush := Brush; + DC.FillRect(Rect(Area.Left, Area.Top, Area.Right, Area.Top + Steps + 1)); + end + else + begin + Run := Rect(Area.Left, Area.Top, Area.Right, Area.Top + Steps + 1); + EraseLine; + end; + end; + + //--------------- end local functions --------------------------------------- + +begin + Result := True; + if StepSize > 0 then + begin + SecondaryStepSize := 0; + with TToggleAnimationData(Data^) do + begin + if Mode1 <> tamNoScroll then + begin + if Mode1 = tamScrollUp then + DoScrollUp(DC, Brush, R1, StepSize) + else + DoScrollDown(DC, Brush, R1, StepSize); + + if (Mode2 <> tamNoScroll) and (ScaleFactor > 0) then + begin + // As this routine is able to scroll two independent areas at once, the missing StepSize is + // computed in that case. To ensure the maximal accuracy the rounding error is accumulated. + SecondaryStepSize := Round((StepSize + MissedSteps) * ScaleFactor); + MissedSteps := MissedSteps + StepSize * ScaleFactor - SecondaryStepSize; + end; + end + else + SecondaryStepSize := StepSize; + + if Mode2 <> tamNoScroll then + if Mode2 = tamScrollUp then + DoScrollUp(DC, Brush, R2, SecondaryStepSize) + else + DoScrollDown(DC, Brush, R2, SecondaryStepSize); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMColorChange(var Message: TMessage); + +begin + if not (csLoading in ComponentState) then + begin + PrepareBitmaps(True, False); + if HandleAllocated then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMCtl3DChanged(var Message: TMessage); + +begin + inherited; + if FBorderStyle = bsSingle then + RecreateWnd; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMBiDiModeChanged(var Message: TMessage); + +begin + inherited; + + if UseRightToLeftAlignment then + FEffectiveOffsetX := FRangeX - ClientWidth + FOffsetX + else + FEffectiveOffsetX := -FOffsetX; + if FEffectiveOffsetX < 0 then + FEffectiveOffsetX := 0; + + if toAutoBidiColumnOrdering in FOptions.AutoOptions then + TVirtualTreeColumnsCracker(FHeader.Columns).ReorderColumns(UseRightToLeftAlignment); + FHeader.Invalidate(nil); +end; + +procedure TBaseVirtualTree.CMBorderChanged(var Message: TMessage); +begin + inherited; + if VclStyleEnabled and (seBorder in StyleElements) then + RecreateWnd; +end; + +procedure TBaseVirtualTree.CMParentDoubleBufferedChange(var Message: TMessage); +begin + // empty by intention, we do our own buffering +end; + +procedure TBaseVirtualTree.CMStyleChanged(var Message: TMessage); +begin + VclStyleChanged; + RecreateWnd; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMDenySubclassing(var Message: TMessage); + +// If a Windows XP Theme Manager component is used in the application it will try to subclass all controls which do not +// explicitly deny this. Virtual Treeview knows how to handle XP themes so it does not need subclassing. + +begin + Message.Result := 1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMDrag(var Message: TCMDrag); + +var + S: TObject; + ShiftState: Integer; + P: TPoint; + Formats: TFormatArray; + Effect: Integer; + +begin + with Message, DragRec^ do + begin + S := Source; + Formats := nil; + + // Let the ancestor handle dock operations. + if S is TDragDockObject then + inherited + else + begin + // We need an extra check for the control drag object as there might be other objects not derived from this class (e.g. TActionDragObject). + // Original line of code (see issue #1295): if not (tsUserDragObject in FStates) and (S is TBaseDragControlObject) then + if (S.ClassName = TDragControlObject.ClassName) or (S.ClassName = TDragControlObjectEx.ClassName) then // see issue #1295 + S := (S as TBaseDragControlObject).Control; + case DragMessage of + dmDragEnter, dmDragLeave, dmDragMove: + begin + if DragMessage = dmDragEnter then + DoStateChange([tsVCLDragging]); + if DragMessage = dmDragLeave then + DoStateChange([tsVCLDragFinished], [tsVCLDragging]); + + if DragMessage = dmDragMove then + with ScreenToClient(Pos) do + DoAutoScroll(X, Y); + + ShiftState := 0; + // Alt key will be queried by the KeysToShiftState function in DragOver. + if GetKeyState(VK_SHIFT) < 0 then + ShiftState := ShiftState or MK_SHIFT; + if GetKeyState(VK_CONTROL) < 0 then + ShiftState := ShiftState or MK_CONTROL; + + // Allowed drop effects are simulated for VCL dd. + Effect := DROPEFFECT_MOVE or DROPEFFECT_COPY; + DragOver(S, ShiftState, TDragState(DragMessage), Pos, Effect); + FLastVCLDragTarget := FDropTargetNode; + FVCLDragEffect := Effect; + if (DragMessage = dmDragLeave) and Assigned(FDropTargetNode) then + begin + InvalidateNode(FDropTargetNode); + FDropTargetNode := nil; + end; + Result := LRESULT(Effect); + end; + dmDragDrop: + begin + ShiftState := 0; + // Alt key will be queried by the KeysToShiftState function in DragOver + if GetKeyState(VK_SHIFT) < 0 then + ShiftState := ShiftState or MK_SHIFT; + if GetKeyState(VK_CONTROL) < 0 then + ShiftState := ShiftState or MK_CONTROL; + + // allowed drop effects are simulated for VCL dd, + // replace target node with cached node from other VCL dd messages + if Assigned(FDropTargetNode) then + InvalidateNode(FDropTargetNode); + FDropTargetNode := FLastVCLDragTarget; + P := Point(Pos.X, Pos.Y); + P := ScreenToClient(P); + try + DoDragDrop(S, nil, Formats, KeysToShiftState(ShiftState), P, FVCLDragEffect, FLastDropMode); + finally + if Assigned(FDropTargetNode) then + begin + InvalidateNode(FDropTargetNode); + FDropTargetNode := nil; + end; + end; + end; + dmFindTarget: + begin + Result := LRESULT(ControlAtPos(ScreenToClient(Pos), False)); + if Result = 0 then + Result := LRESULT(Self); + + // This is a reliable place to check whether VCL drag has + // really begun. + if tsVCLDragPending in FStates then + DoStateChange([tsVCLDragging], [tsVCLDragPending, tsEditPending, tsClearPending]); + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMEnabledChanged(var Message: TMessage); + +begin + inherited; + + // Need to invalidate the non-client area as well, since the header must be redrawn too. + if csDesigning in ComponentState then + RedrawWindow(nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_NOERASE or RDW_NOCHILDREN); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMFontChanged(var Message: TMessage); + +var + HeaderMessage: TMessage; + +begin + inherited; + AutoScale(); + + HeaderMessage.Msg := CM_PARENTFONTCHANGED; + HeaderMessage.WParam := 0; + HeaderMessage.LParam := 0; + HeaderMessage.Result := 0; + TVTHeaderCracker(FHeader).HandleMessage(HeaderMessage); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMHintShow(var Message: TCMHintShow); + +// Determines hint message (tooltip) and out-of-hint rect. +// Note: A special handling is needed here because we cannot pass wide strings back to the caller. +// I had to introduce the hint data record anyway so we can use this to pass the hint string. +// We still need to set a dummy hint string in the message to make the VCL showing the hint window. + +var + NodeRect: TRect; + SpanColumn, + Dummy, + ColLeft, + ColRight: Integer; + HitInfo: THitInfo; + ShowOwnHint: Boolean; + IsFocusedOrEditing: Boolean; + ParentForm: TCustomForm; + BottomRightCellContentMargin: TPoint; + HintKind: TVTHintKind; +begin + with Message do + begin + Result := 1; + + if PtInRect(FLastHintRect, HintInfo.CursorPos) then + Exit; + + // Determine node for which to show hint/tooltip. + with HintInfo^ do + GetHitTestInfoAt(CursorPos.X, CursorPos.Y, True, HitInfo, []); + + // Make sure a hint is only shown if the tree or at least its parent form is active. + // Active editing is ok too as long as we don't want the hint for the current edit node. + if IsEditing then + IsFocusedOrEditing := HitInfo.HitNode <> FFocusedNode + else + begin + IsFocusedOrEditing := Focused; + ParentForm := GetParentForm(Self); + if Assigned(ParentForm) then + IsFocusedOrEditing := ParentForm.Focused or Application.Active; + end; + + if (GetCapture = 0) and ShowHint and not (Dragging or IsMouseSelecting) and ([tsScrolling] * FStates = []) and + (FHeader.States = []) and IsFocusedOrEditing then + begin + with HintInfo^ do + begin + Result := 0; + ShowOwnHint := False; + + //workaround for issue #291 + //it duplicates parts of the following code and code in TVirtualTreeHintWindow + HintStr := ''; + if FHeader.UseColumns and (hoShowHint in FHeader.Options) and FHeader.InHeader(CursorPos) then + begin + CursorRect := FHeaderRect; + // Convert the cursor rectangle into real client coordinates. + OffsetRect(CursorRect, 0, -Integer(FHeader.Height)); + HitInfo.HitColumn := TVirtualTreeColumnsCracker(FHeader.Columns).GetColumnAndBounds(CursorPos, CursorRect.Left, CursorRect.Right); + if (HitInfo.HitColumn > NoColumn) and not (csLButtonDown in ControlState) and + (FHeader.Columns[HitInfo.HitColumn].Hint <> '') then + HintStr := FHeader.Columns[HitInfo.HitColumn].Hint; + end + else + if HintMode = hmDefault then + HintStr := GetShortHint(Hint) + else + if Assigned(HitInfo.HitNode) and (HitInfo.HitColumn > InvalidColumn) then + begin + if HintMode = hmToolTip then + HintStr := DoGetNodeToolTip(HitInfo.HitNode, HitInfo.HitColumn, fHintData.LineBreakStyle) + else + HintStr := DoGetNodeHint(HitInfo.HitNode, HitInfo.HitColumn, fHintData.LineBreakStyle); + end; + + // First check whether there is a header hint to show. + if FHeader.UseColumns and (hoShowHint in FHeader.Options) and FHeader.InHeader(CursorPos) then + begin + CursorRect := FHeaderRect; + // Convert the cursor rectangle into real client coordinates. + OffsetRect(CursorRect, 0, -Integer(FHeader.Height)); + HitInfo.HitColumn := TVirtualTreeColumnsCracker(FHeader.Columns).GetColumnAndBounds(CursorPos, CursorRect.Left, CursorRect.Right); + // align the vertical hint position on the bottom bound of the header, but + // avoid overlapping of mouse cursor and hint + HintPos.Y := Max(HintPos.Y, ClientToScreen(Point(0, CursorRect.Bottom)).Y); + // Note: the test for the left mouse button in ControlState might cause problems whenever the VCL does not + // realize when the button is released. This, for instance, happens when doing OLE drag'n drop and + // cancel this with ESC. + if (HitInfo.HitColumn > NoColumn) and not (csLButtonDown in ControlState) then + begin + HintStr := FHeader.Columns[HitInfo.HitColumn].Hint; + if HintStr = '' then + with FHeader.Columns[HitInfo.HitColumn] do + begin + if (2 * FMargin + CaptionWidth + 1) >= Width then + HintStr := CaptionText; + end; + if HintStr <> '' then + ShowOwnHint := True + else + Result := 1; + end + else + Result := 1; + end + else + begin + // Default mode is handled as would the tree be a usual VCL control (no own hint window necessary). + if FHintMode = hmDefault then + HintStr := GetShortHint(Hint) + else + begin + if Assigned(HitInfo.HitNode) and (HitInfo.HitColumn > InvalidColumn) then + begin + // An owner-draw tree should only display a hint when at least + // its OnGetHintSize event handler is assigned. + DoGetHintKind(HitInfo.HitNode, HitInfo.HitColumn, HintKind); + FHintData.HintRect := Rect(0, 0, 0, 0); + if (HintKind = vhkOwnerDraw) then + begin + DoGetHintSize(HitInfo.HitNode, HitInfo.HitColumn, FHintData.HintRect); + ShowOwnHint := not IsRectEmpty(FHintData.HintRect); + end + else + // For trees displaying text hints, a decision about showing the hint or not is based + // on the hint string (if it is empty then no hint is shown). + ShowOwnHint := True; + + if ShowOwnHint then + begin + if HitInfo.HitColumn > NoColumn then + begin + FHeader.Columns.GetColumnBounds(HitInfo.HitColumn, ColLeft, ColRight); + // The right column border might be extended if column spanning is enabled. + if toAutoSpanColumns in FOptions.AutoOptions then + begin + SpanColumn := HitInfo.HitColumn; + repeat + Dummy := FHeader.Columns.GetNextVisibleColumn(SpanColumn); + if (Dummy = InvalidColumn) or not ColumnIsEmpty(HitInfo.HitNode, Dummy) then + Break; + SpanColumn := Dummy; + until False; + if SpanColumn <> HitInfo.HitColumn then + FHeader.Columns.GetColumnBounds(SpanColumn, Dummy, ColRight); + end; + end + else + begin + ColLeft := 0; + ColRight := ClientWidth; + end; + + if FHintMode <> hmTooltip then + begin + // Node specific hint text. + CursorRect := GetDisplayRect(HitInfo.HitNode, HitInfo.HitColumn, False); + CursorRect.Left := ColLeft; + CursorRect.Right := ColRight; + // Align the vertical hint position on the bottom bound of the node, but + // avoid overlapping of mouse cursor and hint. + HintPos.Y := Max(HintPos.Y, ClientToScreen(CursorRect.BottomRight).Y) + ScaledPixels(2); + end + else + begin + // Tool tip to show. This means the full caption of the node must be displayed. + if vsMultiline in HitInfo.HitNode.States then + begin + if hiOnItemLabel in HitInfo.HitPositions then + begin + ShowOwnHint := True; + NodeRect := GetDisplayRect(HitInfo.HitNode, HitInfo.HitColumn, True, False); + end + else + ShowOwnHint := False; + end + else + begin + NodeRect := GetDisplayRect(HitInfo.HitNode, HitInfo.HitColumn, True, True, True); + BottomRightCellContentMargin := DoGetCellContentMargin(HitInfo.HitNode, HitInfo.HitColumn, ccmtBottomRightOnly); + + ShowOwnHint := (HitInfo.HitColumn > InvalidColumn) and PtInRect(NodeRect, CursorPos) and + (CursorPos.X <= ColRight) and (CursorPos.X >= ColLeft) and + ( + // Show hint also if the node text is partially out of the client area. + // "ColRight - 1", since the right column border is not part of this cell. + ( (NodeRect.Right + BottomRightCellContentMargin.X) > Min(ColRight - 1, ClientWidth) ) or + (NodeRect.Left < Max(ColLeft, 0)) or + ( (NodeRect.Bottom + BottomRightCellContentMargin.Y) > ClientHeight ) or + (NodeRect.Top < 0) + ); + end; + + if ShowOwnHint then + begin + // Node specific hint text given will be retrieved when needed. + HintPos := ClientToScreen(Point(NodeRect.Left, NodeRect.Top)); + CursorRect := NodeRect; + end + else + // nothing to show + Result := 1; + end; + end + else + Result := 1; // Avoid hint if this is a draw tree returning an empty hint rectangle. + end + else + begin + // No node so fall back to control's hint (if indicated) or show nothing. + if FHintMode = hmHintAndDefault then + begin + HintStr := GetShortHint(Hint); + + // Fix for the problem: Default Hint once shown stayed even when + // node hint was to be displayed. The reason was that CursorRect + // was for the full client area. Now reducing it to remove the + // columns from it. + if BidiMode = bdLeftToRight then + CursorRect.Left := Header.Columns.TotalWidth + else + CursorRect.right := CursorRect.right - Header.Columns.TotalWidth; + + if Length(HintStr) = 0 then + Result := 1 + else + ShowOwnHint := True; + end + else + Result := 1; + end; + end; + end; + + // Set our own hint window class and prepare structure to be passed to the hint window. + if ShowOwnHint and (Result = 0) then + begin + HintWindowClass := GetHintWindowClass; + FHintData.HintText := HintStr; + FHintData.Tree := Self; + FHintData.Column := HitInfo.HitColumn; + FHintData.Node := HitInfo.HitNode; + FLastHintRect := CursorRect; + HintData := @FHintData; + end + else + FLastHintRect := Rect(0, 0, 0, 0); + end; + + // Remind that a hint is about to show. + if Result = 0 then + DoStateChange([tsHint]) + else + DoStateChange([], [tsHint]); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMHintShowPause(var Message: TCMHintShowPause); + +// Tells the application that the tree (and only the tree) does not want a delayed tool tip. +// Normal hints / header hints use the default delay (except for the first time). + + begin + if ShowHint and (FHintMode = hmToolTip) then + Message.Pause^ := 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMMouseEnter(var Message: TMessage); +begin + DoMouseEnter(); + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMMouseLeave(var Message: TMessage); + +var + LeaveStates: TVirtualTreeStates; + +begin + // Reset the last used hint rectangle in case the mouse enters the window within the bounds + if Assigned(FHintData.Tree) then + FHintData.Tree.FLastHintRect := Rect(0, 0, 0, 0); + + LeaveStates := [tsHint]; + if not (tsPanning in FStates) then + begin + StopTimer(ScrollTimer); + LeaveStates := LeaveStates + [tsScrollPending, tsScrolling]; + end; + DoStateChange([], LeaveStates); + if Assigned(FCurrentHotNode) then + begin + DoHotChange(FCurrentHotNode, nil); + if (toHotTrack in FOptions.PaintOptions) or (toCheckSupport in FOptions.MiscOptions) then + InvalidateNode(FCurrentHotNode); + FCurrentHotNode := nil; + end; + + if Assigned(Header) then + begin + with TVirtualTreeColumnsCracker(Header.Columns) do + begin + DownIndex := NoColumn; + HoverIndex := NoColumn; + CheckBoxHit := False; + end; + end; + DoMouseLeave(); + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CMMouseWheel(var Message: TCMMouseWheel); + +var + ScrollAmount: TDimension; + ScrollLines: DWORD; + RTLFactor: Integer; + WheelFactor: Double; + +begin + StopWheelPanning; + + inherited; + + if Message.Result = 0 then + begin + with Message do + begin + Result := 1; + WheelFactor := WheelDelta / WHEEL_DELTA; + if (FRangeY > ClientHeight) and (not (ssShift in ShiftState)) then + begin + // Scroll vertically if there's something to scroll... + if ssCtrl in ShiftState then + ScrollAmount := Trunc(WheelFactor * ClientHeight) + else + begin + SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @ScrollLines, 0); + if ScrollLines = WHEEL_PAGESCROLL then + ScrollAmount := Trunc(WheelFactor * ClientHeight) + else + ScrollAmount := Integer(Trunc(WheelFactor * ScrollLines * FDefaultNodeHeight)); + end; + SetOffsetY(FOffsetY + ScrollAmount); + end + else + begin + // ...else scroll horizontally if there's something to scroll. + if UseRightToLeftAlignment then + RTLFactor := -1 + else + RTLFactor := 1; + + if ssCtrl in ShiftState then + ScrollAmount := Trunc(WheelFactor * (ClientWidth - FHeader.Columns.GetVisibleFixedWidth)) + else + begin + SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @ScrollLines, 0); + if ScrollLines = WHEEL_PAGESCROLL then + ScrollAmount := Trunc(WheelFactor * (ClientWidth - FHeader.Columns.GetVisibleFixedWidth)) + else + ScrollAmount := Trunc(WheelFactor * ScrollLines * FHeader.Columns.GetScrollWidth); + end; + SetOffsetX(FOffsetX + RTLFactor * ScrollAmount); + end; + end; + + end; + +end; + +//---------------------------------------------------------------------------------------------------------------------- +procedure TBaseVirtualTree.CMSysColorChange(var Message: TMessage); + +begin + inherited; + Message.Msg := WM_SYSCOLORCHANGE; + DefaultHandler(Message); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.TVMGetItem(var Message: TMessage); + +// Screen reader support function. The method returns information about a particular node. + +const + StateMask = TVIS_STATEIMAGEMASK or TVIS_OVERLAYMASK or TVIS_EXPANDED or TVIS_DROPHILITED or TVIS_CUT or + TVIS_SELECTED or TVIS_FOCUSED; + +var + Item: PTVItemEx; + Node: PVirtualNode; + Ghosted: Boolean; + ImageIndex: TImageIndex; + R: TRect; + Text: string; +begin + // We can only return valid data if a nodes reference is given. + Item := Pointer(Message.LParam); + Message.Result := Ord(((Item.mask and TVIF_HANDLE) <> 0) and Assigned(Item.hItem)); + if Message.Result = 1 then + begin + Node := Pointer(Item.hItem); + // Child count requested? + if (Item.mask and TVIF_CHILDREN) <> 0 then + Item.cChildren := Node.ChildCount; + // Index for normal image requested? + if (Item.mask and TVIF_IMAGE) <> 0 then + begin + ImageIndex := -1; + DoGetImageIndex(Node, ikNormal, -1, Ghosted, ImageIndex); + Item.iImage := ImageIndex; + end; + // Index for selected image requested? + if (Item.mask and TVIF_SELECTEDIMAGE) <> 0 then + begin + ImageIndex := -1; + DoGetImageIndex(Node, ikSelected, -1, Ghosted, ImageIndex); + Item.iSelectedImage := ImageIndex; + end; + // State info requested? + if (Item.mask and TVIF_STATE) <> 0 then + begin + // Everything, which is possible is returned. + Item.stateMask := StateMask; + Item.state := 0; + if Node = FFocusedNode then + Item.state := Item.state or TVIS_FOCUSED; + if vsSelected in Node.States then + Item.state := Item.state or TVIS_SELECTED; + if vsCutOrCopy in Node.States then + Item.state := Item.state or TVIS_CUT; + if Node = FDropTargetNode then + Item.state := Item.state or TVIS_DROPHILITED; + if vsExpanded in Node.States then + Item.state := Item.state or TVIS_EXPANDED; + + // Construct state image and overlay image indices. They are zero based, btw. + // and -1 means there is no image. + ImageIndex := -1; + DoGetImageIndex(Node, ikState, -1, Ghosted, ImageIndex); + Item.state := Item.state or Byte(IndexToStateImageMask(ImageIndex + 1)); + ImageIndex := -1; + DoGetImageIndex(Node, ikOverlay, -1, Ghosted, ImageIndex); + Item.state := Item.state or Byte(IndexToOverlayMask(ImageIndex + 1)); + end; + // Node caption requested? + if (Item.mask and TVIF_TEXT) <> 0 then + begin + GetTextInfo(Node, -1, Font, R, Text); + + StrLCopy(Item.pszText, PWideChar(Text), Item.cchTextMax - 1); + Item.pszText[Length(Text)] := #0; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.TVMGetItemRect(var Message: TMessage); + +// Screen read support function. This method returns a node's display rectangle. + +var + TextOnly: Boolean; + Node: PVirtualNode; + +begin + // The lparam member is used two-way. On enter it contains a pointer to the item (node). + // On exit it is to be considered as pointer to a rectangle structure. + Node := Pointer(Pointer(Message.LParam)^); + Message.Result := Ord(IsVisible[Node]); + if Message.Result <> 0 then + begin + TextOnly := Message.WParam <> 0; + PRect(Message.LParam)^ := GetDisplayRect(Node, NoColumn, TextOnly); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.TVMGetNextItem(var Message: TMessage); + +// Screen read support function. This method returns a node depending on the requested case. + +var + Node: PVirtualNode; + +begin + // Start with a nil result. + Message.Result := 0; + Node := Pointer(Message.LParam); + case Message.WParam of + TVGN_CARET: + Message.Result := LRESULT(FFocusedNode); + TVGN_CHILD: + if Assigned(Node) then + Message.Result := LRESULT(GetFirstChild(Node)); + TVGN_DROPHILITE: + Message.Result := LRESULT(FDropTargetNode); + TVGN_FIRSTVISIBLE: + Message.Result := LRESULT(GetFirstVisible(nil, True)); + TVGN_LASTVISIBLE: + Message.Result := LRESULT(GetLastVisible(nil, True)); + TVGN_NEXT: + if Assigned(Node) then + Message.Result := LRESULT(GetNextSibling(Node)); + TVGN_NEXTVISIBLE: + if Assigned(Node) then + Message.Result := LRESULT(GetNextVisible(Node, True)); + TVGN_PARENT: + if Assigned(Node) and (Node <> FRoot) and (Node.Parent <> FRoot) then + Message.Result := LRESULT(Node.Parent); + TVGN_PREVIOUS: + if Assigned(Node) then + Message.Result := LRESULT(GetPreviousSibling(Node)); + TVGN_PREVIOUSVISIBLE: + if Assigned(Node) then + Message.Result := LRESULT(GetPreviousVisible(Node, True)); + TVGN_ROOT: + Message.Result := LRESULT(GetFirst); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMCancelMode(var Message: TWMCancelMode); + +begin + // Clear any transient state. + StopTimer(ExpandTimer); + StopTimer(EditTimer); + StopTimer(HeaderTimer); + StopTimer(ScrollTimer); + StopTimer(SearchTimer); + StopTimer(ThemeChangedTimer); + FSearchBuffer := ''; + FLastSearchNode := nil; + + DoStateChange([], [tsClearPending, tsEditPending, tsOLEDragPending, tsVCLDragPending, tsDrawSelecting, + tsDrawSelPending, tsIncrementalSearching]); + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMChar(var Message: TWMChar); + +begin + if tsIncrementalSearchPending in FStates then + begin + HandleIncrementalSearch(Message.CharCode); + DoStateChange([], [tsIncrementalSearchPending]); + end; + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +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, tsPopupMenuShown]); + + if not Assigned(PopupMenu) then begin + // convert screen coordinates to client + pt := ScreenToClient(Point(Message.XPos, Message.YPos)); + GetHitTestInfoAt(pt.x, pt.y, True, HitInfo); // ShiftState is not used anyway here + DoPopupMenu(HitInfo.HitNode, HitInfo.HitColumn, pt); + end; + + if not (tsPopupMenuShown in FStates) then + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMCopy(var Message: TWMCopy); + +begin + CopyToClipboard; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMCut(var Message: TWMCut); + +begin + CutToClipboard; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMEnable(var Message: TWMEnable); + +begin + inherited; + RedrawWindow(nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_NOERASE or RDW_NOCHILDREN); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMEraseBkgnd(var Message: TWMEraseBkgnd); + +begin + Message.Result := 1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMGetDlgCode(var Message: TWMGetDlgCode); + +begin + Message.Result := DLGC_WANTCHARS or DLGC_WANTARROWS; + if FWantTabs then + Message.Result := Message.Result or DLGC_WANTTAB; +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; + +begin + if UseRightToLeftAlignment then + RTLFactor := -1 + else + RTLFactor := 1; + + case Message.ScrollCode of + SB_BOTTOM: + SetOffsetX(-FRangeX); + SB_ENDSCROLL: + begin + DoStateChange([], [tsThumbTracking]); + // avoiding to adjust the vertical scroll position while tracking makes it much smoother + // but we need to adjust the final position here then + UpdateHorizontalScrollBar(False); + end; + SB_LINELEFT: + SetOffsetX(FOffsetX + RTLFactor * FScrollBarOptions.HorizontalIncrement); + SB_LINERIGHT: + SetOffsetX(FOffsetX - RTLFactor * FScrollBarOptions.HorizontalIncrement); + SB_PAGELEFT: + SetOffsetX(FOffsetX + RTLFactor * (ClientWidth - FHeader.Columns.GetVisibleFixedWidth)); + SB_PAGERIGHT: + SetOffsetX(FOffsetX - RTLFactor * (ClientWidth - FHeader.Columns.GetVisibleFixedWidth)); + SB_THUMBPOSITION, + SB_THUMBTRACK: + begin + DoStateChange([tsThumbTracking]); + if UseRightToLeftAlignment then + SetOffsetX(-FRangeX + ClientWidth + GetRealScrollPosition) + else + SetOffsetX(-GetRealScrollPosition); + end; + SB_TOP: + SetOffsetX(0); + end; + + Message.Result := 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMKeyDown(var Message: TWMKeyDown); + +// Keyboard event handling for node focus, selection, node specific popup menus and help invokation. +// For a detailed description of every action done here read the help. + +var + Shift: TShiftState; + Node, Temp, + LastFocusedNode: PVirtualNode; + Offset: Integer; + ClearPending, + NeedInvalidate, + DoRangeSelect, + PerformMultiSelect: Boolean; + Context: Integer; + ParentControl: TWinControl; + R: TRect; + NewCheckState: TCheckState; + TempColumn, + NewColumn: TColumnIndex; + ActAsGrid: Boolean; + ForceSelection: Boolean; + NewWidth, + NewHeight: Integer; + RTLFactor: Integer; + + // for tabulator handling + GetStartColumn: function(ConsiderAllowFocus: Boolean = False): TColumnIndex of object; + GetNextColumn: function(Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex of object; + GetNextNode: TGetNextNodeProc; + + KeyState: TKeyboardState; + Buffer: array[0..1] of AnsiChar; + LCellSelectionEnabled: Boolean; + + //--------------- local functions ------------------------------------------- + function getPreviousVisibleAutoSpanColumn(acolumn: TColumnIndex; anode: PVirtualNode): TColumnIndex; + var + PrevColumn: Integer; + begin + if (not assigned(anode)) + or (not FHeader.UseColumns) + or (not (toAutoSpanColumns in FOptions.AutoOptions)) + or (acolumn = FHeader.MainColumn) then + begin + //previously existing logic + result := FHeader.Columns.GetPreviousVisibleColumn(acolumn, True); + exit; + end; + //consider auto spanning + with FHeader.Columns do //standard loop for auto span + begin + PrevColumn := acolumn; + repeat + result := FHeader.Columns.GetPreviousVisibleColumn(PrevColumn); + if (result = InvalidColumn) or + (not ColumnIsEmpty(anode, result)) + //Any other BidiMode is not supported as already + //documented by original developer + or (Items[result].BidiMode <> bdLeftToRight) then + Break; + PrevColumn := result; + until False; + end; + end; + + //--------------------------------------------------------------------------- + function getNextVisibleAutoSpanColumn(acolumn: TColumnIndex; anode: PVirtualNode): TColumnIndex; + var + NextColumn: Integer; + begin + if (not assigned(anode)) + or (not FHeader.UseColumns) + or (not (toAutoSpanColumns in FOptions.AutoOptions)) + or (acolumn = FHeader.MainColumn) then + begin + //previously existing logic + result := FHeader.Columns.GetNextVisibleColumn(acolumn, True); + exit; + end; + //consider auto spanning + with FHeader.Columns do //standard loop for auto span + begin + NextColumn := acolumn; + repeat + result := FHeader.Columns.GetNextVisibleColumn(NextColumn); + if (result = InvalidColumn) or + not ColumnIsEmpty(anode, result) + //Any other BidiMode is not supported as already + //documented by original developer + or (Items[result].BidiMode <> bdLeftToRight) then + Break; + NextColumn := result; + until False; + end; + end; + + //--------------------------------------------------------------------------- + function isEmptyAutoSpanColumn(acolumn: TColumnIndex; anode: PVirtualNode): boolean; + var + previousColumn: Integer; + begin + result := false; + if (not assigned(anode)) + or (not FHeader.UseColumns) + or (not (toAutoSpanColumns in FOptions.AutoOptions)) + or (acolumn = FHeader.MainColumn) then + exit; + with FHeader.Columns do + begin + previousColumn := FHeader.Columns.GetPreviousVisibleColumn(acolumn); + if (previousColumn = InvalidColumn) //there is no previous column + //Any other BidiMode is not supported as already + //documented by original developer + or (Items[acolumn].BidiMode <> bdLeftToRight) then + exit; //returning false + result := ColumnIsEmpty(anode, acolumn); + end; + end; + + + //--------------- end local functions --------------------------------------- + +var + SelectedCell, OldCell: TVTCell; +begin + // Make form key preview work and let application modify the key if it wants this. + inherited; + + LCellSelectionEnabled := IsCellSelectionEnabled; + + with Message do + begin + Shift := KeyDataToShiftState(KeyData); + // Ask the application if the default key handling is desired. + if DoKeyAction(CharCode, Shift) then + begin + if (CharCode in [VK_HOME, VK_END, VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_BACK, VK_TAB]) and (RootNode.FirstChild <> nil) then + begin + PerformMultiSelect := (ssShift in Shift) and (toMultiSelect in FOptions.SelectionOptions) and not IsEditing; + + // Clear range selection + if (Shift = []) and LCellSelectionEnabled then + begin + ClearCellSelection; + end; + + // Flag to avoid range selection in case of single node advance. + DoRangeSelect := (CharCode in [ + VK_HOME, VK_END, VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT + ]) and PerformMultiSelect and not IsEditing; + + NeedInvalidate := DoRangeSelect or (FSelectionCount > 1); + ActAsGrid := toGridExtensions in FOptions.MiscOptions; + ClearPending := (Shift = []) or (ActAsGrid and not (ssShift in Shift)) or + not (toMultiSelect in FOptions.SelectionOptions) or (CharCode in [VK_TAB, VK_BACK]); + + // Keep old focused node for range selection. Use a default node if none was focused until now. + LastFocusedNode := FFocusedNode; + if (LastFocusedNode = nil) and (Shift <> []) then + LastFocusedNode := GetFirstVisible(nil, True); + + // Set an initial range anchor if there is not yet one. + if FRangeAnchor = nil then + FRangeAnchor := GetFirstSelected; + if FRangeAnchor = nil then + FRangeAnchor := GetFirst; + + if UseRightToLeftAlignment then + RTLFactor := -1 + else + RTLFactor := 1; + + // Determine new focused node. + case CharCode of + VK_HOME, VK_END: + begin + if (CharCode = VK_END) xor UseRightToLeftAlignment then + begin + GetStartColumn := FHeader.Columns.GetLastVisibleColumn; + GetNextColumn := FHeader.Columns.GetPreviousVisibleColumn; + GetNextNode := GetPreviousVisible; + Node := GetLastVisible(nil, True); + end + else + begin + GetStartColumn := FHeader.Columns.GetFirstVisibleColumn; + GetNextColumn := FHeader.Columns.GetNextVisibleColumn; + GetNextNode := GetNextVisible; + Node := GetFirstVisible(nil, True); + end; + + // Advance to next/previous visible column. + if FHeader.UseColumns then + NewColumn := GetStartColumn + else + NewColumn := NoColumn; + // Find a column for the new/current node which can be focused. + // Make the 'DoFocusChanging' for finding a valid column + // identifiable from the 'DoFocusChanging' raised later on by + // "FocusedNode := Node;" + while (NewColumn > NoColumn) and not DoFocusChanging(FFocusedNode, FFocusedNode, FFocusedColumn, NewColumn) do + NewColumn := GetNextColumn(NewColumn); + if NewColumn > InvalidColumn then + begin + if (Shift = [ssCtrl]) and not ActAsGrid then + begin + ScrollIntoView(Node, toCenterScrollIntoView in FOptions.SelectionOptions, + not (toDisableAutoscrollOnFocus in FOptions.AutoOptions)); + if (CharCode = VK_HOME) and not UseRightToLeftAlignment then + SetOffsetX(0) + else + SetOffsetX(-MaxInt); + end + else + begin + if not ActAsGrid or (ssCtrl in Shift) then + FocusedNode := Node; + //fix: In grid mode, if full row select option is ON, + //then also go to the node determined from the earlier logic + if ActAsGrid and (toFullRowSelect in FOptions.SelectionOptions) then + FocusedNode := Node; + if ActAsGrid and not (toFullRowSelect in FOptions.SelectionOptions) then + begin + FocusedColumn := NewColumn; + // fix: If auto span is ON the last column may be a merged column. So take + // care of selecting the whole merged column on END key. + if (CharCode = VK_END) and isEmptyAutoSpanColumn(NewColumn, FFocusedNode) then + FocusedColumn := getPreviousVisibleAutoSpanColumn(NewColumn, FFocusedNode); + end; + end; + end; + end; + VK_PRIOR: + if Shift = [ssCtrl, ssShift] then + SetOffsetX(FOffsetX + ClientWidth) + else + if [ssShift, ssAlt] = Shift then + begin + if FFocusedColumn <= NoColumn then + NewColumn := FHeader.Columns.GetFirstVisibleColumn + else + begin + Offset := FHeader.Columns.GetVisibleFixedWidth; + NewColumn := FFocusedColumn; + while True do + begin + TempColumn := FHeader.Columns.GetPreviousVisibleColumn(NewColumn); + NewWidth := FHeader.Columns[NewColumn].Width; + if (TempColumn <= NoColumn) or + (Offset + NewWidth >= ClientWidth) or + (coFixed in FHeader.Columns[TempColumn].Options) then + Break; + NewColumn := TempColumn; + Inc(Offset, NewWidth); + end; + end; + SetFocusedColumn(NewColumn); + end + else + if ssCtrl in Shift then + SetOffsetY(FOffsetY + ClientHeight) + else + begin + Offset := 0; + // If there's no focused node then just take the very first visible one. + if FFocusedNode = nil then + Node := GetFirstVisible(nil, True) + else + begin + // Go up as many nodes as comprise together a size of ClientHeight. + Node := FFocusedNode; + while True do + begin + Temp := GetPreviousVisible(Node, True); + NewHeight := NodeHeight[Node]; + if (Temp = nil) or (Offset + NewHeight >= ClientHeight) then + Break; + Node := Temp; + Inc(Offset, NodeHeight[Node]); + end; + end; + FocusedNode := Node; + end; + VK_NEXT: + if Shift = [ssCtrl, ssShift] then + SetOffsetX(FOffsetX - ClientWidth) + else + if [ssShift, ssAlt] = Shift then + begin + if FFocusedColumn <= NoColumn then + NewColumn := FHeader.Columns.GetFirstVisibleColumn + else + begin + Offset := FHeader.Columns.GetVisibleFixedWidth; + NewColumn := FFocusedColumn; + while True do + begin + TempColumn := FHeader.Columns.GetNextVisibleColumn(NewColumn); + NewWidth := FHeader.Columns[NewColumn].Width; + if (TempColumn <= NoColumn) or + (Offset + NewWidth >= ClientWidth) or + (coFixed in FHeader.Columns[TempColumn].Options) then + Break; + NewColumn := TempColumn; + Inc(Offset, NewWidth); + end; + end; + SetFocusedColumn(NewColumn); + end + else + if ssCtrl in Shift then + SetOffsetY(FOffsetY - ClientHeight) + else + begin + Offset := 0; + // If there's no focused node then just take the very last one. + if FFocusedNode = nil then + Node := GetLastVisible(nil, True) + else + begin + // Go up as many nodes as comprise together a size of ClientHeight. + Node := FFocusedNode; + while True do + begin + Temp := GetNextVisible(Node, True); + NewHeight := NodeHeight[Node]; + if (Temp = nil) or (Offset + NewHeight >= ClientHeight) then + Break; + Node := Temp; + Inc(Offset, NewHeight); + end; + end; + FocusedNode := Node; + end; + VK_UP: + begin + // scrolling without selection change + if ssCtrl in Shift then + SetOffsetY(FOffsetY + FDefaultNodeHeight) + else + begin + if FFocusedNode = nil then + Node := GetLastVisible(nil, True) + else + Node := GetPreviousVisible(FFocusedNode, True); + + if Assigned(Node) then + begin + if not EndEditNode then + exit; + if (not PerformMultiSelect or (CompareNodePositions(LastFocusedNode, Node) < -1)) and Assigned(FFocusedNode) then + ClearSelection(False); // Clear selection only if more than one node was skipped. See issue #926 + if FFocusedColumn <= NoColumn then + FFocusedColumn := FHeader.MainColumn; + FocusedNode := Node; + end + else + if Assigned(FFocusedNode) then + InvalidateNode(FFocusedNode); + end; + end; + VK_DOWN: + begin + // scrolling without selection change + if ssCtrl in Shift then + SetOffsetY(FOffsetY - FDefaultNodeHeight) + else + begin + if FFocusedNode = nil then + Node := GetFirstVisible(nil, True) + else + Node := GetNextVisible(FFocusedNode, True); + + if Assigned(Node) then + begin + if not EndEditNode then + exit; + if (not PerformMultiSelect or (CompareNodePositions(LastFocusedNode, Node) > 1)) and Assigned(FFocusedNode) then + ClearSelection(False); // Clear selection only if more than one node was skipped. See issue #926 + if FFocusedColumn <= NoColumn then + FFocusedColumn := FHeader.MainColumn; + FocusedNode := Node; + end + else + if Assigned(FFocusedNode) then + InvalidateNode(FFocusedNode); + end; + end; + VK_LEFT: + begin + // special handling + if ssCtrl in Shift then + SetOffsetX(FOffsetX + RTLFactor * FHeader.Columns.GetScrollWidth) + else + begin + // other special cases + Context := NoColumn; + if ((toExtendedFocus in FOptions.SelectionOptions) and (toGridExtensions in FOptions.MiscOptions)) or + LCellSelectionEnabled then + begin + Context := getPreviousVisibleAutoSpanColumn(FFocusedColumn, FFocusedNode); + if Context > NoColumn then + FocusedColumn := Context; + end + else + if Assigned(FFocusedNode) and (vsExpanded in FFocusedNode.States) and + (Shift = []) and (vsHasChildren in FFocusedNode.States) then + ToggleNode(FFocusedNode) + else + begin + if FFocusedNode = nil then + FocusedNode := GetFirstVisible(nil, True) + else + begin + if FFocusedNode.Parent <> FRoot then + Node := FFocusedNode.Parent + else + Node := nil; + if Assigned(Node) then + begin + if PerformMultiSelect then + begin + // and a third special case + if FFocusedNode.Index > 0 then + DoRangeSelect := True + else + if CompareNodePositions(Node, FRangeAnchor) > 0 then + RemoveFromSelection(FFocusedNode); + end; + FocusedNode := Node; + end + else begin + // If already a root node is selected, then scroll to the left as there is nothing else we could do. #691 + SetOffsetX(FOffsetX + RTLFactor * FHeader.Columns.GetScrollWidth); + end;//else + end; + end; + end; + end; + VK_RIGHT: + begin + // special handling + if ssCtrl in Shift then + SetOffsetX(FOffsetX - RTLFactor * FHeader.Columns.GetScrollWidth) + else + begin + // other special cases + Context := NoColumn; + if ((toExtendedFocus in FOptions.SelectionOptions) and (toGridExtensions in FOptions.MiscOptions)) or + LCellSelectionEnabled then + begin + Context := getNextVisibleAutoSpanColumn(FFocusedColumn, FFocusedNode); + if Context > NoColumn then + FocusedColumn := Context; + end + else + if Assigned(FFocusedNode) and not (vsExpanded in FFocusedNode.States) and + (Shift = []) and (vsHasChildren in FFocusedNode.States) then + ToggleNode(FFocusedNode) + else + begin + if FFocusedNode = nil then + FocusedNode := GetFirstVisible(nil, True) + else + begin + Node := GetFirstVisibleChild(FFocusedNode); + if Assigned(Node) then + begin + if PerformMultiSelect and (CompareNodePositions(Node, FRangeAnchor) < 0) then + RemoveFromSelection(FFocusedNode); + FocusedNode := Node; + end + else begin + // If already a leaf node is selected, then scroll to the right as there is nothing else we could do. #691 + SetOffsetX(FOffsetX - RTLFactor * FHeader.Columns.GetScrollWidth); + end;//else + end; + end; + end; + end; + VK_BACK: + if tsIncrementalSearching in FStates then + DoStateChange([tsIncrementalSearchPending]) + else + if Assigned(FFocusedNode) and (FFocusedNode.Parent <> FRoot) then + FocusedNode := FocusedNode.Parent; + VK_TAB: + if (toExtendedFocus in FOptions.SelectionOptions) and FHeader.UseColumns then + begin + // In order to avoid duplicating source code just to change the direction + // we use function variables. + if ssShift in Shift then + begin + GetStartColumn := FHeader.Columns.GetLastVisibleColumn; + GetNextColumn := FHeader.Columns.GetPreviousVisibleColumn; + GetNextNode := GetPreviousVisible; + end + else + begin + GetStartColumn := FHeader.Columns.GetFirstVisibleColumn; + GetNextColumn := FHeader.Columns.GetNextVisibleColumn; + GetNextNode := GetNextVisible; + end; + + // Advance to next/previous visible column/node. + Node := FFocusedNode; + NewColumn := GetNextColumn(FFocusedColumn, True); + repeat + // Find a column for the current node which can be focused. + while (NewColumn > NoColumn) and not DoFocusChanging(FFocusedNode, Node, FFocusedColumn, NewColumn) + //Fix: for Tab Key to properly skip the empty auto span column + or isEmptyAutoSpanColumn(NewColumn, Node) do + NewColumn := GetNextColumn(NewColumn, True); + + if NewColumn > NoColumn then + begin + // Set new node and column in one go. + SetFocusedNodeAndColumn(Node, NewColumn); + Break; + end; + + // No next column was accepted for the current node. So advance to next node and try again. + Node := GetNextNode(Node); + NewColumn := GetStartColumn; + + // fix: From last column, the Tab key should always go to next row irrespective of auto span + // Similarly the Shift-Tab key should go to previos row from first column + if (Node <> nil) and (NewColumn > NoColumn) then + SetFocusedNodeAndColumn(Node, NewColumn); + + until Node = nil; + end; + end; + + // Clear old selection if required but take care to select the new focused node if it was not selected before. + ForceSelection := False; + if ClearPending and ((LastFocusedNode <> FFocusedNode) or (FSelectionCount <> 1)) then + begin + ClearSelection(not Assigned(FFocusedNode)); + ForceSelection := True; + end; + + // Determine new selection anchor. + if Shift = [] then + begin + // Node-level anchor + FRangeAnchor := FFocusedNode; + FLastSelectionLevel := GetNodeLevelForSelectConstraint(FFocusedNode); + // Cell-level anchor + FCellRangeAnchor.Node := FFocusedNode; + FCellRangeAnchor.Column := FFocusedColumn; + end else + if (ssShift in Shift) and LCellSelectionEnabled then + begin + // multicell support / select multiple cells + SelectedCell := TVTCell.Create(FFocusedNode, FFocusedColumn); + OldCell := FCellRangeAnchor; + SelectCells(OldCell, SelectedCell, True); + end; + + if Assigned(FFocusedNode) then + begin + // Finally change the selection for a specific range of nodes. + if DoRangeSelect then + ToggleSelection(LastFocusedNode, FFocusedNode) + // Make sure the new focused node is also selected. + else if (LastFocusedNode <> FFocusedNode) then begin + if ForceSelection then + AddToSelection(FFocusedNode, False) + else + ToggleSelection(LastFocusedNode, FFocusedNode); // See issue #926 + end; + end; + + // If a repaint is needed then paint the entire tree because of the ClearSelection call, + if NeedInvalidate then + Invalidate; + end + else + begin + // Second chance for keys not directly concerned with selection changes. + + // For +, -, /, * keys on the main keyboard (not numpad) there is no virtual key code defined. + // We have to do special processing to get them working too. + GetKeyboardState(KeyState); + // Avoid conversion to control characters. We have captured the control key state already in Shift. + KeyState[VK_CONTROL] := 0; + if ToASCII(Message.CharCode, (Message.KeyData shr 16) and 7, KeyState, PChar(@Buffer), 0) > 0 then + begin + case Buffer[0] of + '*': + CharCode := VK_MULTIPLY; + '+': + CharCode := VK_ADD; + '/': + CharCode := VK_DIVIDE; + '-': + CharCode := VK_SUBTRACT; + end; + end; + + // According to https://web.archive.org/web/20041129085958/http://www.it-faq.pl/mskb/99/337.HTM + // there is a problem with ToASCII when used in conjunction with dead chars. + // The article recommends to call ToASCII twice to restore a deleted flag in the key message + // structure under certain circumstances. It turned out it is best to always call ToASCII twice. + ToASCII(Message.CharCode, (Message.KeyData shr 16) and 7, KeyState, PChar(@Buffer), 0); + + case CharCode of + VK_F2: + if (Shift = []) and Assigned(FFocusedNode) and CanEdit(FFocusedNode, FFocusedColumn) then + begin + FEditColumn := FFocusedColumn; + DoEdit; + end; + VK_ADD: + if not (tsIncrementalSearching in FStates) then + begin + if ssCtrl in Shift then begin// When changing this code review issue #781 + if ((toReverseFullExpandHotKey in TreeOptions.MiscOptions) and (Shift = [ssCtrl])) xor (Shift = [ssCtrl, ssShift]) then + FullExpand + else if Shift = [ssCtrl] then + FHeader.AutoFitColumns + end + else if Shift = [] then begin + if Assigned(FFocusedNode) and not (vsExpanded in FFocusedNode.States) then + ToggleNode(FFocusedNode); + end// if Shift = [] + else + DoStateChange([tsIncrementalSearchPending]); + end;//if not (tsIncrementalSearching in FStates) + VK_SUBTRACT: + if not (tsIncrementalSearching in FStates) then + begin + if ssCtrl in Shift then + if (toReverseFullExpandHotKey in TreeOptions.MiscOptions) xor (ssShift in Shift) then + FullCollapse + else + FHeader.RestoreColumns + else + if Assigned(FFocusedNode) and (vsExpanded in FFocusedNode.States) then + ToggleNode(FFocusedNode); + end + else + DoStateChange([tsIncrementalSearchPending]); + VK_MULTIPLY: + if not (tsIncrementalSearching in FStates) then + begin + if Assigned(FFocusedNode) then + FullExpand(FFocusedNode); + end + else + DoStateChange([tsIncrementalSearchPending]); + VK_DIVIDE: + if not (tsIncrementalSearching in FStates) then + begin + if Assigned(FFocusedNode) then + FullCollapse(FFocusedNode); + end + else + DoStateChange([tsIncrementalSearchPending]); + VK_ESCAPE: // cancel actions currently in progress + begin + if IsMouseSelecting then + begin + DoStateChange([], [tsDrawSelecting, tsDrawSelPending]); + Invalidate; + end + else + if IsEditing then + CancelEditNode; + end; + VK_SPACE: + if (toCheckSupport in FOptions.MiscOptions) and Assigned(FFocusedNode) and + (FFocusedNode.CheckType <> ctNone) then + begin + NewCheckState := DetermineNextCheckState(FFocusedNode.CheckType, GetCheckState(FFocusedNode)); + if DoChecking(FFocusedNode, NewCheckState) then + begin + if SelectedCount > 1 then + SetCheckStateForAll(NewCheckState, True) + else + DoCheckClick(FFocusedNode, NewCheckState); + end; + end + else + DoStateChange([tsIncrementalSearchPending]); + VK_F1: + if Assigned(FOnGetHelpContext) then + begin + Context := 0; + if Assigned(FFocusedNode) then + begin + Node := FFocusedNode; + // Traverse the tree structure up to the root. + repeat + FOnGetHelpContext(Self, Node, IfThen(FFocusedColumn > NoColumn, FFocusedColumn, 0), Context); + Node := Node.Parent; + until (Node = FRoot) or (Context <> 0); + end; + + // If no help context could be found try the tree's one or its parent's contexts. + ParentControl := Self; + while Assigned(ParentControl) and (Context = 0) do + begin + Context := ParentControl.HelpContext; + ParentControl := ParentControl.Parent; + end; + if Context <> 0 then + Application.HelpContext(Context); + end; + VK_APPS: + if Assigned(FFocusedNode) then + begin + R := GetDisplayRect(FFocusedNode, FFocusedColumn, True); + Offset := DoGetNodeWidth(FFocusedNode, FFocusedColumn); + if FFocusedColumn >= 0 then + begin + if Offset > FHeader.Columns[FFocusedColumn].Width then + Offset := FHeader.Columns[FFocusedColumn].Width; + end + else + begin + if Offset > ClientWidth then + Offset := ClientWidth; + end; + DoPopupMenu(FFocusedNode, FFocusedColumn, Point(R.Left + Offset div 2, (R.Top + R.Bottom) div 2)); + end + else + DoPopupMenu(nil, FFocusedColumn, Point(-1, -1)); + Ord('a'), Ord('A'): + if ssCtrl in Shift then + SelectAll(True) + else + DoStateChange([tsIncrementalSearchPending]); + else + begin + // Use the key for incremental search. + // Since we are dealing with Unicode all the time there should be a more sophisticated way + // of checking for valid characters for incremental search. + // This is available but would require to include a significant amount of Unicode character + // properties, so we stick with the simple space check. + if ((Shift * [ssCtrl, ssAlt] = []) or ((Shift * [ssCtrl, ssAlt] = [ssCtrl, ssAlt]))) and (CharCode >= 32) then + DoStateChange([tsIncrementalSearchPending]); + end; + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMKeyUp(var Message: TWMKeyUp); + +begin + inherited; + + case Message.CharCode of + VK_TAB: + EnsureNodeFocused(); // Always select a node if the control gets the focus via TAB key, #237 + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMKillFocus(var Msg: TWMKillFocus); + +var + Form: TCustomForm; + Control: TWinControl; + Pos: TSmallPoint; + Unknown: IUnknown; + +begin + inherited; + + // Remove hint if shown currently. + if tsHint in Self.FStates then + Application.CancelHint; + + // Stop wheel panning if active. + StopWheelPanning; + + // Don't let any timer continue if the tree is no longer the active control (except change timers). + StopTimer(ExpandTimer); + StopTimer(EditTimer); + StopTimer(HeaderTimer); + StopTimer(ScrollTimer); + StopTimer(SearchTimer); + FSearchBuffer := ''; + FLastSearchNode := nil; + + DoStateChange([], [tsScrollPending, tsScrolling, tsEditPending, tsLeftButtonDown, tsRightButtonDown, + tsMiddleButtonDown, tsOLEDragPending, tsVCLDragPending, tsIncrementalSearching, tsNodeHeightTrackPending, + tsNodeHeightTracking]); + + if (FSelectionCount > 0) or not (toGhostedIfUnfocused in FOptions.PaintOptions) then + Invalidate + else + if Assigned(FFocusedNode) then + InvalidateNode(FFocusedNode); + + // Workaround for wrapped non-VCL controls (like TWebBrowser), which do not use VCL mechanisms and + // leave the ActiveControl property in the wrong state, which causes trouble when the control is refocused. + Form := GetParentForm(Self); + if Assigned(Form) and (Form.ActiveControl = Self) then + begin + Cardinal(Pos) := GetMessagePos; + Control := FindVCLWindow(SmallPointToPoint(Pos)); + // Every control derived from TOleControl has potentially the focus problem. In order to avoid including + // the OleCtrls unit (which will, among others, include Variants), which would allow to test for the TOleControl + // class, the IOleClientSite interface is used for the test, which is supported by TOleControl and a good indicator. + if Assigned(Control) and Control.GetInterface(IOleClientSite, Unknown) then + Form.ActiveControl := nil; + + // For other classes the active control should not be modified. Otherwise you need two clicks to select it. + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMLButtonDblClk(var Message: TWMLButtonDblClk); + +var + HitInfo: THitInfo; + +begin + DoStateChange([tsLeftDblClick]); + try + // get information about the hit, before calling inherited, is this may change the scroll postion and so the node under the mouse would chnage and would no longer be the one the user actually clicked + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + HandleMouseDblClick(Message, HitInfo); + // Call inherited after doing our standard handling, as the event handler may close the form or re-fill the control, so our clicked node would be no longer valid. + // Our standard handling does not do that. + inherited; + // #909 + // if we show a modal form in the HandleMouseDblClick(), the mouse capture wont be released + if csCaptureMouse in ControlStyle then MouseCapture := False; + finally + DoStateChange([], [tsLeftDblClick]); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMLButtonDown(var Message: TWMLButtonDown); + +var + HitInfo: THitInfo; + +begin + DoStateChange([tsLeftButtonDown]); + inherited; + + // get information about the hit + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + HandleMouseDown(Message, HitInfo); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMLButtonUp(var Message: TWMLButtonUp); + +var + HitInfo: THitInfo; + +begin + DoStateChange([], [tsLeftButtonDown, tsNodeHeightTracking, tsNodeHeightTrackPending]); + + // get information about the hit + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + HandleMouseUp(Message, HitInfo); + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMMButtonDblClk(var Message: TWMMButtonDblClk); + +var + HitInfo: THitInfo; + +begin + DoStateChange([tsMiddleDblClick]); + inherited; + + // get information about the hit + if toMiddleClickSelect in FOptions.SelectionOptions then + begin + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + HandleMouseDblClick(Message, HitInfo); + end; + DoStateChange([], [tsMiddleDblClick]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMMButtonDown(var Message: TWMMButtonDown); + +var + HitInfo: THitInfo; + +begin + DoStateChange([tsMiddleButtonDown]); + + if FHeader.States = [] then + begin + inherited; + + // Start wheel panning or scrolling if not already active, allowed and scrolling is useful at all. + if (toWheelPanning in FOptions.MiscOptions) and not (tsPanning in FStates) and + ((FRangeX > ClientWidth) or (FRangeY > ClientHeight)) then + begin + FLastClickPos := SmallPointToPoint(Message.Pos); + StartWheelPanning(FLastClickPos); + end + else + begin + StopWheelPanning; + + // Get information about the hit. + if toMiddleClickSelect in FOptions.SelectionOptions then + begin + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + HandleMouseDown(Message, HitInfo); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMMButtonUp(var Message: TWMMButtonUp); + +var + HitInfo: THitInfo; + +begin + DoStateChange([], [tsMiddleButtonDown]); + + if not (tsPanning in FStates) then + if FHeader.States = [] then + begin + inherited; + + // get information about the hit + if toMiddleClickSelect in FOptions.SelectionOptions then + begin + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + HandleMouseUp(Message, HitInfo); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMNCCalcSize(var Message: TWMNCCalcSize); + +begin + inherited; + + with FHeader do + if hoVisible in FHeader.Options then + with Message.CalcSize_Params^ do + Inc(rgrc[0].Top, Height); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMNCDestroy(var Message: TWMNCDestroy); + +// Used to release a reference of the drag manager. This is the only reliable way we get notified about +// window destruction, because of the automatic release of a window if its parent window is freed. + +begin + InterruptValidation; + + StopTimer(ChangeTimer); + StopTimer(StructureChangeTimer); + + if not (csDesigning in ComponentState) and HandleAllocated then + RevokeDragDrop(Handle); + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMNCHitTest(var Message: TWMNCHitTest); + +begin + inherited; + if (hoVisible in FHeader.Options) and + FHeader.InHeader(ScreenToClient(SmallPointToPoint(Message.Pos))) then + Message.Result := HTBORDER; +end; + +//---------------------------------------------------------------------------------------------------------------------- + + +procedure TBaseVirtualTree.WMNCPaint(var Message: TWMNCPaint); + +var + DC: HDC; + R: TRect; + Flags: DWORD; + ExStyle: Integer; + TempRgn: HRGN; + BorderWidth, + BorderHeight: Integer; + +begin + if tsUseThemes in FStates then + begin + // If theming is enabled and the client edge border is set for the window then prevent the default window proc + // from painting the old border to avoid flickering. + ExStyle := GetWindowLong(Handle, GWL_EXSTYLE); + if (ExStyle and WS_EX_CLIENTEDGE) <> 0 then + begin + GetWindowRect(Handle, R); + // Determine width of the client edge. + BorderWidth := GetSystemMetrics(SM_CXEDGE); + BorderHeight := GetSystemMetrics(SM_CYEDGE); + InflateRect(R, -BorderWidth, -BorderHeight); + TempRgn := CreateRectRgnIndirect(R); + // Exclude the border from the message region if there is one. Otherwise just use the inflated + // window area region. + if Message.Rgn <> 1 then + CombineRgn(TempRgn, Message.Rgn, TempRgn, RGN_AND); + DefWindowProc(Handle, Message.Msg, WPARAM(TempRgn), 0); + DeleteObject(TempRgn); + end + else + DefaultHandler(Message); + end + else + DefaultHandler(Message); + + Flags := DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE; + + if (Message.Rgn = 1) then + DC := GetDCEx(Handle, 0, Flags) + else + DC := GetDCEx(Handle, Message.Rgn, Flags or DCX_INTERSECTRGN); + + if DC <> 0 then + try + OriginalWMNCPaint(DC); + finally + ReleaseDC(Handle, DC); + end; + if (((tsUseThemes in FStates) and not VclStyleEnabled) or (VclStyleEnabled and (seBorder in StyleElements))) then + StyleServices.PaintBorder(Self, False) + else + if (VclStyleEnabled and not (seBorder in StyleElements)) then + TStyleManager.SystemStyle.PaintBorder(Self, False) +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMPaint(var Message: TWMPaint); +var + DC: HDC; +begin + if tsVCLDragging in FStates then + ImageList_DragShowNolock(False); + if csPaintCopy in ControlState then + FUpdateRect := ClientRect + else + GetUpdateRect(Handle, FUpdateRect, True); + + inherited; + + if tsVCLDragging in FStates then + ImageList_DragShowNolock(True); + + if hoVisible in FHeader.Options then + begin + DC := GetDCEx(Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE); + if DC <> 0 then + try + FHeader.Columns.PaintHeader(DC, FHeaderRect, -FEffectiveOffsetX); + finally + ReleaseDC(Handle, DC); + end; + end;//if header visible +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMPaste(var Message: TWMPaste); + +begin + PasteFromClipboard; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMPrint(var Message: TWMPrint); + +// This message is sent to request that the tree draws itself to a given device context. This includes not only +// the client area but also the non-client area (header!). + +begin + // Draw only if the window is visible or visibility is not required. + if ((Message.Flags and PRF_CHECKVISIBLE) = 0) or IsWindowVisible(Handle) then + Header.Columns.PaintHeader(Message.DC, FHeaderRect, -FEffectiveOffsetX); + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMRButtonDblClk(var Message: TWMRButtonDblClk); + +var + HitInfo: THitInfo; + +begin + DoStateChange([tsRightDblClick]); + inherited; + + // get information about the hit + if toMiddleClickSelect in FOptions.SelectionOptions then + begin + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + HandleMouseDblClick(Message, HitInfo); + end; + DoStateChange([], [tsRightDblClick]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMRButtonDown(var Message: TWMRButtonDown); + +var + HitInfo: THitInfo; + RemoveSynchMode: Boolean; // Needed to restore tsSynchMode correctly + +begin + DoStateChange([tsRightButtonDown]); + + if FHeader.States = [] then + begin + inherited; + + // get information about the hit + if toRightClickSelect in FOptions.SelectionOptions then + begin + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + // Go temporarily into sync mode to avoid a delayed change event for the node when selecting. #679 + RemoveSynchMode := not (tsSynchMode in FStates); + Include(FStates, tsSynchMode); + HandleMouseDown(Message, HitInfo); + if RemoveSynchMode then + Exclude(FStates, tsSynchMode); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMRButtonUp(var Message: TWMRButtonUp); + +// handle right click selection and node specific popup menu + +var + HitInfo: THitInfo; + +begin + DoStateChange([], [tsRightButtonDown]); + + if FHeader.States = [] then + begin + Application.CancelHint; + + if IsMouseSelecting and Assigned(PopupMenu) then + begin + // Reset selection state already here, before the inherited handler opens the default menu. + DoStateChange([], [tsDrawSelecting, tsDrawSelPending]); + Invalidate; + end; + + inherited; + + // get information about the hit + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + + if toRightClickSelect in FOptions.SelectionOptions then + HandleMouseUp(Message, HitInfo); + + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMSetCursor(var Message: TWMSetCursor); + +// Sets the hot node mouse cursor for the tree. Cursor changes for the header are handled in Header.HandleMessage. + +var + NewCursor: TCursor; + HitInfo: THitInfo; + P: TPoint; + Node: PVirtualNode; + +begin + with Message do + begin + // Feature: design-time header #415 + // Allow header to handle cursor and return control's default if it did nothing + if (CursorWnd = Handle) and not (tsPanning in FStates) then + begin + if not TVTHeaderCracker(FHeader).HandleMessage(TMessage(Message)) then + begin + // Apply own cursors only if there is no global cursor set. + if Screen.Cursor = crDefault then + begin + // node resizing and hot tracking - for run-time only + if not (csDesigning in ComponentState) then + begin + NewCursor := crDefault; + if (toNodeHeightResize in FOptions.MiscOptions) then + begin + GetCursorPos(P); + P := ScreenToClient(P); + GetHitTestInfoAt(P.X, P.Y, True, HitInfo, []); + if (hiOnItem in HitInfo.HitPositions) and + ([hiUpperSplitter, hiLowerSplitter] * HitInfo.HitPositions <> []) then + begin + if hiUpperSplitter in HitInfo.HitPositions then + Node := GetPreviousVisible(HitInfo.HitNode, True) + else + Node := HitInfo.HitNode; + + if CanSplitterResizeNode(P, Node, HitInfo.HitColumn) then + NewCursor := crVSplit; + end; + end; + + if (NewCursor = crDefault) then + if (toHotTrack in FOptions.PaintOptions) and Assigned(FCurrentHotNode) and (FHotCursor <> crDefault) then + NewCursor := FHotCursor + else + NewCursor := Cursor; + + DoGetCursor(NewCursor); + end + else + NewCursor := Cursor; + Winapi.Windows.SetCursor(Screen.Cursors[NewCursor]); + Message.Result := 1; + end + else + inherited; + end; + end + else + inherited; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMSetFocus(var Msg: TWMSetFocus); + +begin + inherited; + if (FSelectionCount > 0) or not (toGhostedIfUnfocused in FOptions.PaintOptions) then + Invalidate; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMSize(var Message: TWMSize); + +begin + inherited; + + // Need to update scroll bars here. This will cause a recursion because of the change of the client area + // when changing a scrollbar. Usually this is no problem since with the second level recursion no change of the + // window size happens (the same values for the scrollbars are set, which shouldn't cause a window size change). + // Appearently, this applies not to all systems, however. + if HandleAllocated and ([tsSizing, tsWindowCreating] * FStates = []) and (ClientHeight > 0) then + try + DoStateChange([tsSizing]); + // This call will invalidate the entire non-client area which needs recalculation on resize. + TVTHeaderCracker(FHeader).RescaleHeader; + TVTHeaderCracker(FHeader).UpdateSpringColumns; + UpdateScrollBars(True); + + if (tsEditing in FStates) and not FHeader.UseColumns then + UpdateEditBounds; + finally + DoStateChange([], [tsSizing]); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMThemeChanged(var Message: TMessage); + +begin + inherited; + + if StyleServices.Enabled and (toThemeAware in TreeOptions.PaintOptions) then + DoStateChange([tsUseThemes]) + else + DoStateChange([], [tsUseThemes]); + + // Updating the visuals here will not work correctly. Therefore we postpone + // the update by using a timer. + if not FChangingTheme then + SetTimer(Handle, ThemeChangedTimer, ThemeChangedTimerDelay, nil); + FChangingTheme := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMTimer(var Message: TWMTimer); + +// centralized timer handling happens here + +begin + with Message do + begin + case TimerID of + ExpandTimer: + DoDragExpand; + EditTimer: + DoEdit; + ScrollTimer: + begin + if tsScrollPending in FStates then + begin + Application.CancelHint; + // Scroll delay has elapsed, set to normal scroll interval now. + SetTimer(Handle, ScrollTimer, FAutoScrollInterval, nil); + DoStateChange([tsScrolling], [tsScrollPending]); + end; + DoTimerScroll; + end; + ChangeTimer: + if tsChangePending in FStates then // see issue #602 + DoChange(FLastChangedNode); + ChangeCellTimer: + if tsChangeCellPending in FStates then + DoChangeCell(FSelectedCells); + StructureChangeTimer: + DoStructureChange(FLastStructureChangeNode, FLastStructureChangeReason); + SearchTimer: + begin + // When this event triggers then the user did not pressed any key for the specified timeout period. + // Hence incremental searching is stopped. + DoStateChange([], [tsIncrementalSearching]); + StopTimer(SearchTimer); + FSearchBuffer := ''; + FLastSearchNode := nil; + end; + ThemeChangedTimer: + begin + StopTimer(ThemeChangedTimer); + RecreateWnd; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WMVScroll(var Message: TWMVScroll); + + //--------------- local functions ------------------------------------------- + + function GetRealScrollPosition: TDimension; + + var + SI: TScrollInfo; + Bar: Integer; + + begin + SI.cbSize := SizeOf(TScrollInfo); + SI.fMask := SIF_TRACKPOS; + Bar := SB_VERT; + GetScrollInfo(Bar, SI); + Result := SI.nTrackPos; + end; + + //--------------- end local functions --------------------------------------- + +begin + case Message.ScrollCode of + SB_BOTTOM: + SetOffsetY(-FRoot.TotalHeight); + SB_ENDSCROLL: + begin + DoStateChange([], [tsThumbTracking]); + // Avoiding to adjust the horizontal scroll position while tracking makes scrolling much smoother + // but we need to adjust the final position here then. + UpdateScrollBars(True); + // Really weird invalidation needed here (and I do it only because it happens so rarely), because + // when showing the horizontal scrollbar while scrolling down using the down arrow button, + // the button will be repainted on mouse up (at the wrong place in the far right lower corner)... + RedrawWindow(nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_NOERASE or RDW_NOCHILDREN); + end; + SB_LINEUP: + SetOffsetY(FOffsetY + FScrollBarOptions.VerticalIncrement); + SB_LINEDOWN: + SetOffsetY(FOffsetY - FScrollBarOptions.VerticalIncrement); + SB_PAGEUP: + SetOffsetY(FOffsetY + ClientHeight); + SB_PAGEDOWN: + SetOffsetY(FOffsetY - ClientHeight); + + SB_THUMBPOSITION, + SB_THUMBTRACK: + begin + DoStateChange([tsThumbTracking]); + SetOffsetY(-GetRealScrollPosition); + end; + SB_TOP: + SetOffsetY(0); + end; + Message.Result := 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AddToSelection(Node: PVirtualNode; NotifySynced: Boolean); + +var + Changed: Boolean; + RemoveSyncAfterChange: Boolean; +begin + if not FSelectionLocked then + begin + Assert(Assigned(Node), 'Node must not be nil!'); + Changed := InternalAddToSelection(Node, False); + if Changed then + begin + UpdateNextNodeToSelect(Node); + if (SelectedCount = 1) then + FocusedNode := Node; // if only one node is selected, make sure the focused node changes with the selected node + InvalidateNode(Node); + RemoveSyncAfterChange := NotifySynced and not (tsSynchMode in fStates); + if RemoveSyncAfterChange then + Include(FStates, tsSynchMode); + try + Change(Node); + finally + if RemoveSyncAfterChange then + Exclude(FStates, tsSynchMode); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AddToSelection(const NewItems: TNodeArray; NewLength: Integer; ForceInsert: Boolean = False); + +// Adds the given items all at once into the current selection array. NewLength is the amount of +// nodes to add (necessary to allow NewItems to be larger than the actual used entries). +// ForceInsert is True if nodes must be inserted without consideration of level select constraint or +// already set selected flags (e.g. when loading from stream). +// Note: In the case ForceInsert is True the caller is responsible for making sure the new nodes aren't already in the +// selection array! + +var + Changed: Boolean; + +begin + Changed := InternalAddToSelection(NewItems, NewLength, ForceInsert); + if Changed then + begin + if NewLength = 1 then + begin + InvalidateNode(NewItems[0]); + Change(NewItems[0]); + end + else + begin + Invalidate; + Change(nil); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var NextNonEmpty: TColumnIndex); + +// Used in descendants to modify the paint rectangle of the current column while painting a certain node. + +begin + // Since cells are always drawn from left to right the next column index is independent of the + // bidi mode, but not the column borders, which might change depending on the cell's content. + NextNonEmpty := FHeader.Columns.GetNextVisibleColumn(PaintInfo.Column); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AdjustPanningCursor(X, Y: TDimension); + +// Triggered by a mouse move when wheel panning/scrolling is active. +// Loads the proper cursor which indicates into which direction scrolling is done. + +var + NewCursor: TPanningCursor; + NewCursorHandle: HCURSOR; + ScrollHorizontal, + ScrollVertical: Boolean; + +begin + ScrollHorizontal := FRangeX > ClientWidth; + ScrollVertical := FRangeY > ClientHeight; + + if (Abs(X - FLastClickPos.X) < 8) and (Abs(Y - FLastClickPos.Y) < 8) then + begin + // Mouse is in the neutral zone. + if ScrollHorizontal then + begin + if ScrollVertical then + NewCursor := TPanningCursor.MOVEALL + else + NewCursor := TPanningCursor.MOVEEW; + end + else + NewCursor := TPanningCursor.MOVENS; + end + else + begin + // One of 8 directions applies: north, north-east, east, south-east, south, south-west, west and north-west. + // Check also if scrolling in the particular direction is possible. + if ScrollVertical and ScrollHorizontal then + begin + // All directions allowed. + if X - FLastClickPos.X < -8 then + begin + // Left hand side. + if Y - FLastClickPos.Y < -8 then + NewCursor := TPanningCursor.MOVENW + else + if Y - FLastClickPos.Y > 8 then + NewCursor := TPanningCursor.MOVESW + else + NewCursor := TPanningCursor.MOVEW; + end + else + if X - FLastClickPos.X > 8 then + begin + // Right hand side. + if Y - FLastClickPos.Y < -8 then + NewCursor := TPanningCursor.MOVENE + + else + if Y - FLastClickPos.Y > 8 then + NewCursor := TPanningCursor.MOVESE + else + NewCursor := TPanningCursor.MOVEE; + end + else + begin + // Up or down. + if Y < FLastClickPos.Y then + NewCursor := TPanningCursor.MOVEN + else + NewCursor := TPanningCursor.MOVES; + end; + end + else + if ScrollHorizontal then + begin + // Only horizontal movement allowed. + if X < FLastClickPos.X then + NewCursor := TPanningCursor.MOVEW + else + NewCursor := TPanningCursor.MOVEE; + end + else + begin + // Only vertical movement allowed. + if Y < FLastClickPos.Y then + NewCursor := TPanningCursor.MOVEN + else + NewCursor := TPanningCursor.MOVES; + end; + end; + + // Now load the cursor and apply it. + NewCursorHandle := LoadCursor(0, MAKEINTRESOURCE(NewCursor)); + if FPanningCursor <> NewCursorHandle then + begin + DeleteObject(FPanningCursor); + FPanningCursor := NewCursorHandle; + Winapi.Windows.SetCursor(FPanningCursor); + end + else + DeleteObject(NewCursorHandle); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AdviseChangeEvent(StructureChange: Boolean; Node: PVirtualNode; Reason: TChangeReason); + +// Used to register a delayed change event. If StructureChange is False then we have a selection change event (without +// a specific reason) otherwise it is a structure change. + +begin + if StructureChange then + begin + if tsStructureChangePending in FStates then + StopTimer(StructureChangeTimer) + else + DoStateChange([tsStructureChangePending]); + + FLastStructureChangeNode := Node; + if FLastStructureChangeReason = crIgnore then + FLastStructureChangeReason := Reason + else + if Reason <> crIgnore then + FLastStructureChangeReason := crAccumulated; + end + else + begin + if tsChangePending in FStates then + StopTimer(ChangeTimer) + else + DoStateChange([tsChangePending]); + + FLastChangedNode := Node; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AdviseChangeCellEvent(const Cells: TVTCellArray); +begin + if tsChangeCellPending in FStates then + StopTimer(ChangeCellTimer) + else + DoStateChange([tsChangeCellPending]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.AllocateInternalDataArea(Size: Cardinal): Cardinal; + +// Simple registration method to be called by each descendant to claim their internal data area. +// Result is the offset from the begin of the node to the internal data area of the calling tree class. + +begin + Assert((FRoot = nil) or (FRoot.ChildCount = 0), 'Internal data allocation must be done before any node is created.'); + Result := TreeNodeSize + FTotalInternalDataSize; + System.Inc(FTotalInternalDataSize, (Size + (SizeOf(Pointer) - 1)) and not (SizeOf(Pointer) - 1)); + InitRootNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.Animate(Steps, Duration: Cardinal; Callback: TVTAnimationCallback; Data: Pointer); + +// This method does the calculation part of an animation as used for node toggling and hint animations. +// Steps is the maximum amount of animation steps to do and Duration determines the milliseconds the animation +// has to run. Callback is a task specific method which is called in the loop for every step and Data is simply +// something to pass on to the callback. +// The callback is called with the current step, the current step size and the Data parameter. Since the step amount +// as well as the step size are possibly adjusted during the animation, it is impossible to determine if the current +// step is the last step, even if the original step amount is known. To solve this problem the callback will be +// called after the loop has finished with a step size of 0 indicating so to execute any post processing. + +var + StepSize, + RemainingTime, + RemainingSteps, + NextTimeStep, + CurrentStep, + StartTime: Cardinal; + CurrentTime: Int64; + +begin + if not (tsInAnimation in FStates) and (Duration > 0) then + begin + DoStateChange([tsInAnimation]); + try + RemainingTime := Duration; + RemainingSteps := Steps; + + // Determine the initial step size which is either 1 if the needed steps are less than the number of + // steps possible given by the duration or > 1 otherwise. + StepSize := Round(Max(1, RemainingSteps / Duration)); + RemainingSteps := RemainingSteps div StepSize; + CurrentStep := 0; + + while (RemainingSteps > 0) and (RemainingTime > 0) and not Application.Terminated do + begin + StartTime := timeGetTime; + NextTimeStep := StartTime + RemainingTime div RemainingSteps; + if not Callback(CurrentStep, StepSize, Data) then + Break; + + // Keep duration for this step for rest calculation. + CurrentTime := timeGetTime; + // Wait until the calculated time has been reached. + while CurrentTime < NextTimeStep do + CurrentTime := timeGetTime; + + // Subtract the time this step really needed. + if RemainingTime >= CurrentTime - StartTime then + begin + System.Dec(RemainingTime, CurrentTime - StartTime); + System.Dec(RemainingSteps); + end + else + begin + RemainingTime := 0; + RemainingSteps := 0; + end; + // If the remaining time per step is less than one time step then we have to decrease the + // step count and increase the step size. + if (RemainingSteps > 0) and ((RemainingTime div RemainingSteps) < 1) then + begin + repeat + System.Inc(StepSize); + RemainingSteps := RemainingTime div StepSize; + until (RemainingSteps <= 0) or ((RemainingTime div RemainingSteps) >= 1); + end; + CurrentStep := Steps - RemainingSteps; + end; + + if not Application.Terminated then + Callback(0, 0, Data); + finally + DoStateChange([], [tsInAnimation]); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.StartOperation(OperationKind: TVTOperationKind); + +// Called to indicate that a long-running operation has been started. + +begin + System.Inc(FOperationCount); + if FOperationCount = 1 then + FOperationCanceled := False; + DoStartOperation(OperationKind); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CalculateSelectionRect(X, Y: TDimension): Boolean; + +// Recalculates old and new selection rectangle given that X, Y are new mouse coordinates. +// Returns True if there was a change since the last call. + +var + MaxValue: TDimension; + +begin + if tsDrawSelecting in FStates then + FLastSelRect := FNewSelRect; + FNewSelRect.BottomRight := Point(X + FEffectiveOffsetX, Y - FOffsetY); + if FNewSelRect.Right < 0 then + FNewSelRect.Right := 0; + if FNewSelRect.Bottom < 0 then + FNewSelRect.Bottom := 0; + MaxValue := ClientWidth; + if FRangeX > MaxValue then + MaxValue := FRangeX; + if FNewSelRect.Right > MaxValue then + FNewSelRect.Right := MaxValue; + MaxValue := ClientHeight; + if FRangeY > MaxValue then + MaxValue := FRangeY; + if FNewSelRect.Bottom > MaxValue then + FNewSelRect.Bottom := MaxValue; + + Result := not CompareMem(@FLastSelRect, @FNewSelRect, SizeOf(FNewSelRect)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CanAutoScroll: Boolean; + +// Determines if auto scrolling is currently allowed. + +var + IsDropTarget: Boolean; + IsDrawSelecting: Boolean; + IsWheelPanning: Boolean; + +begin + // Don't scroll the client area if the header is currently doing tracking or dragging. + // Do auto scroll only if there is a draw selection in progress or the tree is the current drop target or + // wheel panning/scrolling is active. + IsDropTarget := Assigned(FDragManager) and DragManager.IsDropTarget; + IsDrawSelecting := [tsDrawSelPending, tsDrawSelecting] * 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; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CanShowDragImage: Boolean; + +// Determines whether a drag image should be shown. + +begin + Result := FDragImageKind <> diNoImage; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex): Boolean; + +begin + Result := (toNodeHeightResize in FOptions.MiscOptions) and Assigned(Node) and (Node <> FRoot) and + (Column > NoColumn) and (coFixed in FHeader.Columns[Column].Options); + DoCanSplitterResizeNode(P, Node, Column, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.Change(Node: PVirtualNode); + +begin + AdviseChangeEvent(False, Node, crIgnore); + + if FUpdateCount = 0 then + begin + if (FChangeDelay > 0) and HandleAllocated and not (tsSynchMode in FStates) then + SetTimer(Handle, ChangeTimer, FChangeDelay, nil) + else + DoChange(Node); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ChangeCell(const Cells: TVTCellArray); +begin + AdviseChangeCellEvent(Cells); + + if FUpdateCount = 0 then + begin + if (FChangeDelay > 0) and HandleAllocated and not (tsSynchMode in FStates) then + SetTimer(Handle, ChangeCellTimer, FChangeDelay, nil) + else + DoChangeCell(Cells); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; isDpiChange: Boolean{$ifend}); +begin + if (M <> D) then + begin + BeginUpdate(); + try + ScaleNodeHeights(M, D); + SetDefaultNodeHeight(MulDiv(FDefaultNodeHeight, M, D)); + Indent := MulDiv(Indent, M, D); + FTextMargin := MulDiv(FTextMargin, M, D); + FMargin := MulDiv(FMargin, M, D); + FImagesMargin := MulDiv(FImagesMargin, M, D); + finally + EndUpdate(); + end;//try..finally + end;// if M<>D + inherited ChangeScale(M, D{$if CompilerVersion >= 31}, isDpiChange{$ifend}); + if (M <> D) then + begin + // Scale header + TVTHeaderCracker(FHeader).ChangeScale(M, D); + // Scale utility images, #796 + if FCheckImageKind = ckSystemDefault then begin + FreeAndNil(FCheckImages); + if HandleAllocated then + FCheckImages := CreateSystemImageSet(); + end; + UpdateHeaderRect(); + PrepareBitmaps(True, False); // See issue #991 + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ScaleNodeHeights(M, D: TDimension); +var + Run: PVirtualNode; + lNewNodeTotalHeight: Cardinal; +begin + // Scale also node heights + BeginUpdate(); + try + Run := GetFirstNoInit(); + while Assigned(Run) do + begin + if vsInitialized in Run.States then + SetNodeHeight(Run, MulDiv(Run.NodeHeight, M, D)) + else // prevent initialization of non-initialzed nodes + begin + Run.SetNodeHeight(MulDiv(Run.NodeHeight, M, D)); + // The next three lines fix issue #1000 + lNewNodeTotalHeight := MulDiv(Run.TotalHeight, M, D); + FRoot.TotalHeight := Cardinal(Int64(FRoot.TotalHeight) + Int64(lNewNodeTotalHeight) - Int64(Run.TotalHeight)); // Avoiding EIntOverflow exception. + Run.TotalHeight := lNewNodeTotalHeight; + end; + Run := GetNextNoInit(Run); + end; // while + finally + EndUpdate(); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ChangeTreeStatesAsync(EnterStates, LeaveStates: TVirtualTreeStates); +begin + //TODO: If this works reliable, move to TWorkerThread + if not (csDestroying in ComponentState) then + begin + AtomicIncrement(FPendingSyncProcs); + TThread.Synchronize(nil, procedure + begin + //Decrement invoke refs + AtomicDecrement(FPendingSyncProcs); + // Prevent invalid combination tsUseCache + tsValidationNeeded (#915) + if not ((tsUseCache in EnterStates) and (tsValidationNeeded in FStates + LeaveStates)) then + DoStateChange(EnterStates, LeaveStates); + if (tsValidating in FStates) and (tsValidating in LeaveStates) then + UpdateEditBounds(); + end); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CheckParentCheckState(Node: PVirtualNode; NewCheckState: TCheckState): Boolean; + +// Checks all siblings of node to determine which check state Node's parent must get. + +var + CheckCount, + BoxCount: Cardinal; + PartialCheck: Boolean; + Run: PVirtualNode; + +begin + CheckCount := 0; + BoxCount := 0; + PartialCheck := False; + Run := Node.Parent.FirstChild; + while Assigned(Run) do + begin + if Run = Node then + begin + // The given node cannot be checked because it does not yet have its new check state (as this depends + // on the outcome of this method). Instead NewCheckState is used as this contains the new state the node + // will get if this method returns True. + if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then + begin + System.Inc(BoxCount); + if NewCheckState.IsChecked then + System.Inc(CheckCount); + PartialCheck := PartialCheck or (NewCheckState = csMixedNormal); + end; + end + else + if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then + begin + System.Inc(BoxCount); + if GetCheckState(Run).IsChecked then + System.Inc(CheckCount); + PartialCheck := PartialCheck or (GetCheckState(Run) = csMixedNormal); + end; + Run := Run.NextSibling; + end; + + if (CheckCount = 0) and not PartialCheck then + NewCheckState := csUncheckedNormal + else + if CheckCount < BoxCount then + NewCheckState := csMixedNormal + else + NewCheckState := csCheckedNormal; + + Node := Node.Parent; + Result := DoChecking(Node, NewCheckState); + if Result then + begin + DoCheckClick(Node, NewCheckState); + // Recursively adjust parent of parent. + // This is already done in the function DoCheckClick() called in the above line + // We revent unnecessary upward recursion by commenting this code. + // with Node^ do + // begin + // if not (vsInitialized in Parent.States) then + // InitNode(Parent); + // if ([vsChecking, vsDisabled] * Parent.States = []) and (Parent <> FRoot) and + // (Parent.CheckType = ctTriStateCheckBox) then + // Result := CheckParentCheckState(Node, NewCheckState); + // end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ClearTempCache; + +// make sure the temporary node cache is in a reliable state + +begin + FTempNodeCache := nil; + FTempNodeCount := 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; + +// Returns True if the given column is to be considered as being empty. This will usually be determined by +// descendants as the base tree implementation has not enough information to decide. + +begin + Result := True; + if Assigned(FOnGetCellIsEmpty) then + FOnGetCellIsEmpty(Self, Node, Column, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ComputeRTLOffset(ExcludeScrollBar: Boolean): TDimension; + +// Computes the horizontal offset needed when all columns are automatically right aligned (in RTL bidi mode). +// ExcludeScrollBar determines if the left-hand vertical scrollbar is to be included (if visible) or not. + +var + HeaderWidth: TDimension; + ScrollBarVisible: Boolean; +begin + ScrollBarVisible := (FRangeY > ClientHeight) and (ScrollBarOptions.ScrollBars in [TScrollStyle.ssVertical, TScrollStyle.ssBoth]); + if ScrollBarVisible then + Result := GetSystemMetrics(SM_CXVSCROLL) + else + Result := 0; + + // Make everything right aligned. + HeaderWidth := FHeaderRect.Right - FHeaderRect.Left; + if FRangeX + Result <= HeaderWidth then + Result := HeaderWidth - FRangeX; + // Otherwise take only left-hand vertical scrollbar into account. + + if ScrollBarVisible and ExcludeScrollBar then + Dec(Result, GetSystemMetrics(SM_CXVSCROLL)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CountLevelDifference(Node1, Node2: PVirtualNode): Integer; + +// This method counts how many indentation levels the given nodes are apart. If both nodes have the same parent then the +// difference is 0 otherwise the result is basically GetNodeLevel(Node2) - GetNodeLevel(Node1), but with sign. +// If the result is negative then Node2 is less intended than Node1. + +var + Level1, Level2: Integer; + +begin + Assert(Assigned(Node1) and Assigned(Node2), 'Both nodes must be Assigned.'); + + Level1 := 0; + while Node1.Parent <> FRoot do + begin + System.Inc(Level1); + Node1 := Node1.Parent; + end; + + Level2 := 0; + while Node2.Parent <> FRoot do + begin + System.Inc(Level2); + Node2 := Node2.Parent; + end; + + Result := Level2 - Level1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CountVisibleChildren(Node: PVirtualNode): Cardinal; + +// Returns the number of visible child nodes of the given node. + +begin + Result := 0; + + // The node's direct children... + if vsExpanded in Node.States then + begin + // ...and their children. + Node := Node.FirstChild; + while Assigned(Node) do + begin + if vsVisible in Node.States then + System.Inc(Result, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); + Node := Node.NextSibling; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CreateParams(var Params: TCreateParams); + +const + ScrollBar: array[TScrollStyle] of Cardinal = (0, WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL); + +begin + inherited CreateParams(Params); + + with Params do + begin + Style := Style or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or ScrollBar[ScrollBarOptions.ScrollBars]; + if toFullRepaintOnResize in FOptions.MiscOptions then + WindowClass.style := WindowClass.style or CS_HREDRAW or CS_VREDRAW + else + WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW); + if FBorderStyle = bsSingle then + begin + if Ctl3D then + begin + ExStyle := ExStyle or WS_EX_CLIENTEDGE; + Style := Style and not WS_BORDER; + end + else + Style := Style or WS_BORDER; + end + else + Style := Style and not WS_BORDER; + + AddBiDiModeExStyle(ExStyle); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CreateWnd; + +// Initializes data which depends on a valid window handle. + +begin + VclStyleChanged(); // Moved here due to issue #986 + DoStateChange([tsWindowCreating]); + inherited; + DoStateChange([], [tsWindowCreating]); + + if not Assigned(FCheckImages) then + FCheckImages := CreateSystemImageSet(); + + if ((StyleServices.Enabled ) and (toThemeAware in TreeOptions.PaintOptions) ) then + begin + DoStateChange([tsUseThemes]); + if (toUseExplorerTheme in FOptions.PaintOptions) then + begin + DoStateChange([tsUseExplorerTheme]); + SetWindowTheme('explorer'); + end + else + DoStateChange([], [tsUseExplorerTheme]); + end + else + DoStateChange([], [tsUseThemes, tsUseExplorerTheme]); + + AutoScale(); + // Because of the special recursion and update stopper when creating the window (or resizing it) + // we have to manually trigger the auto size calculation here. + if hsNeedScaling in FHeader.States then + TVTHeaderCracker(FHeader).RescaleHeader; + if hoAutoResize in FHeader.Options then + TVirtualTreeColumnsCracker(FHeader.Columns).AdjustAutoSize(InvalidColumn); + + PrepareBitmaps(True, True); + + // Register tree as OLE drop target. + 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; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.FakeReadIdent(Reader: TReader); +begin + Assert(Reader.NextValue = vaIdent); + Reader.ReadIdent; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DecVisibleCount; +begin + System.Dec(FVisibleCount); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DefineProperties(Filer: TFiler); + +// There were heavy changes in some properties during development of VT. This method helps to make migration easier +// by reading old properties manually and put them into the new properties as appropriate. +// Note: these old properties are never written again and silently disappear. +// June 2002: Meanwhile another task is done here too: working around the problem that TCollection is not streamed +// correctly when using Visual Form Inheritance (VFI). + +var + StoreIt: Boolean; + +begin + inherited; + + // The header can prevent writing columns altogether. + if TVTHeaderCracker(FHeader).CanWriteColumns then + begin + // Check if we inherit from an ancestor form (Visual Form Inheritance). + StoreIt := Filer.Ancestor = nil; + // If there is an ancestor then save columns only if they are different to the base set. + if not StoreIt then + StoreIt := not FHeader.Columns.Equals(TBaseVirtualTree(Filer.Ancestor).FHeader.Columns); + end + else + StoreIt := False; + + Filer.DefineProperty('Columns', TVTHeaderCracker(FHeader).ReadColumns, TVTHeaderCracker(FHeader).WriteColumns, StoreIt); + + // #622 made old DFMs incompatible with new VTW - so the program is compiled successfully + // and then suddenly crashes at user site in runtime. + Filer.DefineProperty('CheckImageKind', FakeReadIdent, nil, false); + /// #730 removed property HintAnimation + Filer.DefineProperty('HintAnimation', FakeReadIdent, nil, false); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect): TDropMode; + +// Determine the DropMode. + +var + ImageHit: Boolean; + LabelHit: Boolean; + ItemHit: Boolean; + +begin + ImageHit := HitInfo.HitPositions * [hiOnNormalIcon, hiOnStateIcon] <> []; + LabelHit := hiOnItemLabel in HitInfo.HitPositions; + ItemHit := (hiOnItem in HitInfo.HitPositions); + + // In report mode only direct hits of the node captions/images in the main column are accepted as hits. + if (toReportMode in FOptions.MiscOptions) and not (ItemHit or ((LabelHit or ImageHit) and + (HitInfo.HitColumn = FHeader.MainColumn))) then + HitInfo.HitNode := nil; + + if Assigned(HitInfo.HitNode) then + begin + if LabelHit or ImageHit or not (toShowDropmark in FOptions.PaintOptions) then + Result := dmOnNode + else + if Divide(NodeRect.Top + NodeRect.Bottom, 2) > P.Y then + Result := dmAbove + else + Result := dmBelow; + end + else + Result := dmNowhere; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DetermineHiddenChildrenFlag(Node: PVirtualNode); + +// Update the hidden children flag of the given node. + +var + Run: PVirtualNode; + +begin + if Node.ChildCount = 0 then + begin + if vsHasChildren in Node.States then + Exclude(Node.States, vsAllChildrenHidden) + else + Include(Node.States, vsAllChildrenHidden); + end + else + begin + // Iterate through all siblings and stop when one visible is found. + Run := Node.FirstChild; + while Assigned(Run) and not IsEffectivelyVisible[Run] do + Run := Run.NextSibling; + if Assigned(Run) then + Exclude(Node.States, vsAllChildrenHidden) + else + Include(Node.States, vsAllChildrenHidden); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DetermineHiddenChildrenFlagAllNodes; + +var + Run: PVirtualNode; + +begin + Run := GetFirstNoInit(False); + while Assigned(Run) do + begin + DetermineHiddenChildrenFlag(Run); + Run := GetNextNoInit(Run); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: TDimension; + Alignment: TAlignment); + +// This method determines the hit position within a node with left-to-right orientation. + +var + MainColumnHit: Boolean; + lIndent, + TextWidth, + ImageOffset: TDimension; + lOffsets: TVTOffsets; +begin + MainColumnHit := HitInfo.HitColumn = FHeader.MainColumn; + GetOffsets(HitInfo.HitNode, lOffsets, ofsRightOfText, HitInfo.HitColumn); + + if (MainColumnHit and (Offset < lOffsets[ofsCheckbox])) then + begin + // Position is to the left of calculated indentation which can only happen for the main column. + // Check whether it corresponds to a button/checkbox. + if (toShowButtons in FOptions.PaintOptions) and (vsHasChildren in HitInfo.HitNode.States) then + begin + // Position of button is interpreted very generously to avoid forcing the user + // to click exactly into the 9x9 pixels area. The entire node height and one full + // indentation level is accepted as button hit. + if Offset >= lOffsets[ofsCheckbox] - FIndent then + Include(HitInfo.HitPositions, hiOnItemButton); + if Offset > lOffsets[ofsToggleButton] then + Include(HitInfo.HitPositions, hiOnItemButtonExact); + end; + // no button hit so position is on indent + if HitInfo.HitPositions = [] then + Include(HitInfo.HitPositions, hiOnItemIndent); + end + else + begin + // The next hit positions can be: + // - on the check box + // - on the state image + // - on the normal image + // - to the left of the text area + // - on the label or + // - to the right of the text area + // (in this order). + + // In report mode no hit other than in the main column is possible. + if MainColumnHit or not (toReportMode in FOptions.MiscOptions) then + begin + if MainColumnHit and (Offset < lOffsets[ofsStateImage]) then + begin + HitInfo.HitPositions := [hiOnItem]; + if (HitInfo.HitNode.CheckType <> ctNone) then + Include(HitInfo.HitPositions, hiOnItemCheckBox); + end + else + begin + ImageOffset := lOffsets[ofsImage]; + if Offset < ImageOffset then + Include(HitInfo.HitPositions, hiOnStateIcon) + else + begin + ImageOffset := lOffsets[ofsLabel]; + if Offset < ImageOffset then + Include(HitInfo.HitPositions, hiOnNormalIcon) + else + begin + TextWidth := lOffsets[ofsRightOfText] - lOffsets[ofsText]; + // ImageOffset contains now the left border of the node label area. This is used to calculate the + // correct alignment in the column. + + // Check if the text can be aligned at all. This is only possible if there is enough room + // in the remaining text rectangle. + if TextWidth > Right - ImageOffset then + Include(HitInfo.HitPositions, hiOnItemLabel) + else + begin + case Alignment of + taCenter: + begin + lIndent := Divide(ImageOffset + Right - TextWidth, 2); + if Offset < lIndent then + Include(HitInfo.HitPositions, hiOnItemLeft) + else + if Offset < lIndent + TextWidth then + Include(HitInfo.HitPositions, hiOnItemLabel) + else + Include(HitInfo.HitPositions, hiOnItemRight); + end; + taRightJustify: + begin + lIndent := Right - TextWidth; + if Offset < lIndent then + Include(HitInfo.HitPositions, hiOnItemLeft) + else + Include(HitInfo.HitPositions, hiOnItemLabel); + end; + else // taLeftJustify + if Offset < ImageOffset + TextWidth then + Include(HitInfo.HitPositions, hiOnItemLabel) + else + Include(HitInfo.HitPositions, hiOnItemRight); + end; + end; + end; + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: TDimension; Alignment: TAlignment); + +// This method determines the hit position within a node with right-to-left orientation. + +var + MainColumnHit: Boolean; + Run: PVirtualNode; + Indent, + TextWidth, + ImageOffset: TDimension; + +begin + MainColumnHit := HitInfo.HitColumn = FHeader.MainColumn; + + // If columns are not used or the main column is hit then the tree indentation must be considered too. + if MainColumnHit then + begin + if toFixedIndent in FOptions.PaintOptions then + Dec(Right, FIndent) + else + begin + Run := HitInfo.HitNode; + while (Run.Parent <> FRoot) do + begin + Dec(Right, FIndent); + Run := Run.Parent; + end; + if toShowRoot in FOptions.PaintOptions then + Dec(Right, FIndent); + end; + end; + + if Offset >= Right then + begin + // Position is to the right of calculated indentation which can only happen for the main column. + // Check whether it corresponds to a button/checkbox. + if (toShowButtons in FOptions.PaintOptions) and (vsHasChildren in HitInfo.HitNode.States) then + begin + // Position of button is interpreted very generously to avoid forcing the user + // to click exactly into the 9x9 pixels area. The entire node height and one full + // indentation level is accepted as button hit. + if Offset <= Right + FIndent then + Include(HitInfo.HitPositions, hiOnItemButton); + if Offset <= Right + FPlusBM.Width then + Include(HitInfo.HitPositions, hiOnItemButtonExact); + end; + // no button hit so position is on indent + if HitInfo.HitPositions = [] then + Include(HitInfo.HitPositions, hiOnItemIndent); + end + else + begin + // The next hit positions can be: + // - on the check box + // - on the state image + // - on the normal image + // - to the left of the text area + // - on the label or + // - to the right of the text area + // (in this order). + + // In report mode no hit other than in the main column is possible. + if MainColumnHit or not (toReportMode in FOptions.MiscOptions) then + begin + ImageOffset := Right - FMargin; + + // Check support is only available for the main column. + if MainColumnHit and (toCheckSupport in FOptions.MiscOptions) and Assigned(FCheckImages) and + (HitInfo.HitNode.CheckType <> ctNone) then + Dec(ImageOffset, FCheckImages.Width + FImagesMargin); + + if MainColumnHit and (Offset > ImageOffset) then + begin + HitInfo.HitPositions := [hiOnItem]; + if (HitInfo.HitNode.CheckType <> ctNone) then + Include(HitInfo.HitPositions, hiOnItemCheckBox); + end + else + begin + Dec(ImageOffset, GetImageSize(HitInfo.HitNode, ikState, HitInfo.HitColumn).cx); + if Offset > ImageOffset then + Include(HitInfo.HitPositions, hiOnStateIcon) + else + begin + Dec(ImageOffset, GetImageSize(HitInfo.HitNode, ikNormal, HitInfo.HitColumn).cx); + if Offset > ImageOffset then + Include(HitInfo.HitPositions, hiOnNormalIcon) + else + begin + // ImageOffset contains now the right border of the node label area. This is used to calculate the + // correct alignment in the column. + TextWidth := DoGetNodeWidth(HitInfo.HitNode, HitInfo.HitColumn); + + // Check if the text can be aligned at all. This is only possible if there is enough room + // in the remaining text rectangle. + if TextWidth > ImageOffset then + Include(HitInfo.HitPositions, hiOnItemLabel) + else + begin + // Consider bidi mode here. In RTL context does left alignment actually mean right alignment + // and vice versa. + ChangeBiDiModeAlignment(Alignment); + + case Alignment of + taCenter: + begin + Indent := Divide(ImageOffset - TextWidth, 2); + if Offset < Indent then + Include(HitInfo.HitPositions, hiOnItemLeft) + else + if Offset < Indent + TextWidth then + Include(HitInfo.HitPositions, hiOnItemLabel) + else + Include(HitInfo.HitPositions, hiOnItemRight); + end; + taRightJustify: + begin + Indent := ImageOffset - TextWidth; + if Offset < Indent then + Include(HitInfo.HitPositions, hiOnItemLeft) + else + Include(HitInfo.HitPositions, hiOnItemLabel); + end; + else // taLeftJustify + if Offset > TextWidth then + Include(HitInfo.HitPositions, hiOnItemRight) + else + Include(HitInfo.HitPositions, hiOnItemLabel); + end; + end; + end; + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DetermineLineImageAndSelectLevel(Node: PVirtualNode; var LineImage: TLineImage): Integer; + +// This method is used during paint cycles and initializes an array of line type IDs. These IDs are used to paint +// the tree lines in front of the given node. +// Additionally an initial count of selected parents is determined and returned which is used for specific painting. + +var + X: Integer; + Indent: Integer; + Run: PVirtualNode; + +begin + Result := 0; + if toShowRoot in FOptions.PaintOptions then + X := 1 + else + X := 0; + Run := Node; + // Determine indentation level of top node. + while Run.Parent <> FRoot do + begin + System.Inc(X); + Run := Run.Parent; + // Count selected nodes (FRoot is never selected). + if vsSelected in Run.States then + System.Inc(Result); + end; + + // Set initial size of line index array, this will automatically initialized all entries to ltNone. + SetLength(LineImage, X); + Indent := X - 1; + + // Only use lines if requested. + if (toShowTreeLines in FOptions.PaintOptions) and + (not (toHideTreeLinesIfThemed in FOptions.PaintOptions) or not (tsUseThemes in FStates)) then + begin + if toChildrenAbove in FOptions.PaintOptions then + begin + System.Dec(X); + if not HasVisiblePreviousSibling(Node) then + begin + if (Node.Parent <> FRoot) or HasVisibleNextSibling(Node) then + LineImage[X] := ltBottomRight + else + LineImage[X] := ltRight; + end + else + if (Node.Parent = FRoot) and (not HasVisibleNextSibling(Node)) then + LineImage[X] := ltTopRight + else + LineImage[X] := ltTopDownRight; + + // Now go up to the root to determine the rest. + Run := Node.Parent; + while Run <> FRoot do + begin + System.Dec(X); + if HasVisiblePreviousSibling(Run) then + LineImage[X] := ltTopDown + else + LineImage[X] := ltNone; + + Run := Run.Parent; + end; + end + else + begin + // Start over parent traversal if necessary. + Run := Node; + + if Run.Parent <> FRoot then + begin + // The very last image (the one immediately before the item label) is different. + if HasVisibleNextSibling(Run) then + LineImage[X - 1] := ltTopDownRight + else + LineImage[X - 1] := ltTopRight; + Run := Run.Parent; + + // Now go up all parents. + repeat + if Run.Parent = FRoot then + Break; + System.Dec(X); + if HasVisibleNextSibling(Run) then + LineImage[X - 1] := ltTopDown + else + LineImage[X - 1] := ltNone; + Run := Run.Parent; + until False; + end; + + // Prepare root level. Run points at this stage to a top level node. + if (toShowRoot in FOptions.PaintOptions) and ((toShowTreeLines in FOptions.PaintOptions) and + (not (toHideTreeLinesIfThemed in FOptions.PaintOptions) or not (tsUseThemes in FStates))) then + begin + // Is the top node a root node? + if Run = Node then + begin + // First child gets the bottom-right bitmap if it isn't also the only child. + if IsFirstVisibleChild(FRoot, Run) then + // Is it the only child? + if IsLastVisibleChild(FRoot, Run) then + LineImage[0] := ltRight + else + LineImage[0] := ltBottomRight + else + // real last child + if IsLastVisibleChild(FRoot, Run) then + LineImage[0] := ltTopRight + else + LineImage[0] := ltTopDownRight; + end + else + begin + // No, top node is not a top level node. So we need different painting. + if HasVisibleNextSibling(Run) then + LineImage[0] := ltTopDown + else + LineImage[0] := ltNone; + end; + end; + end; + end; + + if (tsUseExplorerTheme in FStates) and HasChildren[Node] and (Indent >= 0) + and not ((vsAllChildrenHidden in Node.States) and (toAutoHideButtons in TreeOptions.AutoOptions)) then + LineImage[Indent] := ltNone; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DetermineNextCheckState(CheckType: TCheckType; CheckState: TCheckState): TCheckState; + +// Determines the next check state in case the user click the check image or pressed the space key. + +begin + case CheckType of + ctTriStateCheckBox, + ctButton, + ctCheckBox: + begin + Result := CheckState.GetToggled(); + end;//ctCheckbox + ctRadioButton: + Result := csCheckedNormal; + else + Result := csMixedNormal; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DetermineScrollDirections(X, Y: TDimension): TScrollDirections; + +// Determines which direction the client area must be scrolled depending on the given position. + +begin + Result:= []; + + if CanAutoScroll then + begin + // Calculation for wheel panning/scrolling is a bit different to normal auto scroll. + if tsPanning in FStates then + begin + if (X - FLastClickPos.X) < -8 then + Include(Result, TScrollDirection.sdLeft); + if (X - FLastClickPos.X) > 8 then + Include(Result, TScrollDirection.sdRight); + + if (Y - FLastClickPos.Y) < -8 then + Include(Result, TScrollDirection.sdUp); + if (Y - FLastClickPos.Y) > 8 then + Include(Result, TScrollDirection.sdDown); + end + else + begin + if (X < FDefaultNodeHeight) and (FEffectiveOffsetX <> 0) then + Include(Result, TScrollDirection.sdLeft); + if (ClientWidth + FEffectiveOffsetX < FRangeX) and (X > ClientWidth - FDefaultNodeHeight) then + Include(Result, TScrollDirection.sdRight); + + if (Y < FDefaultNodeHeight) and (FOffsetY <> 0) then + Include(Result, TScrollDirection.sdUp); + if (ClientHeight - FOffsetY < FRangeY) and (Y > ClientHeight - FDefaultNodeHeight) then + Include(Result, TScrollDirection.sdDown); + + // Since scrolling during dragging is not handled via the timer we do a check here whether the auto + // scroll timeout already has elapsed or not. + if (Result <> []) and + ((Assigned(FDragManager) and DragManager.IsDropTarget) or + (FindDragTarget(Point(X, Y), False) = Self)) then + begin + if FDragScrollStart = 0 then + FDragScrollStart := timeGetTime; + // Reset any scroll direction to avoid scroll in the case the user is dragging and the auto scroll time has not + // yet elapsed. + if ((Int64(timeGetTime) - FDragScrollStart) < FAutoScrollDelay) then + Result := []; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoAddToSelection(Node: PVirtualNode); +begin + if Assigned(FOnAddToSelection) then + FOnAddToSelection(Self, Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoAdvancedHeaderDraw(var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements); + +begin + if Assigned(FOnAdvancedHeaderDraw) then + FOnAdvancedHeaderDraw(FHeader, PaintInfo, Elements); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoAfterCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); + +begin + if Assigned(FOnAfterCellPaint) then + FOnAfterCellPaint(Self, Canvas, Node, Column, CellRect); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoAfterItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); + +begin + if Assigned(FOnAfterItemErase) then + FOnAfterItemErase(Self, Canvas, Node, ItemRect); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoAfterItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); + +begin + if Assigned(FOnAfterItemPaint) then + FOnAfterItemPaint(Self, Canvas, Node, ItemRect); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoAfterPaint(Canvas: TCanvas); + +begin + if Assigned(FOnAfterPaint) then + FOnAfterPaint(Self, Canvas); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoAutoScroll(X, Y: TDimension); + +begin + FScrollDirections := DetermineScrollDirections(X, Y); + + if not (tsPanning in FStates) then + begin + if FScrollDirections = [] then + begin + if ((FStates * [tsScrollPending, tsScrolling]) <> []) then + begin + StopTimer(ScrollTimer); + DoStateChange([], [tsScrollPending, tsScrolling]); + end; + end + else + begin + // start auto scroll if not yet done + if (FStates * [tsScrollPending, tsScrolling]) = [] then + begin + DoStateChange([tsScrollPending]); + SetTimer(Handle, ScrollTimer, FAutoScrollDelay, nil); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoBeforeDrag(Node: PVirtualNode; Column: TColumnIndex): Boolean; + +begin + Result := False; + if Assigned(FOnDragAllowed) then + FOnDragAllowed(Self, Node, Column, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoBeforeCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); + +var + UpdateRect: TRect; + +begin + if Assigned(FOnBeforeCellPaint) then + begin + if CellPaintMode = cpmGetContentMargin then + begin + // Prevent drawing if we are only about to get the margin. As this also clears the update rect we need to save it. + GetUpdateRect(Handle, UpdateRect, False); + SetUpdateState(True); + end; + + Canvas.Font.Assign(Self.Font); // Fixes issue #298 + FOnBeforeCellPaint(Self, Canvas, Node, Column, CellPaintMode, CellRect, ContentRect); + + if CellPaintMode = cpmGetContentMargin then + SetUpdateState(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoBeforeItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; var Color: TColor; + var EraseAction: TItemEraseAction); + +begin + if Assigned(FOnBeforeItemErase) then + FOnBeforeItemErase(Self, Canvas, Node, ItemRect, Color, EraseAction); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoBeforeItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect): Boolean; + +begin + // By default custom draw will not be used, so the tree handles drawing the node. + Result := False; + if Assigned(FOnBeforeItemPaint) then + FOnBeforeItemPaint(Self, Canvas, Node, ItemRect, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoBeforePaint(Canvas: TCanvas); + +begin + if Assigned(FOnBeforePaint) then + FOnBeforePaint(Self, Canvas); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoCancelEdit(): Boolean; + +// Called when the current edit action or a pending edit must be cancelled. + +begin + Result := DoEndEdit(True); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoEndEdit(pCancel: Boolean = False): Boolean; + +// Called to finish a current edit action or stop the edit timer if an edit operation is pending. +// Pass True if the edit should be cancelled, pass False if the new text should be used and saved. +// Returns True if editing was successfully ended/canceled or the control was not in edit mode. +// Returns False if the control could not leave the edit mode e.g. due to an invalid value that was entered. + +begin + StopTimer(EditTimer); + DoStateChange([], [tsEditPending]); + if not (tsEditing in FStates) then + Exit(True); + DoStateChange([], [tsEditing]); + if pCancel then + begin + Result := FEditLink.CancelEdit(); + if Result and Assigned(FOnEditCancelled) then + FOnEditCancelled(Self, FEditColumn); + end + else + begin + Result := FEditLink.EndEdit; + if Result and Assigned(FOnEdited) then + FOnEdited(Self, FFocusedNode, FEditColumn); + end; + FEditLink := nil; + TrySetFocus(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoCanEdit(Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); + +begin + if Assigned(FOnEditing) then + FOnEditing(Self, Node, Column, Allowed); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoCanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex; + var Allowed: Boolean); + +begin + if Assigned(FOnCanSplitterResizeNode) then + FOnCanSplitterResizeNode(Self, P, Node, Column, Allowed); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoChange(Node: PVirtualNode); + +begin + StopTimer(ChangeTimer); + if Assigned(FOnChange) then + FOnChange(Self, Node); + + // This is a good place to reset the cached node. This is the same as the node passed in here. + // This is necessary to allow descendants to override this method and get the node then. + DoStateChange([], [tsChangePending]); + FLastChangedNode := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoChangeCell(const Cells: TVTCellArray); +begin + StopTimer(ChangeCellTimer); + if Assigned(FOnChangeCell) then + begin + FOnChangeCell(Self, Cells); + end; + DoStateChange([], [tsChangeCellPending]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoCheckClick(Node: PVirtualNode; NewCheckState: TCheckState); + +begin + if ChangeCheckState(Node, NewCheckState) then + begin + DoChecked(Node); + if SyncCheckstateWithSelection[Node] then + begin + // selection should follow check state + if (NewCheckState = csCheckedNormal) then + Selected[node] := true + else + Selected[node] := false; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoChecked(Node: PVirtualNode); + +begin + if Assigned(FOnChecked) then + FOnChecked(Self, Node); + if (Self.UpdateCount = 0) then // See issue #1174 + NotifyAccessibleEvent(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoChecking(Node: PVirtualNode; var NewCheckState: TCheckState): Boolean; + +// Determines if a node is allowed to change its check state to NewCheckState. + +begin + if (toReadOnly in FOptions.MiscOptions) or (vsDisabled in Node.States) then + Result := False + else + begin + Result := True; + if Assigned(FOnChecking) then + FOnChecking(Self, Node, NewCheckState, Result); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoCollapsed(Node: PVirtualNode); +var + lFirstSelected: PVirtualNode; + lParent: PVirtualNode; +begin + if Assigned(FOnCollapsed) then + FOnCollapsed(Self, Node); + + if (Self.UpdateCount = 0) then // See issue #1174 + NotifyAccessibleEvent(); + + if (toAlwaysSelectNode in TreeOptions.SelectionOptions) then + begin + // Select the next visible parent if the currently selected node gets invisible due to a collapse + // This makes the VT behave more like the Win32 custom TreeView control + // This makes only sense no no multi selection is allowed and if there is a selected node at all + lFirstSelected := GetFirstSelected(); + if Assigned(lFirstSelected) and not FullyVisible[lFirstSelected] then + begin + lParent := GetVisibleParent(lFirstSelected); + Selected[lFirstSelected] := False; + Selected[lParent] := True; + end;//if + //if there is (still) no selected node, then use FNextNodeToSelect to select one + if SelectedCount = 0 then + EnsureNodeSelected(False); + end;//if +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoCollapsing(Node: PVirtualNode): Boolean; + +begin + Result := True; + if Assigned(FOnCollapsing) then + FOnCollapsing(Self, Node, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoColumnChecked(Column: TColumnIndex); +begin + if Assigned(FOnColumnChecked) then + FOnColumnChecked(Self.FHeader, Column); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoColumnChecking(Column: TColumnIndex; var NewCheckState: TCheckState): Boolean; + +// Determines if a column is allowed to change its check state to NewCheckState. + +begin + Result := True; + if Assigned(FOnColumnChecking) then + FOnColumnChecking(Self.Header, Column, NewCheckState, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoColumnClick(Column: TColumnIndex; Shift: TShiftState); + +begin + if Assigned(FOnColumnClick) then + FOnColumnClick(Self, Column, Shift); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoColumnDblClick(Column: TColumnIndex; Shift: TShiftState); + +begin + if Assigned(FOnColumnDblClick) then + FOnColumnDblClick(Self, Column, Shift); +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 + R: TRect; + Run: PVirtualNode; + +begin + if not (csLoading in ComponentState) and HandleAllocated then + begin + // Reset all vsHeightMeasured flags if we are in multiline mode. + Run := GetFirstInitialized; + while Assigned(Run) do + begin + if vsMultiline in Run.States then + Exclude(Run.States, vsHeightMeasured); + Run := GetNextInitialized(Run); + end; + if Header.Columns.UpdateCount = 0 then + UpdateHorizontalScrollBar(True); + if Column > NoColumn then + begin + // Invalidate client area from the current column all to the right (or left in RTL mode). + R := ClientRect; + if not (toAutoSpanColumns in FOptions.AutoOptions) then + if UseRightToLeftAlignment then + R.Right := FHeader.Columns[Column].Left + FHeader.Columns[Column].Width + ComputeRTLOffset + else + R.Left := FHeader.Columns[Column].Left; + InvalidateRect(@R, False); + FHeader.Invalidate(FHeader.Columns[Column], True); + end; + if [hsColumnWidthTracking, hsResizing] * FHeader.States = [hsColumnWidthTracking] then + UpdateWindow(); + + if not (IsUpdating) then + UpdateDesigner; // design time only + + if Assigned(FOnColumnResize) and not (hsResizing in FHeader.States) then + FOnColumnResize(FHeader, Column); + + // If the tree is currently in edit state then notify edit link. + if tsEditing in FStates then + UpdateEditBounds; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoColumnVisibilityChanged(const Column: TColumnIndex; Visible: Boolean); + // Triggers the OnColumnVisibilityChanged event. +begin + if Assigned(OnColumnVisibilityChanged) then + OnColumnVisibilityChanged(Self, Column, Visible); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoCompare(Node1, Node2: PVirtualNode; Column: TColumnIndex): Integer; + +begin + Result := 0; + if Assigned(FOnCompareNodes) then + FOnCompareNodes(Self, Node1, Node2, Column, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoCreateDataObject: IDataObject; + +begin + Result := nil; + if Assigned(FOnCreateDataObject) then + FOnCreateDataObject(Self, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoCreateDragManager: IVTDragManager; + +begin + Result := nil; + if Assigned(FOnCreateDragManager) then + FOnCreateDragManager(Self, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; + +begin + Result := nil; + if Assigned(FOnCreateEditor) then + FOnCreateEditor(Self, Node, Column, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoDragging(P: TPoint); + +// Initiates finally the drag'n drop operation and returns after DD is finished. + + //--------------- local function -------------------------------------------- + + function GetDragOperations: Integer; + + begin + if FDragOperations = [] then + Result := DROPEFFECT_COPY or DROPEFFECT_MOVE or DROPEFFECT_LINK + else + begin + Result := 0; + if doCopy in FDragOperations then + Result := Result or DROPEFFECT_COPY; + if doLink in FDragOperations then + Result := Result or DROPEFFECT_LINK; + if doMove in FDragOperations then + Result := Result or DROPEFFECT_MOVE; + end; + end; + + //--------------- end local function ---------------------------------------- + +var + AllowedEffects: Integer; + DragObject: TDragObject; + + DataObject: IDataObject; + +begin + DataObject := nil; + // Dragging is dragging, nothing else. + DoCancelEdit; + + if Assigned(FCurrentHotNode) then + begin + InvalidateNode(FCurrentHotNode); + FCurrentHotNode := nil; + end; + // Select the focused node if not already done. + if Assigned(FFocusedNode) and not (vsSelected in FFocusedNode.States) then + begin + InternalAddToSelection(FFocusedNode, False); + InvalidateNode(FFocusedNode); + end; + + UpdateWindow(); + + // Keep a list of all currently selected nodes as this list might change, + // but we have probably to delete currently selected nodes. + FDragSelection := GetSortedSelection(True); + try + DoStateChange([tsOLEDragging], [tsOLEDragPending, tsClearPending]); + + // An application might create a drag object like used during VCL dd. This is not required for OLE dd but + // required as parameter. + DragObject := nil; + DoStartDrag(DragObject); + DragObject.Free; + + DataObject := DragManager.DataObject; + PrepareDragImage(P, DataObject); + + FLastDropMode := dmOnNode; + // Don't forget to initialize the result. It might never be touched. + FLastDragEffect := DROPEFFECT_NONE; + AllowedEffects := GetDragOperations; + try + DragAndDrop(AllowedEffects, DataObject, FLastDragEffect); + DragManager.ForceDragLeave; + finally + GetCursorPos(P); + P := ScreenToClient(P); + DoEndDrag(Self, P.X, P.Y); + + // Finish the operation. + if (FLastDragEffect = DROPEFFECT_MOVE) and (toAutoDeleteMovedNodes in TreeOptions.AutoOptions) then + begin + // The operation was a move so delete the previously selected nodes. + DeleteSelectedNodes; + end; + + DoStateChange([], [tsOLEDragging]); + end; + finally + FDragSelection := nil; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoDragExpand; +begin + StopTimer(ExpandTimer); + if Assigned(FDropTargetNode) and (vsHasChildren in FDropTargetNode.States) and + not (vsExpanded in FDropTargetNode.States) then + begin + ToggleNode(FDropTargetNode); + UpdateWindow(); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoDragOver(Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; + var Effect: Integer): Boolean; + +begin + Result := False; + if Assigned(FOnDragOver) then + FOnDragOver(Self, Source, Shift, State, Pt, Mode, Effect, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoDragDrop(Source: TObject; const DataObject: TVTDragDataObject; const Formats: TFormatArray; + Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); + +begin + if Assigned(FOnDragDrop) then + FOnDragDrop(Self, Source, DataObject, Formats, Shift, Pt, Effect, Mode); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoBeforeDrawLineImage(Node: PVirtualNode; Level: Integer; var XPos: TDimension); + +begin + if Assigned(FOnBeforeDrawLineImage) then + FOnBeforeDrawLineImage(Self, Node, Level, XPos); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoEdit; + +begin + Application.CancelHint; + StopTimer(ScrollTimer); + StopTimer(EditTimer); + DoStateChange([], [tsEditPending]); + if Assigned(FFocusedNode) and not (vsDisabled in FFocusedNode.States) and + not (toReadOnly in FOptions.MiscOptions) and (FEditLink = nil) then + begin + InternalSetFocusedColumn(FEditColumn); + ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions, not (toDisableAutoscrollOnEdit in FOptions.AutoOptions)); + FEditLink := DoCreateEditor(FFocusedNode, FEditColumn); + if Assigned(FEditLink) then + begin + DoStateChange([tsEditing], [tsDrawSelecting, tsDrawSelPending, tsToggleFocusedSelection, tsOLEDragPending, + tsOLEDragging, tsClearPending, tsDrawSelPending, tsScrollPending, tsScrolling]); + if FEditLink.PrepareEdit(Self, FFocusedNode, FEditColumn) then + begin + UpdateEditBounds; + // Node needs repaint because the selection rectangle and static text must disappear. + InvalidateNode(FFocusedNode); + if not FEditLink.BeginEdit then + DoStateChange([], [tsEditing]); + end + else + DoStateChange([], [tsEditing]); + if not (tsEditing in FStates) then + FEditLink := nil; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoEndDrag(Target: TObject; X, Y: TDimension); + +// Does some housekeeping for VCL drag'n drop; + +begin + inherited; + + DragFinished; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoEndOperation(OperationKind: TVTOperationKind); + +begin + if Assigned(FOnEndOperation) then + FOnEndOperation(Self, OperationKind); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoEnter(); +begin + inherited; + EnsureNodeSelected(False); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoExpanded(Node: PVirtualNode); + +begin + if Assigned(FOnExpanded) then + FOnExpanded(Self, Node); + if (Self.UpdateCount = 0) then // See issue #1174 + NotifyAccessibleEvent(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoExpanding(Node: PVirtualNode): Boolean; + +begin + Result := True; + if Assigned(FOnExpanding) then + FOnExpanding(Self, Node, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoFocusChange(Node: PVirtualNode; Column: TColumnIndex); + +begin + if Assigned(FOnFocusChanged) then + FOnFocusChanged(Self, Node, Column); + NotifyAccessibleEvent(EVENT_OBJECT_LOCATIONCHANGE); + NotifyAccessibleEvent(EVENT_OBJECT_NAMECHANGE); + NotifyAccessibleEvent(EVENT_OBJECT_VALUECHANGE); + NotifyAccessibleEvent(EVENT_OBJECT_STATECHANGE); + NotifyAccessibleEvent(EVENT_OBJECT_SELECTION); + NotifyAccessibleEvent(EVENT_OBJECT_FOCUS); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoFocusChanging(OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex): Boolean; + +begin + Result := (OldColumn = NewColumn) or FHeader.AllowFocus(NewColumn); + if Assigned(FOnFocusChanging) then + FOnFocusChanging(Self, OldNode, NewNode, OldColumn, NewColumn, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoFocusNode(Node: PVirtualNode; Ask: Boolean); + +begin + if not (tsEditing in FStates) or EndEditNode then + begin + if Node = FRoot then + Node := nil; + if (FFocusedNode <> Node) and (not Ask or DoFocusChanging(FFocusedNode, Node, FFocusedColumn, FFocusedColumn)) then + begin + if Assigned(FFocusedNode) then + begin + // Do automatic collapsing of last focused node if enabled. This is however only done if + // old and new focused node have a common parent node. + if (toAutoExpand in FOptions.AutoOptions) and Assigned(Node) and (Node.Parent = FFocusedNode.Parent) and + (vsExpanded in FFocusedNode.States) then + ToggleNode(FFocusedNode) + else + InvalidateNode(FFocusedNode); + end; + FFocusedNode := Node; + end; + + // Have to scroll the node into view, even it is the same node as before. + if Assigned(FFocusedNode) then + begin + // Make sure a valid column is set if columns are used and no column has currently the focus. + // We should also check if the maincolumn is allowfocus + if FHeader.UseColumns and (not FHeader.Columns.IsValidColumn(FFocusedColumn)) + and FHeader.AllowFocus(FHeader.MainColumn) then + FFocusedColumn := FHeader.MainColumn; + // Do automatic expansion of the newly focused node if enabled. + if (toAutoExpand in FOptions.AutoOptions) and not (vsExpanded in FFocusedNode.States) then + ToggleNode(FFocusedNode); + InvalidateNode(FFocusedNode); + if (FUpdateCount = 0) and not (toDisableAutoscrollOnFocus in FOptions.AutoOptions) then + ScrollIntoView(FFocusedNode, (toCenterScrollIntoView in FOptions.SelectionOptions) and + (MouseButtonDown * FStates = []), not (toFullRowSelect in FOptions.SelectionOptions) ); + end; + + // Reset range anchor if necessary. + if FSelectionCount = 0 then + ResetRangeAnchor; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoFreeNode(Node: PVirtualNode); + +var + IntfData: IInterface; +begin + // Prevent invalid references + if Node = FLastChangedNode then + FLastChangedNode := nil; + if Node = FCurrentHotNode then + FCurrentHotNode := nil; + if Node = FDropTargetNode then + FDropTargetNode := nil; + if Node = FLastStructureChangeNode then + FLastStructureChangeNode := nil; + if Node = FFocusedNode then + FFocusedNode := nil; + if Node = FNextNodeToSelect then + UpdateNextNodeToSelect(Node); + if Node = FLastHitInfo.HitNode then + FLastHitInfo.HitNode := nil; + // fire event + if Assigned(FOnFreeNode) and ([vsInitialized, vsOnFreeNodeCallRequired] * Node.States <> []) then + FOnFreeNode(Self, Node); + + if vsReleaseCallOnUserDataRequired in Node.States then + begin + // Data may have been set to nil, in which case we can't call _Release on it + IntfData := GetInterfaceFromNodeData(Node); + if Assigned(IntfData) then + IntfData._Release(); + end; + + FreeMem(Node); + if Self.UpdateCount = 0 then + EnsureNodeSelected(True); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; + CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; + +// Determines the margins of the content rectangle caused by DoBeforeCellPaint. +// Note that shrinking the content rectangle results in positive margins whereas enlarging the content rectangle results +// in negative margins. + +var + CellRect, + ContentRect: TRect; + +begin + Result := Point(0, 0); + + if Assigned(FOnBeforeCellPaint) then // Otherwise DoBeforeCellPaint has no effect. + begin + if Canvas = nil then + Canvas := Self.Canvas; + + // Determine then node's cell rectangle and content rectangle before calling DoBeforeCellPaint. + CellRect := GetDisplayRect(Node, Column, True); + ContentRect := CellRect; + DoBeforeCellPaint(Canvas, Node, Column, cpmGetContentMargin, CellRect, ContentRect); + + // Calculate the changes caused by DoBeforeCellPaint. + case CellContentMarginType of + ccmtAllSides: + // Calculate the width difference and high difference. + Result := Point((CellRect.Right - CellRect.Left) - (ContentRect.Right - ContentRect.Left), + (CellRect.Bottom - CellRect.Top) - (ContentRect.Bottom - ContentRect.Top)); + ccmtTopLeftOnly: + // Calculate the left margin and top margin only. + Result := Point(ContentRect.Left - CellRect.Left, ContentRect.Top - CellRect.Top); + ccmtBottomRightOnly: + // Calculate the right margin and bottom margin only. + Result := Point(CellRect.Right - ContentRect.Right, CellRect.Bottom - ContentRect.Bottom); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoGetCursor(var Cursor: TCursor); + +begin + if Assigned(FOnGetCursor) then + FOnGetCursor(Self, Cursor); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoGetHeaderCursor(var Cursor: TVTCursor); + +begin + if Assigned(FOnGetHeaderCursor) then + FOnGetHeaderCursor(FHeader, Cursor); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoGetImageIndex(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var Index: TImageIndex): TCustomImageList; + +// Queries the application/descendant about certain image properties for a node. +// Returns a custom image list if given by the callee, otherwise nil. +const + cTVTImageKind2String: Array [TVTImageKind] of string = ('ikNormal', 'ikSelected', 'ikState', 'ikOverlay'); +begin + if (Kind = ikState) and Assigned(StateImages) then + Result := Self.StateImages + else + Result := Self.Images; + // First try the enhanced event to allow for custom image lists. + if Assigned(FOnGetImageEx) then + FOnGetImageEx(Self, Node, Kind, Column, Ghosted, Index, Result) + else if Assigned(FOnGetImage) then + FOnGetImage(Self, Node, Kind, Column, Ghosted, Index); + + Assert((Index < 0) or Assigned(Result), 'An image index was supplied for TVTImageKind.' + cTVTImageKind2String[Kind] + ' but no image list was supplied.'); + if not Assigned(Result) then + Index := -1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoGetImageText(Node: PVirtualNode; Kind: TVTImageKind; + Column: TColumnIndex; var ImageText: string); + +// Queries the application/descendant about alternative image text for a node. + +begin + if Assigned(FOnGetImageText) then + FOnGetImageText(Self, Node, Kind, Column, ImageText); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoGetLineStyle(var Bits: Pointer); + +begin + if Assigned(FOnGetLineStyle) then + FOnGetLineStyle(Self, Bits); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; + var LineBreakStyle: TVTTooltipLineBreakStyle): string; + +begin + Result := Hint; + LineBreakStyle := hlbDefault; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex; + var LineBreakStyle: TVTTooltipLineBreakStyle): string; + +begin + Result := Hint; + LineBreakStyle := hlbDefault; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; + +// Returns the pixel width of extra space occupied by node contents (for example, static text). + +begin + Result := 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; + +// Returns the pixel width of a node. + +begin + Result := 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoGetPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint): TPopupMenu; + +// Queries the application whether there is a node specific popup menu. + +var + Run: PVirtualNode; + AskParent: Boolean; + +begin + Result := nil; + if Assigned(FOnGetPopupMenu) then + begin + Run := Node; + + if Assigned(Run) then + begin + AskParent := True; + repeat + FOnGetPopupMenu(Self, Run, Column, Position, AskParent, Result); + Run := Run.Parent; + until (Run = FRoot) or Assigned(Result) or not AskParent; + end + else + FOnGetPopupMenu(Self, nil, NoColumn, Position, AskParent, Result); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoGetUserClipboardFormats(var Formats: TFormatEtcArray); + +begin + if Assigned(FOnGetUserClipboardFormats) then + FOnGetUserClipboardFormats(Self, Formats); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHeaderAddPopupItem(const Column: TColumnIndex; var Cmd: TAddPopupItemType); + +begin + if Assigned(FOnHeaderAddPopupItem) then + FOnHeaderAddPopupItem(Self, Column, Cmd); + +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHeaderClick(const HitInfo: TVTHeaderHitInfo); + +begin + if Assigned(FOnHeaderClick) then + FOnHeaderClick(FHeader, HitInfo); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHeaderDblClick(const HitInfo: TVTHeaderHitInfo); + +begin + if Assigned(FOnHeaderDblClick) then + FOnHeaderDblClick(FHeader, HitInfo); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHeaderDragged(Column: TColumnIndex; OldPosition: TColumnPosition); + +begin + if Assigned(FOnHeaderDragged) then + FOnHeaderDragged(FHeader, Column, OldPosition); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHeaderDraggedOut(Column: TColumnIndex; DropPosition: TPoint); + +begin + if Assigned(FOnHeaderDraggedOut) then + FOnHeaderDraggedOut(FHeader, Column, DropPosition); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoHeaderDragging(Column: TColumnIndex): Boolean; + +begin + Result := True; + if Assigned(FOnHeaderDragging) then + FOnHeaderDragging(FHeader, Column, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHeaderDraw(Canvas: TCanvas; Column: TVirtualTreeColumn; R: TRect; Hover, Pressed: Boolean; + DropMark: TVTDropMarkMode); + +begin + if Assigned(FOnHeaderDraw) then + FOnHeaderDraw(FHeader, Canvas, Column, R, Hover, Pressed, DropMark); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHeaderDrawQueryElements(var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); + +begin + if Assigned(FOnHeaderDrawQueryElements) then + FOnHeaderDrawQueryElements(FHeader, PaintInfo, Elements); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHeaderMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: TDimension); + +begin + if Assigned(FOnHeaderMouseDown) then + FOnHeaderMouseDown(FHeader, Button, Shift, X, Y); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHeaderMouseMove(Shift: TShiftState; X, Y: TDimension); + +begin + if Assigned(FOnHeaderMouseMove) then + FOnHeaderMouseMove(FHeader, Shift, X, Y); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHeaderMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: TDimension); + +begin + if Assigned(FOnHeaderMouseUp) then + FOnHeaderMouseUp(FHeader, Button, Shift, X, Y); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoHotChange(Old, New: PVirtualNode); + +begin + if Assigned(FOnHotChange) then + FOnHotChange(Self, Old, New); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoIncrementalSearch(Node: PVirtualNode; const Text: string): Integer; + +begin + Result := 0; + if Assigned(FOnIncrementalSearch) then + FOnIncrementalSearch(Self, Node, Text, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoInitChildren(Node: PVirtualNode; var ChildCount: Cardinal): Boolean; +/// The function calls the OnInitChildren and returns True if the event was called; it returns False if the caller can expect that no changes have been made to ChildCount +begin + if Assigned(FOnInitChildren) then + begin + FOnInitChildren(Self, Node, ChildCount); + Result := True; + end + else + Result := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoInitNode(Parent, Node: PVirtualNode; var InitStates: TVirtualNodeInitStates); + +begin + if Assigned(FOnInitNode) then + FOnInitNode(Self, Parent, Node, InitStates); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoKeyAction(var CharCode: Word; var Shift: TShiftState): Boolean; + +begin + Result := True; + if Assigned(FOnKeyAction) then + FOnKeyAction(Self, CharCode, Shift, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoLoadUserData(Node: PVirtualNode; Stream: TStream); + +begin + if Assigned(FOnLoadNode) then + if Node = FRoot then + FOnLoadNode(Self, nil, Stream) + else + FOnLoadNode(Self, Node, Stream); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: TDimension); + +begin + if not (vsInitialized in Node.States) then + InitNode(Node); + if Assigned(FOnMeasureItem) then + FOnMeasureItem(Self, TargetCanvas, Node, NodeHeight); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoMouseEnter(); + +begin + if Assigned(FOnMouseEnter) then + FOnMouseEnter(Self); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoMouseLeave; + +begin + if Assigned(FOnMouseLeave) then + FOnMouseLeave(Self); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoNodeCopied(Node: PVirtualNode); + +begin + if Assigned(FOnNodeCopied) then + FOnNodeCopied(Self, Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoNodeCopying(Node, NewParent: PVirtualNode): Boolean; + +begin + Result := True; + if Assigned(FOnNodeCopying) then + FOnNodeCopying(Self, Node, NewParent, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoNodeClick(const HitInfo: THitInfo); + +begin + if Assigned(FOnNodeClick) then + FOnNodeClick(Self, HitInfo); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoNodeDblClick(const HitInfo: THitInfo); + +begin + if Assigned(FOnNodeDblClick) then + FOnNodeDblClick(Self, HitInfo); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoNodeHeightDblClickResize(Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; + P: TPoint): Boolean; + +begin + Result := True; + if Assigned(FOnNodeHeightDblClickResize) then + FOnNodeHeightDblClickResize(Self, Node, Column, Shift, P, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoNodeHeightTracking(Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; + var TrackPoint: TPoint; P: TPoint): Boolean; + +begin + Result := True; + if Assigned(FOnNodeHeightTracking) then + FOnNodeHeightTracking(Self, Node, Column, Shift, TrackPoint, P, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoNodeMoved(Node: PVirtualNode); + +begin + if Assigned(FOnNodeMoved) then + FOnNodeMoved(Self, Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoNodeMoving(Node, NewParent: PVirtualNode): Boolean; + +begin + Result := True; + if Assigned(FOnNodeMoving) then + FOnNodeMoving(Self, Node, NewParent, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoPaintBackground(Canvas: TCanvas; R: TRect): Boolean; + +begin + Result := False; + if Assigned(FOnPaintBackground) then + FOnPaintBackground(Self, Canvas, R, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoPaintDropMark(Canvas: TCanvas; Node: PVirtualNode; R: TRect); + +// draws the drop mark into the given rectangle +// Note: Changed properties of the given canvas should be reset to their previous values. + +var + SaveBrushColor: TColor; + SavePenStyle: TPenStyle; + +begin + if FLastDropMode in [dmAbove, dmBelow] then + with Canvas do + begin + SavePenStyle := Pen.Style; + Pen.Style := psClear; + SaveBrushColor := Brush.Color; + Brush.Color := FColors.DropMarkColor; + + if FLastDropMode = dmAbove then + begin + Polygon([Point(R.Left + 2, R.Top), + Point(R.Right - 2, R.Top), + Point(R.Right - 2, R.Top + 6), + Point(R.Right - 6, R.Top + 2), + Point(R.Left + 6 , R.Top + 2), + Point(R.Left + 2, R.Top + 6) + ]); + end + else + Polygon([Point(R.Left + 2, R.Bottom - 1), + Point(R.Right - 2, R.Bottom - 1), + Point(R.Right - 2, R.Bottom - 8), + Point(R.Right - 7, R.Bottom - 3), + Point(R.Left + 7 , R.Bottom - 3), + Point(R.Left + 2, R.Bottom - 8) + ]); + Brush.Color := SaveBrushColor; + Pen.Style := SavePenStyle; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoPaintNode(var PaintInfo: TVTPaintInfo); + +begin +end; + +procedure TBaseVirtualTree.DoPaintText(Node: PVirtualNode; const Canvas: TCanvas; Column: TColumnIndex; TextType: TVSTTextType); +begin + if Assigned(FOnPaintText) then + FOnPaintText(Self, Canvas, Node, Column, TextType); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint); + +// Support for node dependent popup menus. + +var + Menu: TPopupMenu; + +begin + Menu := DoGetPopupMenu(Node, Column, Position); + + if Assigned(Menu) then + begin + DoStateChange([tsPopupMenuShown]); + StopTimer(EditTimer); + Menu.PopupComponent := Self; + with ClientToScreen(Position) do + Menu.Popup(X, Y); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoRemoveFromSelection(Node: PVirtualNode); + +begin + if Assigned(FOnRemoveFromSelection) then + FOnRemoveFromSelection(Self, Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoReset(Node: PVirtualNode); + +begin + if Assigned(FOnResetNode) then + FOnResetNode(Self, Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoSaveUserData(Node: PVirtualNode; Stream: TStream); + +begin + if Assigned(FOnSaveNode) then + if Node = FRoot then + FOnSaveNode(Self, nil, Stream) + else + FOnSaveNode(Self, Node, Stream); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoScroll(DeltaX, DeltaY: TDimension); + +begin + if Assigned(FOnScroll) then + FOnScroll(Self, DeltaX, DeltaY); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOptions; ClipRect: PRect = nil): Boolean; + +// Actual offset setter used to scroll the client area, update scroll bars and invalidating the header (all optional). +// Returns True if the offset really changed otherwise False is returned. + +var + DeltaX: TDimension; + DeltaY: TDimension; + DWPStructure: HDWP; + I: Integer; + P: TPoint; + R: TRect; + +begin + // Range check, order is important here. + if Value.X < (ClientWidth - FRangeX) then + Value.X := ClientWidth - FRangeX; + if Value.X > 0 then + Value.X := 0; + DeltaX := Value.X - FOffsetX; + if UseRightToLeftAlignment then + DeltaX := -DeltaX; + if Value.Y < (ClientHeight - FRangeY) then + Value.Y := ClientHeight - FRangeY; + if Value.Y > 0 then + Value.Y := 0; + DeltaY := Value.Y - FOffsetY; + + Result := (DeltaX <> 0) or (DeltaY <> 0); + if Result then + begin + FOffsetX := Value.X; + FOffsetY := Value.Y; + Result := True; + + if tsHint in Self.FStates then + Application.CancelHint; + if FUpdateCount = 0 then + begin + // The drag image from VCL controls need special consideration. + if tsVCLDragging in FStates then + ImageList_DragShowNolock(False); + + if (suoScrollClientArea in Options) and not (tsToggling in FStates) then + begin + // Have to invalidate the entire window if there's a background. + if (toShowBackground in FOptions.PaintOptions) and Assigned(FBackground.Graphic) then + begin + // Since we don't use ScrollWindow here we have to move all client windows ourselves. + DWPStructure := BeginDeferWindowPos(ControlCount); + for I := 0 to ControlCount - 1 do + if Controls[I] is TWinControl then + begin + with Controls[I] as TWinControl do + DWPStructure := DeferWindowPos(DWPStructure, Handle, 0, Left + DeltaX, Top + DeltaY, 0, 0, + SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOSIZE); + if DWPStructure = 0 then + Break; + end; + if DWPStructure <> 0 then + EndDeferWindowPos(DWPStructure); + InvalidateRect(nil, False); + end + else + begin + if (DeltaX <> 0) and (Header.Columns.GetVisibleFixedWidth > 0) then + begin + // When fixed columns exists we have to scroll separately horizontally and vertically. + // Horizontally is scroll only the client area not occupied by fixed columns and + // vertically entire client area (or clipping area if one exists). + R := ClientRect; + R.Left := Header.Columns.GetVisibleFixedWidth; + + ScrollWindow(Handle, DeltaX, 0, @R, @R); + if DeltaY <> 0 then + ScrollWindow(Handle, 0, DeltaY, ClipRect, ClipRect); + end + else + ScrollWindow(Handle, DeltaX, DeltaY, ClipRect, ClipRect); + end; + end; + + if suoUpdateNCArea in Options then + begin + if DeltaX <> 0 then + begin + UpdateHorizontalScrollBar(suoRepaintScrollBars in Options); + if (suoRepaintHeader in Options) and (hoVisible in FHeader.Options) then + FHeader.Invalidate(nil); + if not (tsSizing in FStates) and (FScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssHorizontal, System.UITypes.TScrollStyle.ssBoth]) then + UpdateVerticalScrollBar(suoRepaintScrollBars in Options); + end; + + if (DeltaY <> 0) and ([tsThumbTracking, tsSizing] * FStates = []) then + begin + UpdateVerticalScrollBar(suoRepaintScrollBars in Options); + if not (FHeader.UseColumns or IsMouseSelecting) and + (FScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssHorizontal, System.UITypes.TScrollStyle.ssBoth]) then + UpdateHorizontalScrollBar(suoRepaintScrollBars in Options); + end; + end; + + if tsVCLDragging in FStates then + ImageList_DragShowNolock(True); + end; + + // Finally update "hot" node if hot tracking is activated + GetCursorPos(P); + P := ScreenToClient(P); + if PtInRect(ClientRect, P) then + HandleHotTrack(P.X, P.Y); + + DoScroll(DeltaX, DeltaY); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoShowScrollBar(Bar: Integer; Show: Boolean); + +begin + ShowScrollBar(Bar, Show); + + if Assigned(FOnShowScrollBar) then + FOnShowScrollBar(Self, Bar, Show); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoStartDrag(var DragObject: TDragObject); + +begin + inherited; + + // Check if the application created an own drag object. This is needed to pass the correct source in + // OnDragOver and OnDragDrop. + if Assigned(DragObject) then + DoStateChange([tsUserDragObject]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoStartOperation(OperationKind: TVTOperationKind); + +begin + if Assigned(FOnStartOperation) then + FOnStartOperation(Self, OperationKind); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoStateChange(Enter: TVirtualTreeStates; Leave: TVirtualTreeStates = []); + +var + ActualEnter, + ActualLeave: TVirtualTreeStates; + +begin + if Assigned(FOnStateChange) then + begin + ActualEnter := Enter - FStates; + ActualLeave := FStates * Leave; + if (ActualEnter + ActualLeave) <> [] then + FOnStateChange(Self, Enter, Leave); + end; + FStates := FStates + Enter - Leave; + Assert(FStates * [tsUseCache, tsValidationNeeded] <> [tsUseCache, tsValidationNeeded], 'Invalid state. tsUseCache and tsValidationNeeded are mutually exclusive and must not be set at the same time'); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoStructureChange(Node: PVirtualNode; Reason: TChangeReason); + +begin + StopTimer(StructureChangeTimer); + if Assigned(FOnStructureChange) then + FOnStructureChange(Self, Node, Reason); + + // This is a good place to reset the cached node and reason. These are the same as the values passed in here. + // This is necessary to allow descendants to override this method and get them. + DoStateChange([], [tsStructureChangePending]); + FLastStructureChangeNode := nil; + FLastStructureChangeReason := crIgnore; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoTimerScroll; + +var + P, + ClientP: TPoint; + InRect, + Panning: Boolean; + R, + ClipRect: TRect; + DeltaX, + DeltaY: Integer; + +begin + GetCursorPos(P); + R := ClientRect; + ClipRect := R; + MapWindowPoints(Handle, 0, R, 2); + InRect := PtInRect(R, P); + ClientP := ScreenToClient(P); + Panning := tsPanning in FStates; + + if IsMouseSelecting or InRect or Panning then + begin + DeltaX := 0; + DeltaY := 0; + if sdUp in FScrollDirections then + begin + if Panning then + DeltaY := FLastClickPos.Y - ClientP.Y - 8 + else + if InRect then + DeltaY := Min(FScrollBarOptions.VerticalIncrement, ClientHeight) + else + DeltaY := Min(FScrollBarOptions.VerticalIncrement, ClientHeight) * Abs(R.Top - P.Y); + if FOffsetY = 0 then + Exclude(FScrollDirections, sdUp); + end; + + if sdDown in FScrollDirections then + begin + if Panning then + DeltaY := FLastClickPos.Y - ClientP.Y + 8 + else + if InRect then + DeltaY := -Min(FScrollBarOptions.VerticalIncrement, ClientHeight) + else + DeltaY := -Min(FScrollBarOptions.VerticalIncrement, ClientHeight) * Abs(P.Y - R.Bottom); + if (ClientHeight - FOffsetY) = FRangeY then + Exclude(FScrollDirections, sdDown); + end; + + if sdLeft in FScrollDirections then + begin + if Panning then + DeltaX := FLastClickPos.X - ClientP.X - 8 + else + if InRect then + DeltaX := FScrollBarOptions.HorizontalIncrement + else + DeltaX := FScrollBarOptions.HorizontalIncrement * Abs(R.Left - P.X); + if FEffectiveOffsetX = 0 then + Exclude(FScrollDirections, sdleft); + end; + + if sdRight in FScrollDirections then + begin + if Panning then + DeltaX := FLastClickPos.X - ClientP.X + 8 + else + if InRect then + DeltaX := -FScrollBarOptions.HorizontalIncrement + else + DeltaX := -FScrollBarOptions.HorizontalIncrement * Abs(P.X - R.Right); + + if (ClientWidth + FEffectiveOffsetX) = FRangeX then + Exclude(FScrollDirections, sdRight); + end; + + if UseRightToLeftAlignment then + DeltaX := - DeltaX; + + if IsMouseSelecting then + begin + // In order to avoid scrolling the area which needs a repaint due to the changed selection rectangle + // we limit the scroll area explicitely. + OffsetRect(ClipRect, DeltaX, DeltaY); + DoSetOffsetXY(Point(FOffsetX + DeltaX, FOffsetY + DeltaY), DefaultScrollUpdateFlags, @ClipRect); + // When selecting with the mouse then either update only the parts of the window which have been uncovered + // by the scroll operation if no change in the selection happend or invalidate and redraw the entire + // client area otherwise (to avoid the time consuming task of determining the display rectangles of every + // changed node). + if CalculateSelectionRect(ClientP.X, ClientP.Y) and HandleDrawSelection(ClientP.X, ClientP.Y) then + InvalidateRect(nil, False) + else + begin + // The selection did not change so invalidate only the part of the window which really needs an update. + // 1) Invalidate the parts uncovered by the scroll operation. Add another offset range, we have to + // scroll only one stripe but have to update two. + OffsetRect(ClipRect, DeltaX, DeltaY); + SubtractRect(ClipRect, ClientRect, ClipRect); + InvalidateRect(@ClipRect, False); + + // 2) Invalidate the selection rectangles. + UnionRect(ClipRect, OrderRect(FNewSelRect), OrderRect(FLastSelRect)); + OffsetRect(ClipRect, FOffsetX, FOffsetY); + InvalidateRect(@ClipRect, False); + end; + end + else + begin + // Scroll only if there is no drag'n drop in progress. Drag'n drop scrolling is handled in DragOver. + if ((FDragManager = nil) or not DragManager.IsDropTarget) and ((DeltaX <> 0) or (DeltaY <> 0)) then + DoSetOffsetXY(Point(FOffsetX + DeltaX, FOffsetY + DeltaY), DefaultScrollUpdateFlags, nil); + end; + UpdateWindow(); + + if (FScrollDirections = []) and not (tsPanning in FStates) then + begin + StopTimer(ScrollTimer); + DoStateChange([], [tsScrollPending, tsScrolling]); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoUpdating(State: TVTUpdateState); + +begin + if Assigned(FOnUpdating) then + FOnUpdating(Self, State); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DoValidateCache(): Boolean; + +// This method fills the cache, which is used to speed up searching for nodes. +// The strategy is simple: Take the current number of visible nodes and distribute evenly a number of marks +// (which are stored in FPositionCache) so that iterating through the tree doesn't cost too much time. +// If there are less than 'CacheThreshold' nodes in the tree then the cache remains empty. +// Result is True if the cache was filled without interruption, otherwise False. +// Note: You can adjust the maximum number of nodes between two cache entries by changing CacheThreshold. + +var + EntryCount, + Index: Cardinal; + CurrentNode, + Temp: PVirtualNode; + CurrentTop: TNodeHeight; +begin + EntryCount := 0; + if not (tsStopValidation in FStates) then + begin + if FStartIndex = 0 then + FPositionCache := nil; + + EntryCount := CalculateCacheEntryCount; + SetLength(FPositionCache, EntryCount); + if FStartIndex > EntryCount then + FStartIndex := EntryCount; + + // Optimize validation by starting with FStartIndex if set. + if (FStartIndex > 0) and Assigned(FPositionCache[FStartIndex - 1].Node) then + begin + // Index is the current entry in FPositionCache. + Index := FStartIndex - 1; + // Running term for absolute top value. + CurrentTop := FPositionCache[Index].AbsoluteTop; + // Running node pointer. + CurrentNode := FPositionCache[Index].Node; + end + else + begin + // Index is the current entry in FPositionCache. + Index := 0; + // Running term for absolute top value. + CurrentTop := 0; + // Running node pointer. + CurrentNode := GetFirstVisibleNoInit(nil, True); + end; + + // EntryCount serves as counter for processed nodes here. This value can always start at 0 as + // the validation either starts also at index 0 or an index which is always a multiple of CacheThreshold + // and EntryCount is only used with modulo CacheThreshold. + EntryCount := 0; + if Assigned(CurrentNode) then + begin + while not (tsStopValidation in FStates) do + begin + // If the cache is full then stop the loop. + if (Integer(Index) >= Length(FPositionCache)) then + Break; + if (EntryCount mod CacheThreshold) = 0 then + begin + // New cache entry to set up. + with FPositionCache[Index] do + begin + Node := CurrentNode; // 2 EAccessViolation seen here in TreeSize V4.3.1, 1 in V4.4.0 (Write of address 00000000) + AbsoluteTop := CurrentTop; + end; + System.Inc(Index); + end; + + Inc(CurrentTop, NodeHeight[CurrentNode]); + // Advance to next visible node. + Temp := GetNextVisibleNoInit(CurrentNode, True); + // If there is no further node then stop the loop. + if (Temp = nil) then // CHANGED: 17.09.2013 - Veit Zimmermann + Break; // CHANGED: 17.09.2013 - Veit Zimmermann + + CurrentNode := Temp; + System.Inc(EntryCount); + end; + end; + // Finalize the position cache so no nil entry remains there. + if not (tsStopValidation in FStates) and (Integer(Index) <= High(FPositionCache)) then + begin + SetLength(FPositionCache, Index + 1); + with FPositionCache[Index] do + begin + Node := CurrentNode; + AbsoluteTop := CurrentTop; + end; + end; + end; + + Result := (EntryCount > 0) and not (tsStopValidation in FStates); + + // In variable node height mode it might have happend that some or all of the nodes have been adjusted in their + // height. During validation updates of the scrollbars is disabled so let's do this here. + if Result and (toVariableNodeHeight in FOptions.MiscOptions) then + begin + TThread.Queue(nil, procedure begin UpdateScrollBars(True) end); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DragAndDrop(AllowedEffects: Dword; const DataObject: TVTDragDataObject; var DragEffect: Integer); +var + lDragEffect: DWord; // required for type compatibility with SHDoDragDrop +begin + lDragEffect := DWord(DragEffect); + SHDoDragDrop(Self.Handle, DataObject, nil, AllowedEffects, lDragEffect); // supports drag hints on Windows Vista and later + DragEffect := Integer(lDragEffect); + end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DragCanceled; + +// Does some housekeeping for VCL drag'n drop; + +begin + inherited; + + DragFinished; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DragDrop(const DataObject: TVTDragDataObject; KeyState: Integer; Pt: TPoint; + var Effect: Integer): HResult; + +var + Shift: TShiftState; + EnumFormat: IEnumFormatEtc; + Fetched: Integer; + OLEFormat: TFormatEtc; + Formats: TFormatArray; + +begin + StopTimer(ExpandTimer); + StopTimer(ScrollTimer); + DoStateChange([], [tsScrollPending, tsScrolling]); + Formats := nil; + + // Ask explicitly again whether the action is allowed. Otherwise we may accept a drop which is intentionally not + // allowed but cannot be prevented by the application because when the tree was scrolling while dropping + // no DragOver event is created by the OLE subsystem. + Result := DragOver(DragManager.DragSource, KeyState, dsDragMove, Pt, Effect); + try + if (Result <> NOERROR) or ((Effect and not DROPEFFECT_SCROLL) = DROPEFFECT_NONE) then + Result := E_FAIL + else + begin + try + Shift := KeysToShiftState(KeyState); + if tsRightButtonDown in FStates then + Include(Shift, ssRight) + else if tsMiddleButtonDown in FStates then + Include(Shift, ssMiddle) + else + Include(Shift, ssLeft); + Pt := ScreenToClient(Pt); + // Determine which formats we can get and pass them along with the data object to the drop handler. + Result := DataObject.EnumFormatEtc(DATADIR_GET, EnumFormat); + if Failed(Result) then + Abort; + Result := EnumFormat.Reset; + if Failed(Result) then + Abort; + // create a list of available formats + while EnumFormat.Next(1, OLEFormat, @Fetched) = S_OK do + begin + SetLength(Formats, Length(Formats) + 1); + Formats[High(Formats)] := OLEFormat.cfFormat; + end; + DoDragDrop(DragManager.DragSource, DataObject, Formats, Shift, Pt, Effect, FLastDropMode); + except + // An unhandled exception here leaks memory. + Application.HandleException(Self); + Result := E_UNEXPECTED; + end; + end; + finally + if Assigned(FDropTargetNode) then + begin + InvalidateNode(FDropTargetNode); + FDropTargetNode := nil; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DragEnter(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; + +// callback routine for the drop target interface + +var + Shift: TShiftState; + Accept: Boolean; + R: TRect; + HitInfo: THitInfo; + +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; + + Shift := KeysToShiftState(KeyState); + if tsLeftButtonDown in FStates then + Include(Shift, ssLeft); + if tsMiddleButtonDown in FStates then + Include(Shift, ssMiddle); + if tsRightButtonDown in FStates then + Include(Shift, ssRight); + Pt := ScreenToClient(Pt); + Effect := SuggestDropEffect(DragManager.DragSource, Shift, Pt, Effect); + Accept := DoDragOver(DragManager.DragSource, Shift, dsDragEnter, Pt, FLastDropMode, Effect); + if not Accept then + Effect := DROPEFFECT_NONE + else + begin + // Set initial drop target node and drop mode. + GetHitTestInfoAt(Pt.X, Pt.Y, True, HitInfo, Shift); + if Assigned(HitInfo.HitNode) then + begin + FDropTargetNode := HitInfo.HitNode; + R := GetDisplayRect(HitInfo.HitNode, FHeader.MainColumn, False); + //VSOFT CHANGE - changed back to 4.8.5 behaviour + if (hiOnItemLabel in HitInfo.HitPositions) or ((hiOnItem in HitInfo.HitPositions) and + ((toFullRowDrag in FOptions.MiscOptions){ or (toFullRowSelect in FOptions.SelectionOptions)}))then + FLastDropMode := dmOnNode + else + if ((R.Top + R.Bottom) div 2) > Pt.Y then + FLastDropMode := dmAbove + else + FLastDropMode := dmBelow; + end + else + FLastDropMode := dmNowhere; + end; + Result := NOERROR; + except + Result := E_UNEXPECTED; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DragFinished; + +// Called by DragCancelled or EndDrag to make up for the still missing mouse button up messages. +// These are important for such important things like popup menus. + +var + P: TPoint; + +begin + if [tsOLEDragging, tsVCLDragPending, tsVCLDragging, tsVCLDragFinished] * FStates = [] then + Exit; + + DoStateChange([], [tsVCLDragPending, tsVCLDragging, tsUserDragObject, tsVCLDragFinished]); + + GetCursorPos(P); + P := ScreenToClient(P); + if tsRightButtonDown in FStates then + Perform(WM_RBUTTONUP, 0, LPARAM(Integer(PointToSmallPoint(P)))) + else + if tsMiddleButtonDown in FStates then + Perform(WM_MBUTTONUP, 0, LPARAM(Integer(PointToSmallPoint(P)))) + else + Perform(WM_LBUTTONUP, 0, LPARAM(Integer(PointToSmallPoint(P)))); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DragLeave; + +var + Effect: Integer; + +begin + StopTimer(ExpandTimer); + + if Assigned(FDropTargetNode) then + begin + InvalidateNode(FDropTargetNode); + FDropTargetNode := nil; + end; + + UpdateWindow(); + + Effect := 0; + DoDragOver(nil, [], TDragState.dsDragLeave, Point(0, 0), FLastDropMode, Effect); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint; + var Effect: Integer): HResult; + +// callback routine for the drop target interface + +var + Shift: TShiftState; + Accept, + WindowScrolled: Boolean; + OldR, R: TRect; + NewDropMode: TDropMode; + HitInfo: THitInfo; + DragPos: TPoint; + LastNode: PVirtualNode; + DeltaX, + DeltaY: TDimension; + ScrollOptions: TScrollUpdateOptions; + +begin + ScrollOptions := DefaultScrollUpdateFlags; + + try + DragPos := Pt; + Pt := ScreenToClient(Pt); + + // Check if we have to scroll the client area. + FScrollDirections := DetermineScrollDirections(Pt.X, Pt.Y); + DeltaX := 0; + DeltaY := 0; + if FScrollDirections <> [] then + begin + // Determine amount to scroll. + if sdUp in FScrollDirections then + begin + DeltaY := Min(FScrollBarOptions.VerticalIncrement, ClientHeight); + if FOffsetY = 0 then + Exclude(FScrollDirections, sdUp); + end; + if sdDown in FScrollDirections then + begin + DeltaY := -Min(FScrollBarOptions.VerticalIncrement, ClientHeight); + if (ClientHeight - FOffsetY) = FRangeY then + Exclude(FScrollDirections, sdDown); + end; + if sdLeft in FScrollDirections then + begin + DeltaX := FScrollBarOptions.HorizontalIncrement; + if FEffectiveOffsetX = 0 then + Exclude(FScrollDirections, sdleft); + end; + if sdRight in FScrollDirections then + begin + DeltaX := -FScrollBarOptions.HorizontalIncrement; + if (ClientWidth + FEffectiveOffsetX) = FRangeX then + Exclude(FScrollDirections, sdRight); + end; + WindowScrolled := DoSetOffsetXY(Point(FOffsetX + DeltaX, FOffsetY + DeltaY), ScrollOptions, nil); + end + else + WindowScrolled := False; + + // Determine acceptance of drag operation as well as drag target. + Shift := KeysToShiftState(KeyState); + if tsLeftButtonDown in FStates then + Include(Shift, ssLeft); + if tsMiddleButtonDown in FStates then + Include(Shift, ssMiddle); + if tsRightButtonDown in FStates then + Include(Shift, ssRight); + GetHitTestInfoAt(Pt.X, Pt.Y, True, HitInfo, Shift); + + if Assigned(HitInfo.HitNode) then + R := GetDisplayRect(HitInfo.HitNode, NoColumn, False) + else + R := Rect(0, 0, 0, 0); + NewDropMode := DetermineDropMode(Pt, HitInfo, R); + + if (HitInfo.HitNode <> FDropTargetNode) or (FLastDropMode <> NewDropMode) then + begin + // Something in the tree will change. This requires to update the screen and/or the drag image. + FLastDropMode := NewDropMode; + if HitInfo.HitNode <> FDropTargetNode then + begin + StopTimer(ExpandTimer); + // The last target node is needed for the rectangle determination but must already be set for + // the recapture call, hence it must be stored somewhere. + LastNode := FDropTargetNode; + FDropTargetNode := HitInfo.HitNode; + // In order to show a selection rectangle a column must be focused. + if FFocusedColumn <= NoColumn then + FFocusedColumn := FHeader.MainColumn; + + if Assigned(LastNode) and Assigned(FDropTargetNode) then + begin + // Optimize the case that the selection moved between two nodes. + OldR := GetDisplayRect(LastNode, NoColumn, False); + UnionRect(R, R, OldR); + InvalidateRect(@R, False); + end + else + begin + if Assigned(LastNode) then + begin + // Repaint last target node. + OldR := GetDisplayRect(LastNode, NoColumn, False); + InvalidateRect(@OldR, False); + end + else + InvalidateRect(@R, False); + end; + + // Start auto expand timer if necessary. + if (toAutoDropExpand in FOptions.AutoOptions) and Assigned(FDropTargetNode) and + (vsHasChildren in FDropTargetNode.States) then + SetTimer(Handle, ExpandTimer, FAutoExpandDelay, nil); + end + else + begin + InvalidateRect(@R, False); + end; + end; + + Update; + + Effect := SuggestDropEffect(Source, Shift, Pt, Effect); + Accept := DoDragOver(Source, Shift, DragState, Pt, FLastDropMode, Effect); + if not Accept then + Effect := DROPEFFECT_NONE; + if WindowScrolled then + Effect := Effect or Integer(DROPEFFECT_SCROLL); + Result := NOERROR; + except + Result := E_UNEXPECTED; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension); +// Draws a horizontal line with alternating pixels +var + R: TRect; +begin + R := Rect(Min(Left, Right), Top, Max(Left, Right) + 1, Top + 1); + PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; + Winapi.Windows.FillRect(PaintInfo.Canvas.Handle, R, DottedBrushTreeLines.Handle); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: TDimension); +// Draws a vertical line with alternating pixels +var + R: TRect; +begin + R := Rect(Left, Min(Top, Bottom), Left + 1, Max(Top, Bottom) + 1); + PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; + Winapi.Windows.FillRect(PaintInfo.Canvas.Handle, R, DottedBrushTreeLines.Handle); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DrawGridLine(Canvas: TCanvas; R: TRect); +begin + Canvas.Brush.Color := FColors.GridLineColor; + Canvas.Brush.Style := bsSolid; + Canvas.FillRect(R); + //StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tlGroupHeaderLineOpenSelectedNotFocused), R {$IF CompilerVersion >= 34}, @R, CurrentPPI{$IFEND}); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DrawGridHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: TDimension); +// Draws a horizontal grid line +var + R: TRect; +begin + R := Rect(Min(Left, Right), Top, Max(Left, Right) + LineWidth, Top + LineWidth); + DrawGridLine(PaintInfo.Canvas, R) +end; + + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DrawGridVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: TDimension; pFixedColumn: Boolean = False); +// Draws a vertical grid line +var + R: TRect; +begin + 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 + if StyleServices.IsSystemStyle then // This approach does not work well for many VCL styles, so we added an else case + begin + DrawGridLine(PaintInfo.Canvas, R) + //StyleServices.DrawElement(PaintInfo.Canvas.Handle, StyleServices.GetElementDetails(tlGroupHeaderLineOpenSelectedNotFocused), R {$IF CompilerVersion >= 34}, @R, CurrentPPI{$IFEND}) + end + else begin + DrawGridLine(PaintInfo.Canvas, R) + //StyleServices.DrawElement(PaintInfo.Canvas.Handle, StyleServices.GetElementDetails(tbGroupBoxNormal), R {$IF CompilerVersion >= 34}, @R, CurrentPPI{$IFEND}); + end; + end;// else +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.EndOperation(OperationKind: TVTOperationKind); + +// Called to indicate that a long-running operation has finished. + +begin + Assert(FOperationCount > 0, 'EndOperation must not be called when no operation in progress.'); + System.Dec(FOperationCount); + DoEndOperation(OperationKind); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.EnsureNodeFocused(); +begin + if FocusedNode = nil then + FocusedNode := Self.GetFirstSelected(); + if FocusedNode = nil then + FocusedNode := Self.GetFirstVisible(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.EnsureNodeSelected(pAfterDeletion: Boolean); +begin + if IsEmpty then + exit; // Nothing to do + if (toAlwaysSelectNode in TreeOptions.SelectionOptions) or (pAfterDeletion and (toSelectNextNodeOnRemoval in TreeOptions.SelectionOptions)) then + begin + if (SelectedCount = 0) and not SelectionLocked then + begin + if not Assigned(FNextNodeToSelect) then + begin + FNextNodeToSelect := GetFirstVisible; + // Avoid selecting a disabled node, see #954 + while Assigned(FNextNodeToSelect) and IsDisabled[FNextNodeToSelect] do + FNextNodeToSelect := GetNextVisible(FNextNodeToSelect); + end; + Selected[FNextNodeToSelect] := True; + Self.ScrollIntoView(Self.GetFirstSelected, False); + end;// if nothing selected + EnsureNodeFocused(); + end;//if toAlwaysSelectNode +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.FindNodeInSelection(P: PVirtualNode; var Index: Integer; LowBound, + HighBound: Integer): Boolean; + +// Search routine to find a specific node in the selection array. +// LowBound and HighBound determine the range in which to search the node. +// Either value can be -1 to denote the maximum range otherwise LowBound must be less or equal HighBound. + +var + L, H, + I: Integer; + +begin + Result := False; + L := 0; + if LowBound >= 0 then + L := LowBound; + H := FSelectionCount - 1; + if HighBound >= 0 then + H := HighBound; + while L <= H do + begin + I := (L + H) shr 1; + if PAnsiChar(FSelection[I]) < PAnsiChar(P) then + L := I + 1 + else + begin + H := I - 1; + if FSelection[I] = P then + begin + Result := True; + L := I; + end; + end; + end; + Index := L; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.FinishChunkHeader(Stream: TStream; StartPos, EndPos: Integer); + +// used while streaming out a node to finally write out the size of the chunk + +var + Size: Integer; + +begin + // seek back to the second entry in the chunk header + Stream.Position := StartPos + SizeOf(Size); + // determine size of chunk without the chunk header + Size := EndPos - StartPos - SizeOf(TChunkHeader); + // write the size... + Stream.Write(Size, SizeOf(Size)); + // ... and seek to the last endposition + Stream.Position := EndPos; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.FontChanged(AFont: TObject); + +// Little helper function for font changes (as they are not tracked in TBitmap/TCanvas.OnChange). + +begin + FFontChanged := True; + if Assigned(FOldFontChange) then + FOldFontChange(AFont); + //if not (tsPainting in TreeStates) then AutoScale(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetBorderDimensions: TSize; + +// Returns the overall width of the current window border, depending on border styles. +// Note: these numbers represent the system's standards not special properties, which can be set for TWinControl +// (e.g. bevels, border width). + +var + Styles: Integer; + +begin + Result.cx := 0; + Result.cy := 0; + + Styles := GetWindowLong(Handle, GWL_STYLE); + if (Styles and WS_BORDER) <> 0 then + begin + Dec(Result.cx); + Dec(Result.cy); + end; + if (Styles and WS_THICKFRAME) <> 0 then + begin + Dec(Result.cx, GetSystemMetrics(SM_CXFIXEDFRAME)); + Dec(Result.cy, GetSystemMetrics(SM_CYFIXEDFRAME)); + end; + Styles := GetWindowLong(Handle, GWL_EXSTYLE); + if (Styles and WS_EX_CLIENTEDGE) <> 0 then + begin + Dec(Result.cx, GetSystemMetrics(SM_CXEDGE)); + Dec(Result.cy, GetSystemMetrics(SM_CYEDGE)); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetCheckImage(Node: PVirtualNode; ImgCheckType: TCheckType = ctNone; ImgCheckState: + TCheckState = csUncheckedNormal; ImgEnabled: Boolean = True): Integer; + +// Determines the index into the check image list for the given node depending on the check type +// and enabled state. + +const + // Four dimensional array consisting of image indices for the check type, the check state, the enabled state and the + // hot state. + CheckStateToCheckImage: array[ctCheckBox..ctButton, csUncheckedNormal..csMixedPressed, Boolean, Boolean] of Integer = ( + // ctCheckBox, ctTriStateCheckBox + ( + // csUncheckedNormal (disabled [not hot, hot], enabled [not hot, hot]) + ((ckCheckUncheckedDisabled, ckCheckUncheckedDisabled), (ckCheckUncheckedNormal, ckCheckUncheckedHot)), + // csUncheckedPressed (disabled [not hot, hot], enabled [not hot, hot]) + ((ckCheckUncheckedDisabled, ckCheckUncheckedDisabled), (ckCheckUncheckedPressed, ckCheckUncheckedPressed)), + // csCheckedNormal + ((ckCheckCheckedDisabled, ckCheckCheckedDisabled), (ckCheckCheckedNormal, ckCheckCheckedHot)), + // csCheckedPressed + ((ckCheckCheckedDisabled, ckCheckCheckedDisabled), (ckCheckCheckedPressed, ckCheckCheckedPressed)), + // csMixedNormal + ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedNormal, ckCheckMixedHot)), + // csMixedPressed + ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedPressed, ckCheckMixedPressed)) + ), + // ctRadioButton + ( + // csUncheckedNormal (disabled [not hot, hot], enabled [not hot, hot]) + ((ckRadioUncheckedDisabled, ckRadioUncheckedDisabled), (ckRadioUncheckedNormal, ckRadioUncheckedHot)), + // csUncheckedPressed (disabled [not hot, hot], enabled [not hot, hot]) + ((ckRadioUncheckedDisabled, ckRadioUncheckedDisabled), (ckRadioUncheckedPressed, ckRadioUncheckedPressed)), + // csCheckedNormal + ((ckRadioCheckedDisabled, ckRadioCheckedDisabled), (ckRadioCheckedNormal, ckRadioCheckedHot)), + // csCheckedPressed + ((ckRadioCheckedDisabled, ckRadioCheckedDisabled), (ckRadioCheckedPressed, ckRadioCheckedPressed)), + // csMixedNormal (should never appear with ctRadioButton) + ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedNormal, ckCheckMixedHot)), + // csMixedPressed (should never appear with ctRadioButton) + ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedPressed, ckCheckMixedPressed)) + ), + // ctButton + ( + // csUncheckedNormal (disabled [not hot, hot], enabled [not hot, hot]) + ((ckButtonDisabled, ckButtonDisabled), (ckButtonNormal, ckButtonHot)), + // csUncheckedPressed (disabled [not hot, hot], enabled [not hot, hot]) + ((ckButtonDisabled, ckButtonDisabled), (ckButtonPressed, ckButtonPressed)), + // csCheckedNormal + ((ckButtonDisabled, ckButtonDisabled), (ckButtonNormal, ckButtonHot)), + // csCheckedPressed + ((ckButtonDisabled, ckButtonDisabled), (ckButtonPressed, ckButtonPressed)), + // csMixedNormal (should never appear with ctButton) + ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedNormal, ckCheckMixedHot)), + // csMixedPressed (should never appear with ctButton) + ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedPressed, ckCheckMixedPressed)) + ) + ); + +var + IsHot: Boolean; + +begin + if Assigned(Node) then + begin + ImgCheckType := Node.CheckType; + ImgCheckState := GetCheckState(Node); + ImgEnabled := not (vsDisabled in Node.States) and Self.Enabled; + + IsHot := Node = FCurrentHotNode; + end + else + IsHot := False; + + if ImgCheckState.IsDisabled then begin // disabled image? + // We need to use disabled images, so map ImgCheckState value from disabled to normal, as disabled state is expressed by ImgEnabled. + ImgEnabled := False; + ImgCheckState := ImgCheckState.GetEnabled(); + end;//if + + if ImgCheckType = ctTriStateCheckBox then + ImgCheckType := ctCheckBox; + if IsHot and (ImgCheckState in [csCheckedNormal, csUncheckedNormal]) and (GetKeyState(VK_LBUTTON) < 0) and (hiOnItemCheckbox in FLastHitInfo.HitPositions) then + System.Inc(ImgCheckState); // Advance to pressed state + + if ImgCheckType = ctNone then + Result := -1 + else + Result := CheckStateToCheckImage[ImgCheckType, ImgCheckState, ImgEnabled, IsHot]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetColumnClass: TVirtualTreeColumnClass; + +begin + Result := TVirtualTreeColumn; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetHeaderClass: TVTHeaderClass; + +begin + Result := TVTHeader; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.GetImageIndex(var Info: TVTPaintInfo; Kind: TVTImageKind; InfoIndex: TVTImageInfoIndex); + +// Retrieves the image index and an eventual customized image list for drawing. + +var + CustomImages: TCustomImageList; + +begin + with Info do + begin + ImageInfo[InfoIndex].Index := -1; + ImageInfo[InfoIndex].Ghosted := False; + + CustomImages := DoGetImageIndex(Node, Kind, Column, ImageInfo[InfoIndex].Ghosted, ImageInfo[InfoIndex].Index); + if Assigned(CustomImages) then + ImageInfo[InfoIndex].Images := CustomImages + end; +end; + +function TBaseVirtualTree.GetImageSize(Node: PVirtualNode; Kind: TVTImageKind = TVTImageKind.ikNormal; Column: TColumnIndex = 0; IncludePadding: Boolean = True): TSize; + +// Determines whether the given node has got an image of the given kind in the given column. +// Returns the size of the image, or (0,0) if no image is available +// The given node will be implicitly initialized if needed. + +var + Ghosted: Boolean; + Index: TImageIndex; + lImageList: TCustomImageList; +begin + if not Assigned(OnGetImageIndexEx) and (((Kind = TVTImageKind.ikNormal) and not Assigned(fImages)) + or ((Kind = TVTImageKind.ikState) and not Assigned(fStateImages))) then + begin + Result.cx := 0; + Result.cy := 0; + end; + if not (vsInitialized in Node.States) then + InitNode(Node); + Index := -1; + Ghosted := False; + lImageList := DoGetImageIndex(Node, Kind, Column, Ghosted, Index); + if (Index > NoImage) or (Index = EmptyImage) then begin + if IncludePadding then + Result.cx := lImageList.Width + ScaledPixels(2) + else + Result.cx := lImageList.Width; + Result.cy := lImageList.Height; + end + else begin + Result.cx := 0; + Result.cy := 0; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsEmpty: Boolean; +begin + Result := (Self.ChildCount[nil] = 0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNodeImageSize(Node: PVirtualNode): TSize; + + // Returns the size of an image + // Override if you need different sized images for certain nodes. +begin + Result := GetImageSize(Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetMaxRightExtend(): TDimension; + +// Determines the maximum with of the currently visible part of the tree, depending on the length +// of the node texts. This method is used for determining the horizontal scroll range if no columns are used. + +var + Node, + NextNode: PVirtualNode; + TopPosition: TDimension; + CurrentWidth: TDimension; + +begin + Node := GetNodeAt(0, 0, True, TopPosition); + Result := 0; + if not Assigned(Node) then + exit; + + while Assigned(Node) do + begin + if not (vsInitialized in Node.States) then + InitNode(Node); + CurrentWidth := GetOffset(TVTElement.ofsRightOfText, Node); + if Result < (CurrentWidth) then + Result := CurrentWidth; + Inc(TopPosition, NodeHeight[Node]); + if TopPosition > Height then + Break; + + // Get next visible node and update left node position. + NextNode := GetNextVisible(Node, True); + if NextNode = nil then + Break; + Node := NextNode; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.GetNativeClipboardFormats(var Formats: TFormatEtcArray); + +// Returns the supported clipboard formats of the tree. + +begin + TClipboardFormatList.EnumerateFormats(TVirtualTreeClass(ClassType), Formats, FClipboardFormats); + // Ask application/descendants for self defined formats. + DoGetUserClipboardFormats(Formats); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetOperationCanceled; + +begin + Result := FOperationCanceled and (FOperationCount > 0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetOptionsClass: TTreeOptionsClass; + +begin + Result := TCustomVirtualTreeOptions; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.HandleHotTrack(X, Y: TDimension); + +// Updates the current "hot" node. + +var + HitInfo: THitInfo; + CheckPositions: THitPositions; + ButtonIsHit, + DoInvalidate: Boolean; + oldHotNode : PVirtualNode; +begin + if not IsMouseCursorVisible then + begin + if Assigned(FCurrentHotNode) then + begin + InvalidateNode(FCurrentHotNode); + FCurrentHotNode := nil; + end; + Exit; + end;//if not IsMouseCursorVisible + + DoInvalidate := False; + oldHotNode := FCurrentHotNode; + // Get information about the hit. + GetHitTestInfoAt(X, Y, True, HitInfo, []); + + // Only make the new node being "hot" if its label is hit or full row selection is enabled. + CheckPositions := [hiOnItemLabel, hiOnItemCheckbox]; + + // If running under Windows Vista using the explorer theme hitting the buttons makes the node hot, too. + if tsUseExplorerTheme in FStates then + Include(CheckPositions, hiOnItemButtonExact); + + if (CheckPositions * HitInfo.HitPositions = []) and + (not (toFullRowSelect in FOptions.SelectionOptions) or (hiNowhere in HitInfo.HitPositions)) then + FCurrentHotNode := nil + else + FCurrentHotNode := HitInfo.HitNode; + if (FCurrentHotNode <> oldHotNode) or (HitInfo.HitColumn <> FCurrentHotColumn) then + begin + DoInvalidate := (toHotTrack in FOptions.PaintOptions) or (toCheckSupport in FOptions.MiscOptions) or (oldHotNode <> FCurrentHotNode); + DoHotChange(oldHotNode, HitInfo.HitNode); + if Assigned(oldHotNode) and DoInvalidate then + InvalidateNode(oldHotNode); + FCurrentHotColumn := HitInfo.HitColumn; + end; + + ButtonIsHit := (hiOnItemButtonExact in HitInfo.HitPositions); + if Assigned(HitInfo.HitNode) and ((FHotNodeButtonHit <> ButtonIsHit) or (FCurrentHotNode <> oldHotNode) or DoInvalidate) then + begin + FHotNodeButtonHit := ButtonIsHit; + InvalidateNode(HitInfo.HitNode); + end + else + if not Assigned(HitInfo.HitNode) then + FHotNodeButtonHit := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.HandleIncrementalSearch(CharCode: Word); + +var + Run, Stop: PVirtualNode; + GetNextNode: TGetNextNodeProc; + NewSearchText: string; + SingleLetter, + PreviousSearch: Boolean; // True if VK_BACK was sent. + SearchDirection: TVTSearchDirection; + + //--------------- local functions ------------------------------------------- + + procedure SetupNavigation; + + // If the search buffer is empty then we start searching with the next node after the last one, otherwise + // we continue with the last one. Node navigation function is set up too here, to avoid frequent checks. + + var + FindNextNode: Boolean; + + begin + FindNextNode := (Length(FSearchBuffer) = 0) or (Run = nil) or SingleLetter or PreviousSearch; + case FIncrementalSearch of + isVisibleOnly: + if SearchDirection = sdForward then + begin + GetNextNode := GetNextVisible; + if FindNextNode then + begin + if Run = nil then + Run := GetFirstVisible(nil, True) + else + begin + Run := GetNextVisible(Run, True); + // Do wrap around. + if Run = nil then + Run := GetFirstVisible(nil, True); + end; + end; + end + else + begin + GetNextNode := GetPreviousVisible; + if FindNextNode then + begin + if Run = nil then + Run := GetLastVisible(nil, True) + else + begin + Run := GetPreviousVisible(Run, True); + // Do wrap around. + if Run = nil then + Run := GetLastVisible(nil, True); + end; + end; + end; + isInitializedOnly: + if SearchDirection = sdForward then + begin + GetNextNode := GetNextNoInit; + if FindNextNode then + begin + if Run = nil then + Run := GetFirstNoInit + else + begin + Run := GetNextNoInit(Run); + // Do wrap around. + if Run = nil then + Run := GetFirstNoInit; + end; + end; + end + else + begin + GetNextNode := GetPreviousNoInit; + if FindNextNode then + begin + if Run = nil then + Run := GetLastNoInit + else + begin + Run := GetPreviousNoInit(Run); + // Do wrap around. + if Run = nil then + Run := GetLastNoInit; + end; + end; + end; + else + // isAll + if SearchDirection = sdForward then + begin + GetNextNode := GetNext; + if FindNextNode then + begin + if Run = nil then + Run := GetFirst + else + begin + Run := GetNext(Run); + // Do wrap around. + if Run = nil then + Run := GetFirst; + end; + end; + end + else + begin + GetNextNode := GetPrevious; + if FindNextNode then + begin + if Run = nil then + Run := GetLast + else + begin + Run := GetPrevious(Run); + // Do wrap around. + if Run = nil then + Run := GetLast; + end; + end; + end; + end; + end; + + //--------------------------------------------------------------------------- + + function CodePageFromLocale(Language: LCID): Integer; + + // Determines the code page for a given locale. + // Unfortunately there is no easier way than this, currently. + + var + Buf: array[0..6] of Char; + + begin + GetLocaleInfo(Language, LOCALE_IDEFAULTANSICODEPAGE, Buf, 6); + Result := StrToIntDef(Buf, GetACP); + end; + + //--------------------------------------------------------------------------- + + function KeyUnicode(C: Char): WideChar; + // Converts the given character into its corresponding Unicode character + // depending on the active keyboard layout. + begin + Result := C; //!!!!!! + end; + + //--------------- end local functions --------------------------------------- + +var + FoundMatch: Boolean; + NewChar: WideChar; + +begin + StopTimer(SearchTimer); + + if FIncrementalSearch <> isNone then + begin + if CharCode <> 0 then + begin + DoStateChange([tsIncrementalSearching]); + + // Convert the given virtual key code into a Unicode character based on the current locale. + NewChar := KeyUnicode(Char(CharCode)); + PreviousSearch := NewChar = WideChar(VK_BACK); + // We cannot do a search with an empty search buffer. + if not PreviousSearch or (FSearchBuffer <> '') then + begin + // Determine which method to use to advance nodes and the start node to search from. + case FSearchStart of + ssAlwaysStartOver: + Run := nil; + ssFocusedNode: + Run := FFocusedNode; + else // ssLastHit + Run := FLastSearchNode; + end; + + // Make sure the start node corresponds to the search criterion. + if Assigned(Run) then + begin + case FIncrementalSearch of + isInitializedOnly: + if not (vsInitialized in Run.States) then + Run := nil; + isVisibleOnly: + if not FullyVisible[Run] or IsEffectivelyFiltered[Run] then + Run := nil; + end; + end; + Stop := Run; + + // VK_BACK temporarily changes search direction to opposite mode. + if PreviousSearch then + begin + if SearchDirection = sdBackward then + SearchDirection := sdForward + else + SearchDirection := sdBackward; + end + else + SearchDirection := FSearchDirection; + // The "single letter mode" is used to advance quickly from node to node when pressing the same key several times. + SingleLetter := (Length(FSearchBuffer) = 1) and not PreviousSearch and (FSearchBuffer[1] = NewChar); + // However if the current hit (if there is one) would fit also with a repeated character then + // don't use single letter mode. + if SingleLetter and (DoIncrementalSearch(Run, FSearchBuffer + NewChar) = 0) then + SingleLetter := False; + SetupNavigation; + FoundMatch := False; + + if Assigned(Run) then + begin + if SingleLetter then + NewSearchText := FSearchBuffer + else + if PreviousSearch then + begin + SetLength(FSearchBuffer, Length(FSearchBuffer) - 1); + NewSearchText := FSearchBuffer; + end + else + NewSearchText := FSearchBuffer + NewChar; + + repeat + if DoIncrementalSearch(Run, NewSearchText) = 0 then + begin + FoundMatch := True; + Break; + end; + + // Advance to next node if we have not found a match. + Run := GetNextNode(Run); + // Do wrap around start or end of tree. + if (Run <> Stop) and (Run = nil) then + SetupNavigation; + until Run = Stop; + end; + + if FoundMatch then + begin + ClearSelection; + FSearchBuffer := NewSearchText; + FLastSearchNode := Run; + FocusedNode := Run; + AddToSelection(Run, False); + FLastSearchNode := Run; + end + else + // Play an acoustic signal if nothing could be found but don't beep if only the currently + // focused node matches. + if Assigned(Run) and (DoIncrementalSearch(Run, NewSearchText) <> 0) then + Beep; + end; + end; + + // Restart search timeout interval. + SetTimer(Handle, SearchTimer, FSearchTimeout, nil); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); + +var + Node: PVirtualNode; + MayEdit: Boolean; + +begin + MayEdit := not (tsEditing in FStates) and (toEditOnDblClick in FOptions.MiscOptions); + if tsEditPending in FStates then + begin + StopTimer(EditTimer); + DoStateChange([], [tsEditPending]); + end; + + if not (tsEditing in FStates) or DoEndEdit then + begin + if HitInfo.HitColumn = FHeader.Columns.ClickIndex then + DoColumnDblClick(HitInfo.HitColumn, KeysToShiftState(Message.Keys)); + + if HitInfo.HitNode <> nil then + DoNodeDblClick(HitInfo); + + Node := nil; + if (hiOnItem in HitInfo.HitPositions) and (HitInfo.HitColumn > NoColumn) and + (coFixed in FHeader.Columns[HitInfo.HitColumn].Options) then + begin + if hiUpperSplitter in HitInfo.HitPositions then + Node := GetPreviousVisible(HitInfo.HitNode, True) + else + if hiLowerSplitter in HitInfo.HitPositions then + Node := HitInfo.HitNode; + end; + + if Assigned(Node) and (Node <> FRoot) and (toNodeHeightDblClickResize in FOptions.MiscOptions) then + begin + if DoNodeHeightDblClickResize(Node, HitInfo.HitColumn, KeysToShiftState(Message.Keys), Point(Message.XPos, Message.YPos)) then + begin + SetNodeHeight(Node, FDefaultNodeHeight); + UpdateWindow(); + MayEdit := False; + end; + end + else + if hiOnItemCheckBox in HitInfo.HitPositions then + begin + HandleCheckboxClick(HitInfo.HitNode, Message.Keys); + MayEdit := False; + end// if hiOnItemCheckBox + else + begin + if hiOnItemButton in HitInfo.HitPositions then + begin + ToggleNode(HitInfo.HitNode); + MayEdit := False; + end + else + begin + if toToggleOnDblClick in FOptions.MiscOptions then + begin + if ((([hiOnItemButton, hiOnItemLabel, hiOnNormalIcon, hiOnStateIcon] * HitInfo.HitPositions) <> []) or + ((toFullRowSelect in FOptions.SelectionOptions) and Assigned(HitInfo.HitNode))) then + begin + ToggleNode(HitInfo.HitNode); + MayEdit := False; + end; + end; + end; + end; + end; + + if MayEdit and Assigned(FFocusedNode) and (FFocusedNode = HitInfo.HitNode) and + (FFocusedColumn = HitInfo.HitColumn) and CanEdit(FFocusedNode, HitInfo.HitColumn) then + begin + DoStateChange([tsEditPending]); + FEditColumn := FFocusedColumn; + SetTimer(Handle, EditTimer, 0, nil); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.HandleCheckboxClick(pHitNode: PVirtualNode; pKeys: LongInt); +var + NewCheckState: TCheckState; +begin + NewCheckState := DetermineNextCheckState(pHitNode.CheckType, pHitNode.CheckState); + if (ssLeft in KeysToShiftState(pKeys)) and DoChecking(pHitNode, NewCheckState) then + begin + if (Self.SelectedCount > 1) and (Selected[pHitNode]) and not (toSyncCheckboxesWithSelection in TreeOptions.SelectionOptions) then + SetCheckStateForAll(NewCheckState, True) + else + DoCheckClick(pHitNode, NewCheckState); + end;//if ssLeft +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: THitInfo); + +// centralized mouse button down handling + +var + LastFocused: PVirtualNode; + Column: TColumnIndex; + ShiftState: TShiftState; + + // helper variables to shorten boolean equations/expressions + AutoDrag, // automatic (or allowed) drag start + IsLabelHit, // the node's caption or images are hit + IsCellHit, // for grid extension or full row select (but not check box, button) + IsAnyHit, // either IsHit or IsCellHit + IsHeightTracking, // height tracking + MultiSelect, // multiselection is enabled + ShiftEmpty, // ShiftState = [] + NodeSelected: Boolean; // the new node (if any) is selected + NewColumn: Boolean; // column changed + NewNode: Boolean; // Node changed. + NeedChangeEvent: Boolean; // change event is required for selection change + CanClear: Boolean; + AltPressed: Boolean; // Pressing the Alt key enables special processing for selection. + FullRowDrag: Boolean; // Start dragging anywhere within a node's bound. + NodeRect: TRect; + LCellSelectionEnabled: Boolean; + + //--------------- local functions ------------------------------------------- + + //Fix for issue: 310 whenever there is a need to invalidate a column, consider + //auto spanned columns if applicable + procedure invalidateWithAutoSpan(acolumn: TColumnIndex; anode: PVirtualNode); + var + NextColumn: Integer; + Dummy: TColumnIndex; + begin + if (not FHeader.UseColumns) or (not (toAutoSpanColumns in FOptions.AutoOptions)) + or (acolumn = FHeader.MainColumn) then + begin + //no need to find auto spanned next columns + InvalidateColumn(acolumn); + exit; + end; + //invalidate auto spanned columns too + with FHeader.Columns do //standard loop for auto span + begin + NextColumn := acolumn; + repeat + InvalidateColumn(NextColumn); + Dummy := GetNextVisibleColumn(NextColumn); + if (Dummy = InvalidColumn) or + not ColumnIsEmpty(anode, Dummy) + or + (Items[Dummy].BidiMode <> bdLeftToRight) then + Break; + NextColumn := Dummy; + until False; + end; + end; + + //--------------- end local functions --------------------------------------- + +var + CellClickHandled: Boolean; + ClickedCell: TVTCell; +begin + if tsPanning in FStates then + begin + StopWheelPanning; + Exit; + end; + + if tsEditPending in FStates then + begin + StopTimer(EditTimer); + DoStateChange([], [tsEditPending]); + end; + + FLastHitInfo := HitInfo; // Save for later use in OnNodeClick event, see issue #692 + if (tsEditing in FStates) then begin + if not DoEndEdit then + exit; + // Repeat the hit test as an OnEdited event might got triggered that could modify the tree. + GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo, KeysToShiftState(Message.Keys)); + end;//if tsEditing + + // Focus change. Don't use the SetFocus method as this does not work for MDI Winapi.Windows. + if not Focused and CanFocus then + 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 + Exit; // Nothing to do + + // Keep clicked column in case the application needs it. + FHeader.Columns.ClickIndex := HitInfo.HitColumn; + + // Change column only if we have hit the node label. + if (hiOnItemLabel in HitInfo.HitPositions) or + (toFullRowSelect in FOptions.SelectionOptions) or + (toGridExtensions in FOptions.MiscOptions) then + begin + NewColumn := FFocusedColumn <> HitInfo.HitColumn; + if toExtendedFocus in FOptions.SelectionOptions then + Column := HitInfo.HitColumn + else + Column := FHeader.MainColumn; + end + else + begin + NewColumn := False; + Column := FFocusedColumn; + end; + + if NewColumn and not FHeader.AllowFocus(Column) then + begin + NewColumn := False; + Column := FFocusedColumn; + end; + + NewNode := FFocusedNode <> HitInfo.HitNode; + + // Translate keys and filter out shift and control key. + ShiftState := KeysToShiftState(Message.Keys) * [ssShift, ssCtrl, ssAlt]; + if ssAlt in ShiftState then + begin + AltPressed := True; + // Remove the Alt key from the shift state. It is not meaningful there. + Exclude(ShiftState, ssAlt); + end + else + AltPressed := False; + + // Cell multi-selection hinges on the existing toMultiSelect in addition + // to toExtendedFocus being present and toFullRowSelect being absent + LCellSelectionEnabled := IsCellSelectionEnabled; + + // Various combinations determine what states the tree enters now. + // We initialize shorthand variables to avoid the following expressions getting too large + // and to avoid repeative expensive checks. + IsLabelHit := not AltPressed and not (toSimpleDrawSelection in FOptions.SelectionOptions) and + ((hiOnItemLabel in HitInfo.HitPositions) or (hiOnNormalIcon in HitInfo.HitPositions)); + + IsCellHit := not IsLabelHit and Assigned(HitInfo.HitNode) and + ([hiOnItemButton, hiOnItemCheckBox, hiNoWhere] * HitInfo.HitPositions = []) and + ((toFullRowSelect in FOptions.SelectionOptions) or + ((toGridExtensions in FOptions.MiscOptions) and (HitInfo.HitColumn > NoColumn))) or + (LCellSelectionEnabled and (HitInfo.HitColumn > NoColumn)); + + IsAnyHit := IsLabelHit or IsCellHit; + MultiSelect := toMultiSelect in FOptions.SelectionOptions; + ShiftEmpty := ShiftState = []; + + // Early anchor set for plain clicks helps avoid race where + // later handlers see the anchor as nil and fall back to the first cell. + if ShiftEmpty and + (LCellSelectionEnabled and Assigned(HitInfo.HitNode) and (Column > NoColumn)) then + begin + InternalClearCellSelection; + FCellRangeAnchor.Node := HitInfo.HitNode; + FCellRangeAnchor.Column := Column; + end; + NodeSelected := IsAnyHit and (vsSelected in HitInfo.HitNode.States); + + // Determine the Drag behavior. + if MultiSelect and not (toDisableDrawSelection in FOptions.SelectionOptions) then + begin + // We have MultiSelect and want to draw a selection rectangle. + // We will start a full row drag only in case a label was hit, + // otherwise a multi selection will start. + FullRowDrag := (toFullRowDrag in FOptions.MiscOptions) and IsCellHit and + not (hiNowhere in HitInfo.HitPositions) and + (NodeSelected or (hiOnItemLabel in HitInfo.HitPositions) or (hiOnNormalIcon in HitInfo.HitPositions)); + end + else // No MultiSelect, hence we can start a drag anywhere in the row. + FullRowDrag := toFullRowDrag in FOptions.MiscOptions; + + IsHeightTracking := (Message.Msg = WM_LBUTTONDOWN) and + (hiOnItem in HitInfo.HitPositions) and + ([hiUpperSplitter, hiLowerSplitter] * HitInfo.HitPositions <> []); + + // Dragging might be started in the inherited handler manually (which is discouraged for stability reasons) + // the test for manual mode is done below (after the focused node is set). + AutoDrag := ((DragMode = TDragMode.dmAutomatic) or Dragging) and (not IsCellHit or FullRowDrag); + + // Query the application to learn if dragging may start now (if set to dmManual). + if Assigned(HitInfo.HitNode) and not AutoDrag and (DragMode = TDragMode.dmManual) then + AutoDrag := DoBeforeDrag(HitInfo.HitNode, Column) and (FullRowDrag or IsLabelHit); + + // handle node height tracking + if IsHeightTracking then + begin + if hiUpperSplitter in HitInfo.HitPositions then + FHeightTrackNode := GetPreviousVisible(HitInfo.HitNode, True) + else + FHeightTrackNode := HitInfo.HitNode; + + if CanSplitterResizeNode(Point(Message.XPos, Message.YPos), FHeightTrackNode, HitInfo.HitColumn) then + begin + FHeightTrackColumn := HitInfo.HitColumn; + NodeRect := GetDisplayRect(FHeightTrackNode, FHeightTrackColumn, False); + FHeightTrackPoint := Point(NodeRect.Left, NodeRect.Top); + DoStateChange([tsNodeHeightTrackPending]); + Exit; + end; + end; + + // handle button clicks + if (hiOnItemButton in HitInfo.HitPositions) and (vsHasChildren in HitInfo.HitNode.States) then + begin + ToggleNode(HitInfo.HitNode); + Exit; + end; + + // check event + if hiOnItemCheckBox in HitInfo.HitPositions then + begin + HandleCheckboxClick(HitInfo.HitNode, Message.Keys); + Exit; + end; + + // Keep this node's level in case we need it for constraint selection. + if (FRoot.ChildCount > 0) and ShiftEmpty or (FSelectionCount = 0) then + if Assigned(HitInfo.HitNode) then + FLastSelectionLevel := GetNodeLevelForSelectConstraint(HitInfo.HitNode) + else + FLastSelectionLevel := GetNodeLevelForSelectConstraint(GetLastVisibleNoInit(nil, True)); + + // immediate clearance + // Determine for the right mouse button if there is a popup menu. In this case and if drag'n drop is pending + // the current selection has to stay as it is. + with HitInfo, Message do + CanClear := not AutoDrag and + (not (tsRightButtonDown in FStates) or not HasPopupMenu(HitNode, HitColumn, Point(XPos, YPos))); + + // pending clearance + if MultiSelect and ShiftEmpty and not (hiOnItemCheckbox in HitInfo.HitPositions) and IsAnyHit and AutoDrag and + NodeSelected and not FSelectionLocked + then + DoStateChange([tsClearPending]); + + // User starts a selection with a selection rectangle. + if not (toDisableDrawSelection in FOptions.SelectionOptions) and not (IsLabelHit or FullRowDrag) and MultiSelect then + begin + SetCapture(Handle); + DoStateChange([tsDrawSelPending]); + FDrawSelShiftState := ShiftState; + FNewSelRect := Rect(Message.XPos + FEffectiveOffsetX, Message.YPos - FOffsetY, Message.XPos + FEffectiveOffsetX, + Message.YPos - FOffsetY); + FLastSelRect := Rect(0, 0, 0, 0); + end; + + NeedChangeEvent := FSelectionCount >= 1; + 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 + // 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 + // on node captions and images. Here the previous selection state does not matter, though. + if NodeSelected or (AltPressed and Assigned(HitInfo.HitNode) and (HitInfo.HitColumn = FHeader.MainColumn)) and not (hiNowhere in HitInfo.HitPositions) then + begin + InternalClearSelection; + InternalAddToSelection(HitInfo.HitNode, True); + if NeedChangeEvent then + begin + Invalidate; + Change(HitInfo.HitNode); + end; + end + else if (toAlwaysSelectNode in Self.TreeOptions.SelectionOptions) then + begin + if not (hiNowhere in HitInfo.HitPositions) then + ClearSelection(False) + else + if not (ssCtrl in ShiftState) then + DoStateChange([tsClearOnNewSelection], []); + end + else + ClearSelection(False); + end; + + // pending node edit + if Focused and + ((hiOnItemLabel in HitInfo.HitPositions) or ((toGridExtensions in FOptions.MiscOptions) and + (hiOnItem in HitInfo.HitPositions))) and NodeSelected and not NewColumn and ShiftEmpty and (SelectedCount = 1) then + begin + DoStateChange([tsEditPending]); + end; + + if not (toDisableDrawSelection in FOptions.SelectionOptions) + and not (IsLabelHit or FullRowDrag) and (MultiSelect or (hiNowhere in HitInfo.HitPositions)) then + begin + // The original code here was moved up to fix issue #187. + // In order not to break the semantics of this procedure, we are leaving these if statements here + if not IsCellHit then begin + if NeedChangeEvent then + Change(nil); + Exit; + end; + end; + + // Keep current mouse position. + FLastClickPos := Point(Message.XPos, Message.YPos); + + // Handle selection and node focus change. + if (IsLabelHit or IsCellHit) and + DoFocusChanging(FFocusedNode, HitInfo.HitNode, FFocusedColumn, Column) then + begin + if NewColumn then + begin + + if not Assigned(FFocusedNode) then + InvalidateColumn(FFocusedColumn) + else + invalidateWithAutoSpan(FFocusedColumn, FFocusedNode); //fix: issue 310 + if not Assigned(HitInfo.HitNode) then + InvalidateColumn(Column) + else + invalidateWithAutoSpan(Column, HitInfo.HitNode); //fix: issue 310 + FFocusedColumn := Column; + end; + if DragKind = dkDock then + begin + StopTimer(ScrollTimer); + DoStateChange([], [tsScrollPending, tsScrolling]); + end; + // Get the currently focused node to make multiple multi-selection blocks possible. + LastFocused := FFocusedNode; + if NewNode then + DoFocusNode(HitInfo.HitNode, False); + + if MultiSelect and not ShiftEmpty and not (tsRightButtonDown in FStates) then + HandleClickSelection(LastFocused, HitInfo.HitNode, ShiftState, AutoDrag) + else + begin + CellClickHandled := False; + if ShiftEmpty then + FRangeAnchor := HitInfo.HitNode; + + // If a column was hit on a plain click, clear existing cell selection and select the clicked cell. + // !!! MultiSelect <> LCellSelectionEnabled, not interchangeable !!! + if ShiftEmpty and LCellSelectionEnabled and Assigned(HitInfo.HitNode) and (Column > NoColumn) then + begin + InternalClearCellSelection; + ClickedCell.Node := HitInfo.HitNode; + ClickedCell.Column := Column; + AddToCellSelection(ClickedCell, True); + FCellRangeAnchor := ClickedCell; + CellClickHandled := True; + end; + + // If the hit node is not yet selected then do it now (unless we already handled the cell click) + if (not CellClickHandled) and (not NodeSelected) then + AddToSelection(HitInfo.HitNode, True); + end; + + if NewNode or NewColumn then + begin + ScrollIntoView(FFocusedNode, False, + not (toDisableAutoscrollOnFocus in FOptions.AutoOptions) + and not (toFullRowSelect in FOptions.SelectionOptions)); + + DoFocusChange(FFocusedNode, FFocusedColumn); + end; + end; + + if (SelectedCount = 0) and NeedChangeEvent then + Change(nil); + + // Drag'n drop initiation + // If we lost focus in the interim the button states would be cleared in WM_KILLFOCUS. + if AutoDrag and IsAnyHit and (FStates * [tsLeftButtonDown, tsRightButtonDown, tsMiddleButtonDown] <> []) then + BeginDrag(False); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.HandleMouseUp(var Message: TWMMouse; const HitInfo: THitInfo); + +// Counterpart to the mouse down handler. + +var + ReselectFocusedNode: Boolean; + +begin + ReleaseCapture; + + if not (tsVCLDragPending in FStates) then + begin + // reset pending or persistent states + if IsMouseSelecting then + begin + DoStateChange([], [tsDrawSelecting, tsDrawSelPending, tsToggleFocusedSelection, tsClearOnNewSelection]); + Invalidate; + end; + + if tsClearPending in FStates then + begin + ReselectFocusedNode := Assigned(FFocusedNode) and (vsSelected in FFocusedNode.States); + ClearSelection; + if ReselectFocusedNode then + AddToSelection(FFocusedNode, False); + end; + + if (tsToggleFocusedSelection in FStates) and (HitInfo.HitNode = FFocusedNode) and Assigned(HitInfo.HitNode) then //Prevent AV when dereferencing HitInfo.HitNode below, see bug #100 + begin + if vsSelected in HitInfo.HitNode.States then + begin + if not (toAlwaysSelectNode in TreeOptions.SelectionOptions) or (Self.SelectedCount > 1) then + RemoveFromSelection(HitInfo.HitNode); + end + else + AddToSelection(HitInfo.HitNode, False); + end; + + DoStateChange([], [tsOLEDragPending, tsOLEDragging, tsClearPending, tsDrawSelPending, tsToggleFocusedSelection, + tsScrollPending, tsScrolling]); + StopTimer(ScrollTimer); + + if (FHeader.Columns.ClickIndex > NoColumn) and (FHeader.Columns.ClickIndex = HitInfo.HitColumn) then + DoColumnClick(HitInfo.HitColumn, KeysToShiftState(Message.Keys)); + + if FLastHitInfo.HitNode <> nil then begin // Use THitInfo of mouse down here, see issue #692 + DoNodeClick(FLastHitInfo); + if Assigned(FLastHitInfo.HitNode) then begin + InvalidateNode(FLastHitInfo.HitNode); + FLastHitInfo.HitNode := nil; // prevent firing the event again + end;//if + end; + + // handle a pending edit event + if tsEditPending in FStates then + begin + // Is the mouse still over the same node? + if (HitInfo.HitNode = FFocusedNode) and (hiOnItem in HitInfo.HitPositions) and + (toEditOnClick in FOptions.MiscOptions) and (FFocusedColumn = HitInfo.HitColumn) and + CanEdit(FFocusedNode, HitInfo.HitColumn) then + begin + FEditColumn := FFocusedColumn; + SetTimer(Handle, EditTimer, FEditDelay, nil); + end + else + DoStateChange([], [tsEditPending]); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.HasImage(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex): Boolean; + +// Determines whether the given node has got an image of the given kind in the given column. +// Returns True if so, otherwise False. +// The given node will be implicitly initialized if needed. + +var + Ghosted: Boolean; + Index: TImageIndex; + +begin + if not (vsInitialized in Node.States) then + InitNode(Node); + + Index := -1; + Ghosted := False; + DoGetImageIndex(Node, Kind, Column, Ghosted, Index); + Result := Index > -1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.HasPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Pos: TPoint): Boolean; + +// Determines whether the tree got a popup menu, either in its PopupMenu property, via the OnGetPopupMenu event or +// through inheritance. The latter case must be checked by the descendant which must override this method. + +begin + Result := Assigned(PopupMenu) or Assigned(DoGetPopupMenu(Node, Column, Pos)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.IncVisibleCount; +begin + System.Inc(FVisibleCount); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InitChildren(Node: PVirtualNode); + +// Initiates the initialization of the child number of the given node. + +var + Count: Cardinal; + +begin + if Assigned(Node) and (Node <> FRoot) and (vsHasChildren in Node.States) then + begin + Count := Node.ChildCount; + if DoInitChildren(Node, Count) then + begin + SetChildCount(Node, Count); + if Count = 0 then + Exclude(Node.States, vsHasChildren); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InitNode(Node: PVirtualNode); + +// Initiates the initialization of the given node to allow the application to load needed data for it. + +var + InitStates: TVirtualNodeInitStates; + MustAdjustInternalVariables: Boolean; + ParentCheckState, SelfCheckState: TCheckState; +begin + with Node^ do + begin + Include(States, vsInitializing); + try + InitStates := []; + if vsInitialized in States then + Include(InitStates, ivsReInit); + Include(States, vsInitialized); + if Parent = FRoot then + DoInitNode(nil, Node, InitStates) + else + DoInitNode(Parent, Node, InitStates); + + // Fix: Any parent check state must be propagated here. + // Because the CheckType is normally set in DoInitNode + // by the App. + if (Node.CheckType = ctTriStateCheckBox) and (toAutoTristateTracking in FOptions.AutoOptions) then + begin + ParentCheckState := Self.GetCheckState(Node.Parent); + SelfCheckState := Self.GetCheckState(Node); + if ((ParentCheckState = csCheckedNormal) + or (ParentCheckState = csUncheckedNormal)) + and (not SelfCheckState.IsDisabled()) + and (SelfCheckState <> ParentCheckState) + and (Parent <> FRoot) + then + SetCheckState(Node, Node.Parent.CheckState); + end + else if (toSyncCheckboxesWithSelection in TreeOptions.SelectionOptions) then + Node.CheckType := TCheckType.ctCheckBox; + + if ivsDisabled in InitStates then + Include(States, vsDisabled); + if ivsHasChildren in InitStates then + Include(States, vsHasChildren); + if ivsSelected in InitStates then + InternalAddToSelection(Node, False); + if ivsMultiline in InitStates then + Include(States, vsMultiline); + if ivsFiltered in InitStates then + begin + MustAdjustInternalVariables := not ((ivsReInit in InitStates) and (vsFiltered in States)); + + Include(States, vsFiltered); + + if not (toShowFilteredNodes in FOptions.PaintOptions) and MustAdjustInternalVariables then + begin + AdjustTotalHeight(Node, -NodeHeight, True); + if FullyVisible[Node] then + System.Dec(FVisibleCount); + if FUpdateCount = 0 then + UpdateScrollBars(True); + end; + end; + + // Expanded may already be set (when called from ReinitNode) or be set in DoInitNode, allow both. + if (vsExpanded in Node.States) xor (ivsExpanded in InitStates) then + begin + // Expand node if not yet done (this will automatically initialize child nodes). + if ivsExpanded in InitStates then + ToggleNode(Node) + else + // If the node already was expanded then explicitly trigger child initialization. + if vsHasChildren in Node.States then + InitChildren(Node); + end; + finally + Exclude(States, vsInitializing); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalAddFromStream(Stream: TStream; Version: Integer; Node: PVirtualNode); + +// Loads all details for Node (including its children) from the given stream. +// Because the new nodes might be selected this method also fixes the selection array. + +var + Stop: PVirtualNode; + Index: Integer; + LastTotalHeight: TDimension; + WasFullyVisible: Boolean; + +begin + Assert(Node <> FRoot, 'The root node cannot be loaded from stream.'); + + // Keep the current total height value of Node as it has already been applied + // but might change in the load and fixup code. We have to adjust that afterwards. + LastTotalHeight := Node.TotalHeight; + WasFullyVisible := FullyVisible[Node] and not IsEffectivelyFiltered[Node]; + + // Read in the new nodes. + ReadNode(Stream, Version, Node); + + // One time update of node-internal states and the global visibility counter. + // This is located here to ease and speed up the loading process. + FixupTotalCount(Node); + AdjustTotalCount(Node.Parent, Node.TotalCount - 1, True); // -1 because Node itself was already set. + FixupTotalHeight(Node); + AdjustTotalHeight(Node.Parent, Node.TotalHeight - LastTotalHeight, True); + + // New nodes are always visible, so the visible node count has been increased already. + // If Node is now invisible we have to take back this increment and don't need to add any visible child node. + if not FullyVisible[Node] or IsEffectivelyFiltered[Node] then + begin + if WasFullyVisible then + System.Dec(FVisibleCount); + end + else + // It can never happen that the node is now fully visible but was not before as this would require + // that the visibility state of one of its parents has changed, which cannot happen during loading. + System.Inc(FVisibleCount, CountVisibleChildren(Node)); + + // Fix selection array. + ClearTempCache; + if Node = FRoot then + Stop := nil + else + Stop := Node.NextSibling; + + if toMultiSelect in FOptions.SelectionOptions then + begin + // Add all nodes which were selected before to the current selection (unless they are already there). + while Node <> Stop do + begin + if (vsSelected in Node.States) and not FindNodeInSelection(Node, Index, 0, High(FSelection)) then + InternalCacheNode(Node); + Node := GetNextNoInit(Node); + end; + if FTempNodeCount > 0 then + AddToSelection(FTempNodeCache, FTempNodeCount, True); + ClearTempCache; + end + else // No further selected nodes allowed so delete the corresponding flag in all new nodes. + while Node <> Stop do + begin + Exclude(Node.States, vsSelected); + Node := GetNextNoInit(Node); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.InternalAddToSelection(Node: PVirtualNode; ForceInsert: Boolean): Boolean; +var + lSingletonNodeArray: TNodeArray; +begin + Assert(Assigned(Node), 'Node must not be nil!'); + SetLength(lSingletonNodeArray, 1); + lSingletonNodeArray[0] := Node; + Result := InternalAddToSelection(lSingletonNodeArray, 1, ForceInsert); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.InternalAddToSelection(const NewItems: TNodeArray; NewLength: Integer; + ForceInsert: Boolean): Boolean; + +// Internal version of method AddToSelection which does not trigger OnChange events + +var + I, J: Integer; + CurrentEnd: Integer; + Constrained, + SiblingConstrained: Boolean; + lPreviousSelectedCount: Integer; + AddedNodesSize: Integer; + PTmpNode: PVirtualNode; + +begin + lPreviousSelectedCount := FSelectionCount; + // The idea behind this code is to use a kind of reverse merge sort. QuickSort is quite fast + // and would do the job here too but has a serious problem with already sorted lists like FSelection. + + // current number of valid entries + AddedNodesSize := 0; + + // 1) Remove already selected items, mark all other as being selected. + if ForceInsert then + begin + //Fix: For already selected node when selected, this path + //is used that didn't contain the Constraint logic. Added. + Constrained := toLevelSelectConstraint in FOptions.SelectionOptions; + if Constrained and (FLastSelectionLevel = -1) then + FLastSelectionLevel := GetNodeLevelForSelectConstraint(NewItems[0]); + AddedNodesSize := NewLength; + end + else + begin + Constrained := toLevelSelectConstraint in FOptions.SelectionOptions; + if Constrained and (FLastSelectionLevel = -1) then + FLastSelectionLevel := GetNodeLevelForSelectConstraint(NewItems[0]); + SiblingConstrained := toSiblingSelectConstraint in FOptions.SelectionOptions; + if SiblingConstrained and (FRangeAnchor = nil) then + FRangeAnchor := NewItems[0]; + + for I := 0 to NewLength - 1 do + if ([vsSelected, vsDisabled] * NewItems[I].States <> []) or + (Constrained and (Cardinal(FLastSelectionLevel) <> GetNodeLevel(NewItems[I]))) or + (SiblingConstrained and (FRangeAnchor.Parent <> NewItems[I].Parent)) + then + System.Inc(PAnsiChar(NewItems[I])) // mark as invalid by setting the LSB + else + System.Inc(AddedNodesSize); + end; + + I := PackArray(NewItems, NewLength); + if I > -1 then + NewLength := I; + + Result := NewLength > 0; + if Result then + begin + // 2) Sort the new item list so we can easily traverse it. + if NewLength > 1 then + QuickSort(NewItems, 0, NewLength - 1); + // 3) Make room in FSelection for the new items. + if lPreviousSelectedCount + NewLength >= Length(FSelection) then + SetLength(FSelection, lPreviousSelectedCount + NewLength); + + // 4) Merge in new items + J := NewLength - 1; + CurrentEnd := lPreviousSelectedCount - 1; + + while J >= 0 do + begin + // First insert all new entries which are greater than the greatest entry in the old list. + // If the current end marker is < 0 then there's nothing more to move in the selection + // array and only the remaining new items must be inserted. + if CurrentEnd >= 0 then + begin + while (J >= 0) and (PAnsiChar(NewItems[J]) > PAnsiChar(FSelection[CurrentEnd])) do + begin + FSelection[CurrentEnd + J + 1] := NewItems[J]; + System.Dec(J); + end; + // early out if nothing more needs to be copied + if J < 0 then + Break; + end + else + begin + // insert remaining new entries at position 0 + System.Move(NewItems[0], FSelection[0], (J + 1) * SizeOf(Pointer)); + // nothing more to do so exit main loop + Break; + end; + + // find the last entry in the remaining selection list which is smaller then the largest + // entry in the remaining new items list + FindNodeInSelection(NewItems[J], I, 0, CurrentEnd); + System.Dec(I); + // move all entries which are greater than the greatest entry in the new items list up + // so the remaining gap travels down to where new items must be inserted + System.Move(FSelection[I + 1], FSelection[I + J + 2], (CurrentEnd - I) * SizeOf(Pointer)); + CurrentEnd := I; + end; + + // update selection count + System.Inc(FSelectionCount, AddedNodesSize); + + // post process added nodes + // First set vsSelected flag for all newly selected nodes, then fire event + for I := 0 to AddedNodesSize - 1 do + Include(NewItems[I].States, vsSelected); + + for I := 0 to AddedNodesSize - 1 do + begin + PTmpNode := NewItems[I]; + // call on add event callbackevent + DoAddToSelection(PTmpNode); + if SyncCheckstateWithSelection[PTmpNode] then + checkstate[PTmpNode] := csCheckedNormal; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalCacheNode(Node: PVirtualNode); + +// Adds the given node to the temporary node cache (used when collecting possibly large amounts of nodes). + +var + Len: Cardinal; + +begin + Len := Length(FTempNodeCache); + if FTempNodeCount = Len then + begin + if Len < 100 then + Len := 100 + else + Len := Len + Len div 10; + SetLength(FTempNodeCache, Len); + end; + FTempNodeCache[FTempNodeCount] := Node; + System.Inc(FTempNodeCount); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalClearSelection(); + +var + Count: Integer; + lNode: PVirtualNode; +begin + // It is possible that there are invalid node references in the selection array + // if the tree update is locked and changes in the structure were made. + // Handle this potentially dangerous situation by packing the selection array explicitely. + if IsUpdating then + begin + Count := PackArray(FSelection, FSelectionCount); + if Count > -1 then + begin + FSelectionCount := Count; + SetLength(FSelection, FSelectionCount); + end; + end; + + while FSelectionCount > 0 do + begin + System.Dec(FSelectionCount); + lNode := FSelection[FSelectionCount]; + //sync path note: deselect when click on another or on outside area + Exclude(lNode.States, vsSelected); + if SyncCheckstateWithSelection[lNode] then + CheckState[lNode] := csUncheckedNormal; + DoRemoveFromSelection(lNode); + end; + ResetRangeAnchor; + FSelection := nil; + DoStateChange([], [tsClearPending]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalConnectNode(Node, Destination: PVirtualNode; Target: TBaseVirtualTree; + Mode: TVTNodeAttachMode); + +// Connects Node with Destination depending on Mode. +// No error checking takes place. Node as well as Destination must be valid. Node must never be a root node and +// Destination must not be a root node if Mode is amInsertBefore or amInsertAfter. + +var + Run: PVirtualNode; + +begin + // Keep in mind that the destination node might belong to another tree. + with Target do + begin + case Mode of + amInsertBefore: + begin + Node.SetPrevSibling(Destination.PrevSibling); + Destination.SetPrevSibling(Node); + Node.SetNextSibling(Destination); + Node.SetParent(Destination.Parent); + Node.SetIndex(Destination.Index); + if Node.PrevSibling = nil then + Node.Parent.SetFirstChild(Node) + else + Node.PrevSibling.SetNextSibling(Node); + + // reindex all following nodes + Run := Destination; + while Assigned(Run) do + begin + Run.SetIndex(Run.Index + 1); + Run := Run.NextSibling; + end; + end; + amInsertAfter: + begin + Node.SetNextSibling(Destination.NextSibling); + Destination.SetNextSibling(Node); + Node.SetPrevSibling(Destination); + Node.SetParent(Destination.Parent); + if Node.NextSibling = nil then + Node.Parent.SetLastChild(Node) + else + Node.NextSibling.SetPrevSibling(Node); + Node.SetIndex(Destination.Index); + + // reindex all following nodes + Run := Node; + while Assigned(Run) do + begin + Run.SetIndex(Run.Index + 1); + Run := Run.NextSibling; + end; + end; + amAddChildFirst: + begin + if Assigned(Destination.FirstChild) then + begin + // If there's a first child then there must also be a last child. + Destination.FirstChild.SetPrevSibling(Node); + Node.SetNextSibling(Destination.FirstChild); + Destination.SetFirstChild(Node); + end + else + begin + // First child node at this location. + Destination.SetFirstChild(Node); + Destination.SetLastChild(Node); + Node.SetNextSibling(nil); + end; + Node.SetPrevSibling(nil); + Node.SetParent(Destination); + Node.SetIndex(0); + // reindex all following nodes + Run := Node.NextSibling; + while Assigned(Run) do + begin + Run.SetIndex(Run.Index + 1); + Run := Run.NextSibling; + end; + end; + amAddChildLast: + begin + if Assigned(Destination.LastChild) then + begin + // If there's a last child then there must also be a first child. + Destination.LastChild.SetNextSibling(Node); + Node.SetPrevSibling(Destination.LastChild); + Destination.SetLastChild(Node); + end + else + begin + // first child node at this location + Destination.SetFirstChild(Node); + Destination.SetLastChild(Node); + Node.SetPrevSibling(nil); + end; + Node.SetNextSibling(nil); + Node.SetParent(Destination); + if Assigned(Node.PrevSibling) then + Node.SetIndex(Node.PrevSibling.Index + 1) + else + Node.SetIndex(0); + end; + else + // amNoWhere: do nothing + end; + // Remove temporary states. + Node.States := Node.States - [vsChecking, vsCutOrCopy, vsDeleting]; + + if (Mode <> amNoWhere) then begin + Node.Parent.SetChildCount(Node.Parent.ChildCount + 1); + Include(Node.Parent.States, vsHasChildren); + AdjustTotalCount(Node.Parent, Node.TotalCount, True); + + // Add the new node's height only if its parent is expanded. + if (vsExpanded in Node.Parent.States) and (vsVisible in Node.States) then begin + AdjustTotalHeight(Node.Parent, Node.TotalHeight, True); + System.Inc(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); + end;//if + + // Update the hidden children flag of the parent. + if (Node.Parent <> FRoot) then + begin + // If we have added a visible node then simply remove the all-children-hidden flag. + if IsEffectivelyVisible[Node] then + Exclude(Node.Parent.States, vsAllChildrenHidden) + else begin + // If we have added an invisible node and this is the only child node then + // make sure the all-children-hidden flag is in a determined state. + // If there were child nodes before then no action is needed. + if Node.Parent.ChildCount = 1 then + Include(Node.Parent.States, vsAllChildrenHidden); + end;//else + end; //if Node.Parent <> FRoot + end;//if Mode <> amNoWhere + end;//With +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.InternalData(Node: PVirtualNode): Pointer; + +begin + Result := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalDisconnectNode(Node: PVirtualNode; KeepFocus: Boolean; Reindex: Boolean = True; ParentClearing: Boolean = False); + +// Disconnects the given node from its parent and siblings. The node's pointer are not reset so they can still be used +// after return from this method (probably a very short time only!). +// If KeepFocus is True then the focused node is not reset. This is useful if the given node is reconnected to the tree +// immediately after return of this method and should stay being the focused node if it was it before. +// Note: Node must not be nil or the root node. + +var + Parent, + Run: PVirtualNode; + Index: Integer; + AdjustHeight: Boolean; + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Node must neither be nil nor the root node.'); + + if (Node = FFocusedNode) and not KeepFocus then + begin + DoFocusNode(nil, False); + DoFocusChange(FFocusedNode, FFocusedColumn); + end; + + if Node = FRangeAnchor then + ResetRangeAnchor; + + // Update the hidden children flag of the parent. + if (Node.Parent <> FRoot) and not (ParentClearing) then + if FUpdateCount = 0 then + DetermineHiddenChildrenFlag(Node.Parent) + else + Include(FStates, tsUpdateHiddenChildrenNeeded); + + if not (vsDeleting in Node.States) then + begin + // Some states are only temporary so take them out. + Node.States := Node.States - [vsChecking]; + Parent := Node.Parent; + Parent.SetChildCount(Parent.ChildCount - 1); + AdjustHeight := (vsExpanded in Parent.States) and (vsVisible in Node.States); + if Parent.ChildCount = 0 then + begin + Parent.States := Parent.States - [vsAllChildrenHidden, vsHasChildren]; + if (Parent <> FRoot) and (vsExpanded in Parent.States) then + Exclude(Parent.States, vsExpanded); + end; + AdjustTotalCount(Parent, -Integer(Node.TotalCount), True); + if AdjustHeight then + AdjustTotalHeight(Parent, -Node.TotalHeight, True); + if FullyVisible[Node] then + System.Dec(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); + + if Assigned(Node.PrevSibling) then + Node.PrevSibling.SetNextSibling(Node.NextSibling) + else + Parent.SetFirstChild(Node.NextSibling); + + if Assigned(Node.NextSibling) then + begin + Node.NextSibling.SetPrevSibling(Node.PrevSibling); + // Reindex all following nodes. + if Reindex then + begin + Run := Node.NextSibling; + Index := Node.Index; + while Assigned(Run) do + begin + Run.SetIndex(Index); + System.Inc(Index); + Run := Run.NextSibling; + end; + end; + end + else + Parent.SetLastChild(Node.PrevSibling); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalRemoveFromSelection(Node: PVirtualNode); + +// Special version to mark a node to be no longer in the current selection. PackArray must +// be used to remove finally those entries. + +var + Index: Integer; + +begin + // Because pointers are always DWORD aligned we can simply increment all those + // which we want to have removed (see also PackArray) and still have the + // order in the list preserved. + if FindNodeInSelection(Node, Index, -1, -1) then + begin + //sync path note: deselect when overlapping drawselection is made + Exclude(Node.States, vsSelected); + if SyncCheckstateWithSelection[Node] then + Node.CheckState := csUncheckedNormal; // Avoid using SetCheckState() as it handles toSyncCheckboxesWithSelection as well. + System.Inc(PAnsiChar(FSelection[Index])); + // update selection count + System.Dec(FSelectionCount); // Fixes #1197 + DoRemoveFromSelection(Node); + Change(Node); // Calling Change() here fixes issue #1047 + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalSetFocusedColumn(const index: TColumnIndex); +begin + FFocusedColumn := index; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InvalidateCache; + +// Marks the cache as invalid. + +begin + DoStateChange([tsValidationNeeded], [tsUseCache]); + //ChangeTreeStatesAsync([csValidationNeeded], [csUseCache]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.MarkCutCopyCells; +var + I: Integer; + LCell: TVTCell; +begin + // Mark that the node is included in cut/copy for multicell + for I := 0 to FSelectedCellCount - 1 do + begin + LCell := FSelectedCells[I]; + Include(LCell.Node.States, vsCutOrCopy); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.MarkCutCopyNodes; + +// Sets the vsCutOrCopy style in every currently selected but not disabled node to indicate it is +// now part of a clipboard operation. + +var + Nodes: TNodeArray; + I: Integer; + +begin + Nodes := nil; + if FSelectionCount > 0 then + begin + // need the current selection sorted to exclude selected nodes which are children, grandchildren etc. of + // already selected nodes + Nodes := GetSortedSelection(False); + for I := 0 to High(Nodes) do + with Nodes[I]^ do + if not (vsDisabled in States) then + Include(States, vsCutOrCopy); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.Loaded; + +var + LastRootCount: Cardinal; + IsReadOnly: Boolean; + +begin + inherited; + + // Call RegisterDragDrop after all visual inheritance changes to MiscOptions have been applied. + 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. + if (tsNeedRootCountUpdate in FStates) and (FRoot.ChildCount > 0) then + begin + DoStateChange([], [tsNeedRootCountUpdate]); + IsReadOnly := toReadOnly in FOptions.MiscOptions; + FOptions.InternalSetMiscOptions(FOptions.MiscOptions - [toReadOnly]); + LastRootCount := FRoot.ChildCount; + FRoot.SetChildCount(0); + BeginUpdate; + SetChildCount(FRoot, LastRootCount); + EndUpdate; + if IsReadOnly then + FOptions.InternalSetMiscOptions(FOptions.MiscOptions + [toReadOnly]); + end; + + // Prevent the object inspector at design time from marking the header as being modified + // when auto resize is enabled. + Updating; + try + TVTHeaderCracker(FHeader).UpdateMainColumn; + TVirtualTreeColumnsCracker(FHeader.Columns).FixPositions; + if toAutoBidiColumnOrdering in FOptions.AutoOptions then + TVirtualTreeColumnsCracker(FHeader.Columns).ReorderColumns(UseRightToLeftAlignment); + // Because of the special recursion and update stopper when creating the window (or resizing it) + // we have to manually trigger the auto size calculation here. + if hsNeedScaling in FHeader.States then + TVTHeaderCracker(FHeader).RescaleHeader + else + TVTHeaderCracker(FHeader).RecalculateHeader; + if hoAutoResize in FHeader.Options then + TVirtualTreeColumnsCracker(FHeader.Columns).AdjustAutoSize(InvalidColumn, True); + finally + Updated; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.MainColumnChanged; + +begin + DoCancelEdit; + NotifyAccessibleEvent(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: TDimension); + +var + R: TRect; + +begin + if tsNodeHeightTrackPending in FStates then + begin + // Remove hint if shown currently. + Application.CancelHint; + + // Stop wheel panning if active. + StopWheelPanning; + + // Stop timers + StopTimer(ExpandTimer); + StopTimer(EditTimer); + StopTimer(HeaderTimer); + StopTimer(ScrollTimer); + StopTimer(SearchTimer); + FSearchBuffer := ''; + FLastSearchNode := nil; + + DoStateChange([tsNodeHeightTracking], [tsScrollPending, tsScrolling, tsEditPending, tsOLEDragPending, tsVCLDragPending, + tsIncrementalSearching, tsNodeHeightTrackPending]); + end; + + if tsDrawSelPending in FStates then + begin + // Remove current selection in case the user clicked somewhere in the window (but not a node) + // and moved the mouse. + if CalculateSelectionRect(X, Y) then + begin + InvalidateRect(@FNewSelRect, False); + UpdateWindow(); + if (Abs(FNewSelRect.Right - FNewSelRect.Left) > Mouse.DragThreshold) or + (Abs(FNewSelRect.Bottom - FNewSelRect.Top) > Mouse.DragThreshold) then + begin + if tsClearPending in FStates then + begin + DoStateChange([], [tsClearPending]); + ClearSelection; + end; + DoStateChange([tsDrawSelecting], [tsDrawSelPending]); + + // Reset to main column for multiselection. + FocusedColumn := FHeader.MainColumn; + + // The current rectangle may already include some node captions. Handle this. + if HandleDrawSelection(X, Y) then + InvalidateRect(nil, False); + end; + end; + end + else + begin + if tsNodeHeightTracking in FStates then + begin + // Handle height tracking. + if DoNodeHeightTracking(FHeightTrackNode, FHeightTrackColumn, TVTHeaderCracker(FHeader).GetShiftState, FHeightTrackPoint, Point(X, Y)) then + begin + // Avoid negative (or zero) node heights. + if FHeightTrackPoint.Y >= Y then + Y := FHeightTrackPoint.Y + 1; + SetNodeHeight(FHeightTrackNode, Y - FHeightTrackPoint.Y); + UpdateWindow(); + Exit; + end; + end; + + // Really start dragging if the mouse has been moved more than the threshold. + if (tsOLEDragPending in FStates) and + ( + ((Abs(FLastClickPos.X - X) >= FDragThreshold) and (X > 0)) or // Check >0 to fix issue #833 + ((Abs(FLastClickPos.Y - Y) >= FDragThreshold) and (Y > 0)) + ) + then + DoDragging(FLastClickPos) + else + begin + if CanAutoScroll then + DoAutoScroll(X, Y); + if tsPanning in FStates then + AdjustPanningCursor(X, Y); + if not IsMouseSelecting then + begin + HandleHotTrack(X, Y); + inherited MouseMove(Shift, X, Y); + end + else + begin + // Handle draw selection if required, but don't do the work twice if the + // auto scrolling code already cares about the selection. + if not (tsScrolling in FStates) and CalculateSelectionRect(X, Y) then + begin + // If something in the selection changed then invalidate the entire + // tree instead trying to figure out the display rects of all changed nodes. + if HandleDrawSelection(X, Y) then + InvalidateRect(nil, False) + else + begin + UnionRect(R, OrderRect(FNewSelRect), OrderRect(FLastSelRect)); + OffsetRect(R, -FEffectiveOffsetX, FOffsetY); + InvalidateRect(@R, False); + end; + UpdateWindow(); + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.Notification(AComponent: TComponent; Operation: TOperation); + +begin + if (AComponent <> Self) and (Operation = opRemove) then + begin + // Check for components linked to the tree. + if AComponent = FImages then + begin + Images := nil; + if not (csDestroying in ComponentState) then + Invalidate; + end + else + if AComponent = FStateImages then + begin + StateImages := nil; + if not (csDestroying in ComponentState) then + Invalidate; + end + else + if AComponent = FCustomCheckImages then + begin + CustomCheckImages := nil; + FCheckImageKind := ckSystemDefault; + if not (csDestroying in ComponentState) then + Invalidate; + end + else + if AComponent = PopupMenu then + PopupMenu := nil + else + // Check for components linked to the header. + if Assigned(FHeader) then + begin + if AComponent = FHeader.Images then + FHeader.Images := nil + else + if AComponent = FHeader.PopupMenu then + FHeader.PopupMenu := nil; + end; + end; + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.OriginalWMNCPaint(DC: HDC); + +// Unfortunately, the painting for the non-client area in TControl is not always correct and does also not consider +// existing clipping regions, so it has been modified here to take this into account. + +const + InnerStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENINNER, BDR_RAISEDINNER, 0); + OuterStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENOUTER, BDR_RAISEDOUTER, 0); + EdgeStyles: array[TBevelKind] of Integer = (0, 0, BF_SOFT, BF_FLAT); + Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0); + +var + RC, RW: TRect; + EdgeSize: Integer; + Size: TSize; + +begin + if (BevelKind <> bkNone) or (BorderWidth > 0) then + begin + RC := Rect(0, 0, Width, Height); + Size := GetBorderDimensions; + InflateRect(RC, Size.cx, Size.cy); + + RW := RC; + + if BevelKind <> bkNone then + begin + DrawEdge(DC, RC, InnerStyles[BevelInner] or OuterStyles[BevelOuter], Byte(BevelEdges) or EdgeStyles[BevelKind] or + Ctl3DStyles[Ctl3D]); + + EdgeSize := 0; + if BevelInner <> bvNone then + Inc(EdgeSize, BevelWidth); + if BevelOuter <> bvNone then + Inc(EdgeSize, BevelWidth); + if beLeft in BevelEdges then + Inc(RC.Left, EdgeSize); + if beTop in BevelEdges then + Inc(RC.Top, EdgeSize); + if beRight in BevelEdges then + Dec(RC.Right, EdgeSize); + if beBottom in BevelEdges then + Dec(RC.Bottom, EdgeSize); + end; + + // Repaint only the part in the original clipping region and not yet drawn parts. + IntersectClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom); + + // Determine inner rectangle to exclude (RC corresponds then to the client area). + InflateRect(RC, -Integer(BorderWidth), -Integer(BorderWidth)); + + // Remove the inner rectangle. + ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom); + + // Erase parts not drawn. + Brush.Color := FColors.BorderColor; + Winapi.Windows.FillRect(DC, RW, Brush.Handle); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.Paint; + +// Window paint routine. Used when the tree window needs to be updated. + +var + Window: TRect; + Target: TPoint; + Temp: TDimension; + Options: TVTInternalPaintOptions; + RTLOffset: TDimension; + +begin + + Options := [poBackground, poColumnColor, poDrawFocusRect, poDrawDropMark, poDrawSelection, poGridLines]; + if UseRightToLeftAlignment and FHeader.UseColumns then + RTLOffset := ComputeRTLOffset(True) + else + RTLOffset := 0; + + // The update rect has already been filled in WMPaint, as it is the window's update rect, which gets + // reset when BeginPaint is called (in the ancestor). + // The difference to the DC's clipbox is that it is also valid with internal paint operations used + // e.g. by the Explorer while dragging, but show window content while dragging is disabled. + if not IsRectEmpty(FUpdateRect) then + begin + Temp := Header.Columns.GetVisibleFixedWidth; + if Temp = 0 then + begin + Window := FUpdateRect; + Target := Window.TopLeft; + + // The clipping rectangle is given in client coordinates of the window. We have to convert it into + // a sliding window of the tree image. + OffsetRect(Window, FEffectiveOffsetX - RTLOffset, -FOffsetY); + PaintTree(Canvas, Window, Target, Options); + end + else + begin + // First part, fixed columns + Window := ClientRect; + Window.Right := Temp; + Target := Window.TopLeft; + + OffsetRect(Window, -RTLOffset, -FOffsetY); + PaintTree(Canvas, Window, Target, Options); + + // Second part, other columns + Window := GetClientRect; + + if Temp > Window.Right then + Exit; + + Window.Left := Temp; + Target := Window.TopLeft; + + OffsetRect(Window, FEffectiveOffsetX - RTLOffset, -FOffsetY); + PaintTree(Canvas, Window, Target, Options); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.PaintCheckImage(Canvas: TCanvas; const ImageInfo: TVTImageInfo; Selected: Boolean); + +var + ForegroundColor: COLORREF; + R: TRect; + Details, lSizeDetails: TThemedElementDetails; + lSize: TSize; + Theme: HTHEME; + lCheckImages: TCustomImageList; +begin + with ImageInfo do + begin + if (tsUseThemes in FStates) and (FCheckImageKind = ckSystemDefault) then + begin + Details.Element := teButton; + case Index of + // ctRadioButton + 1 : Details := StyleServices.GetElementDetails(tbRadioButtonUncheckedNormal); + 2 : Details := StyleServices.GetElementDetails(tbRadioButtonUncheckedHot); + 3 : Details := StyleServices.GetElementDetails(tbRadioButtonUncheckedPressed); + 4 : Details := StyleServices.GetElementDetails(tbRadioButtonUncheckedDisabled); + 5 : Details := StyleServices.GetElementDetails(tbRadioButtonCheckedNormal); + 6 : Details := StyleServices.GetElementDetails(tbRadioButtonCheckedHot); + 7 : Details := StyleServices.GetElementDetails(tbRadioButtonCheckedPressed); + 8 : Details := StyleServices.GetElementDetails(tbRadioButtonCheckedDisabled); + // ct(TriState)CheckBox + 9 : Details := StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal); + 10 : Details := StyleServices.GetElementDetails(tbCheckBoxUncheckedHot); + 11 : Details := StyleServices.GetElementDetails(tbCheckBoxUncheckedPressed); + 12 : Details := StyleServices.GetElementDetails(tbCheckBoxUncheckedDisabled); + 13 : Details := StyleServices.GetElementDetails(tbCheckBoxCheckedNormal); + 14 : Details := StyleServices.GetElementDetails(tbCheckBoxCheckedHot); + 15 : Details := StyleServices.GetElementDetails(tbCheckBoxCheckedPressed); + 16 : Details := StyleServices.GetElementDetails(tbCheckBoxCheckedDisabled); + 17 : Details := StyleServices.GetElementDetails(tbCheckBoxMixedNormal); + 18 : Details := StyleServices.GetElementDetails(tbCheckBoxMixedHot); + 19 : Details := StyleServices.GetElementDetails(tbCheckBoxMixedPressed); + 20 : Details := StyleServices.GetElementDetails(tbCheckBoxMixedDisabled); + // ctButton + ckButtonNormal: Details := StyleServices.GetElementDetails(tbPushButtonNormal); + ckButtonHot: Details := StyleServices.GetElementDetails(tbPushButtonHot); + ckButtonPressed: Details := StyleServices.GetElementDetails(tbPushButtonPressed); + ckButtonDisabled: Details := StyleServices.GetElementDetails(tbPushButtonDisabled); + else + Details := StyleServices.GetElementDetails(tbButtonRoot); + end; + if StyleServices.IsSystemStyle {and not (Index in [ckButtonNormal..ckButtonDisabled])} then + begin + Theme := OpenThemeData(Handle, 'BUTTON'); + GetThemePartSize(Theme, Canvas.Handle, Details.Part, Details.State, nil, TS_TRUE, lSize); + if (Index in [ckButtonNormal..ckButtonDisabled]) then begin + lSizeDetails := StyleServices.GetElementDetails(tbCheckBoxCheckedNormal); // Size of dropdown button should be based on size of checkboxes + GetThemePartSize(Theme, Canvas.Handle, lSizeDetails.Part, lSizeDetails.State, nil, TS_TRUE, lSize); + // dropdown buttons should be slightly larger than checkboxes, see issue #887 + lSize.cx := Round(lSize.cx * 1.15); + lSize.cy := Round(lSize.cy * 1.1); + end; + R := Rect(XPos, YPos, XPos + lSize.cx, YPos + lSize.cy); + if (Index in [ckButtonNormal..ckButtonDisabled]) then + R.Offset(-1, 0); // Eliminate 1 pixel border around Windows themed button + DrawThemeBackground(Theme, Canvas.Handle, Details.Part, Details.State, R, nil); + CloseThemeData(Theme); + end + else + begin + if (Index in [ckButtonNormal..ckButtonDisabled]) or not StyleServices.GetElementSize(Canvas.Handle, Details, TElementSize.esActual, lSize{$IF CompilerVersion >= 34}, CurrentPPI{$IFEND}) then begin + // radio buttons fail in RAD Studio 10 Seattle and lower, fallback to checkbox images. See issue #615 + if not StyleServices.GetElementSize(Canvas.Handle, StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal), TElementSize.esActual, lSize{$IF CompilerVersion >= 34}, CurrentPPI{$IFEND}) then + lSize := TSize.Create(GetSystemMetrics(SM_CXMENUCHECK), GetSystemMetrics(SM_CYMENUCHECK)); + end;//if + R := Rect(XPos, YPos, XPos + lSize.cx, YPos + lSize.cy); + StyleServices.DrawElement(Canvas.Handle, Details, R {$IF CompilerVersion >= 34}, nil, FCurrentPPI{$IFEND}); + Canvas.Refresh; // Every time you give a Canvas.Handle away to some other code you can't control you have to call Canvas.Refresh afterwards because the Canvas object and the HDC can be out of sync. + end; + if (Index in [ckButtonNormal..ckButtonDisabled]) then begin + Canvas.Pen.Color := clGray; + // These constants have been determined by test using various themes and dpi-scalings + 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 begin + if Assigned(FCheckImages) then + lCheckImages := FCheckImages + else + lCheckImages := FCustomCheckImages; + with lCheckImages do + begin + if Selected and not Ghosted then + begin + if Focused or (TVTPaintOption.toPopupMode in FOptions.PaintOptions) then + ForegroundColor := ColorToRGB(FColors.FocusedSelectionColor) + else + ForegroundColor := ColorToRGB(FColors.UnfocusedSelectionColor); + end + else + ForegroundColor := GetRGBColor(BlendColor); + + ImageList_DrawEx(Handle, Index, Canvas.Handle, XPos, YPos, 0, 0, GetRGBColor(BkColor), ForegroundColor, + ILD_TRANSPARENT); + end; + end; //else + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + + +procedure TBaseVirtualTree.PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean); +const + Style: array[TImageType] of Cardinal = (0, ILD_MASK); +var + ExtraStyle: Cardinal; + CutNode: Boolean; + PaintFocused: Boolean; + DrawEnabled: Boolean; + CustomOverlayDrawing: Boolean; // False if the built-in overloay drawing of TImageList should be used, True if custom drawing should take place. +begin + with PaintInfo do + begin + CutNode := (vsCutOrCopy in Node.States) and (tsCutPending in FStates); + PaintFocused := Focused or (toGhostedIfUnfocused in FOptions.PaintOptions); + + // Since the overlay image must be specified together with the image to draw + // it is meaningfull to retrieve it in advance. + if DoOverlay then + GetImageIndex(PaintInfo, ikOverlay, iiOverlay) + else + PaintInfo.ImageInfo[iiOverlay].Index := -1; + + DrawEnabled := not (vsDisabled in Node.States) and Enabled; + with ImageInfo[ImageInfoIndex] do + begin + if (vsSelected in Node.States) and not(Ghosted or CutNode) then + begin + if PaintFocused or (toPopupMode in FOptions.PaintOptions) then + Images.BlendColor := FColors.FocusedSelectionColor + else + Images.BlendColor := FColors.UnfocusedSelectionColor; + end + else + Images.BlendColor := Color; + + ExtraStyle := ILD_TRANSPARENT; + // If the user returned an index >= 15 then we cannot use the built-in overlay image drawing. + // Instead we do it manually. Also of the image list of the normal and the overlay icon is different, + // we can't use the built-in drawing. See issue #779. + if (ImageInfo[iiOverlay].Index > -1) then begin + CustomOverlayDrawing := (ImageInfo[iiOverlay].Index >= 15) or (ImageInfo[iiOverlay].Images <> ImageInfo[iiNormal].Images); + if not CustomOverlayDrawing then + ExtraStyle := ILD_TRANSPARENT or ILD_OVERLAYMASK and IndexToOverlayMask(ImageInfo[iiOverlay].Index + 1); + end + else + CustomOverlayDrawing := False; + + // Blend image if enabled and the tree has the focus (or ghosted images must be drawn also if unfocused) ... + if (toUseBlendedImages in FOptions.PaintOptions) and PaintFocused + // ... and the image is ghosted... + and (Ghosted or + // ... or it is not the check image and the node is selected (but selection is not for the entire row)... + ((vsSelected in Node.States) and + not (toFullRowSelect in FOptions.SelectionOptions) and + not (toGridExtensions in FOptions.MiscOptions)) or + // ... or the node must be shown in cut mode. + CutNode) then + ExtraStyle := ExtraStyle or ILD_BLEND50; + + if (vsSelected in Node.States) and not Ghosted then + Images.BlendColor := clDefault; + + DrawImage(Images, Index, Canvas, XPos, YPos, Style[Images.ImageType] or ExtraStyle, DrawEnabled); + + // Now, draw the overlay. This circumnavigates limitations in the overlay mask index (it has to be 4 bits in size, + // anything larger will be truncated by the ILD_OVERLAYMASK). + // However this will only be done if the overlay image index is > 15, to avoid breaking code that relies + // on overlay image indices (e.g. when using system image lists). + if CustomOverlayDrawing then begin + ExtraStyle := ExtraStyle and not ILD_BLEND50; // Fixes issue #551 + // Note: XPos and YPos are those of the normal images. + DrawImage(ImageInfo[iiOverlay].Images, ImageInfo[iiOverlay].Index, Canvas, XPos, YPos, + Style[ImageInfo[iiOverlay].Images.ImageType] or ExtraStyle, DrawEnabled); + end;//if + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect; + ButtonX, ButtonY: TDimension; BidiMode: TBiDiMode); + +var + Bitmap: TBitmap; + XPos: TDimension; + IsHot: Boolean; + IsSelected : boolean; + Theme: HTHEME; + Glyph: Integer; + State: Integer; + Pos: TRect; + +begin + IsHot := (FCurrentHotNode = Node) and FHotNodeButtonHit; + IsSelected := (vsSelected in Node.States); + + // Draw the node's plus/minus button according to the directionality. + if BidiMode = bdLeftToRight then + XPos := R.Left + ButtonX + else + XPos := R.Right - ButtonX - FPlusBM.Width; + + if (tsUseExplorerTheme in FStates) and not VclStyleEnabled then + begin + Glyph := IfThen(IsHot, TVP_HOTGLYPH, TVP_GLYPH); + State := IfThen(vsExpanded in Node.States, GLPS_OPENED, GLPS_CLOSED); + Pos := Rect(XPos, R.Top + ButtonY, XPos + FPlusBM.Width, R.Top + ButtonY + FPlusBM.Height); + Theme := OpenThemeData(Handle, 'TREEVIEW'); + DrawThemeBackground(Theme, Canvas.Handle, Glyph, State, Pos, nil); + CloseThemeData(Theme); + end + else + begin + if vsExpanded in Node.States then + begin + if IsHot then + begin + if IsSelected then + BitMap := FSelectedHotMinusBM + else + Bitmap := FHotMinusBM; + end + else + Bitmap := FMinusBM; + end + else + begin + if IsHot then + begin + if IsSelected then + BitMap := FSelectedHotPlusBM + else + Bitmap := FHotPlusBM; + end + else + Bitmap := FPlusBM; + end; + // Need to draw this masked. + Canvas.Draw(XPos, R.Top + ButtonY, Bitmap); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; IndentSize: TDimension; const LineImage: TLineImage); + +var + I: Integer; + XPos, + Offset: TDimension; + NewStyles: TLineImage; + +begin + NewStyles := nil; + + with PaintInfo do + begin + if BidiMode = bdLeftToRight then + begin + XPos := CellRect.Left + PaintInfo.Offsets[ofsMargin]; + Offset := FIndent; + end + else + begin + Offset := -FIndent; + XPos := CellRect.Right - PaintInfo.Offsets[ofsMargin] + Offset; + end; + + case FLineMode of + lmBands: + if poGridLines in PaintInfo.PaintOptions then + begin + // Convert the line images in correct bands. + SetLength(NewStyles, Length(LineImage)); + for I := IndentSize - 1 downto 0 do + begin + if (vsExpanded in Node.States) and not (vsAllChildrenHidden in Node.States) then + NewStyles[I] := ltLeft + else + case LineImage[I] of + ltRight, + ltBottomRight, + ltTopDownRight, + ltTopRight: + NewStyles[I] := ltLeftBottom; + ltNone: + // Have to take over the image to the right of this one. A no line entry can never appear as + // last entry so I don't need an end check here. + if LineImage[I + 1] in [ltNone, ltTopRight] then + NewStyles[I] := NewStyles[I + 1] + else + NewStyles[I] := ltLeft; + ltTopDown: + // Have to check the image to the right of this one. A top down line can never appear as + // last entry so I don't need an end check here. + if LineImage[I + 1] in [ltNone, ltTopRight] then + NewStyles[I] := NewStyles[I + 1] + else + NewStyles[I] := ltLeft; + end; + end; + + PaintInfo.Canvas.Font.Color := FColors.GridLineColor; + for I := 0 to IndentSize - 1 do + begin + DoBeforeDrawLineImage(PaintInfo.Node, I + Ord(not (toShowRoot in TreeOptions.PaintOptions)), XPos); + DrawLineImage(PaintInfo, XPos, CellRect.Top, NodeHeight[Node] - 1, VAlign - 1, NewStyles[I], + BidiMode <> bdLeftToRight); + Inc(XPos, Offset); + end; + end; + else // lmNormal + PaintInfo.Canvas.Font.Color := FColors.TreeLineColor; + for I := 0 to IndentSize - 1 do + begin + DoBeforeDrawLineImage(PaintInfo.Node, I + Ord(not (toShowRoot in TreeOptions.PaintOptions)), XPos); + DrawLineImage(PaintInfo, XPos, CellRect.Top, NodeHeight[Node], VAlign - 1, LineImage[I], + BidiMode <> bdLeftToRight); + Inc(XPos, Offset); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: TDimension; const SelectionRect: TRect; + TargetRect: TRect); + +// Helper routine to draw a selection rectangle in the mode determined by DrawSelectionMode. + +var + BlendRect: TRect; + TextColorBackup, + BackColorBackup: COLORREF; // used to restore forground and background colors when drawing a selection rectangle + +begin + if ((FDrawSelectionMode = smDottedRectangle) and not (tsUseThemes in FStates)) then + begin + // Classical selection rectangle using dotted borderlines. + TextColorBackup := GetTextColor(Target.Handle); + SetTextColor(Target.Handle, $FFFFFF); + BackColorBackup := GetBkColor(Target.Handle); + SetBkColor(Target.Handle, 0); + Target.DrawFocusRect(SelectionRect); + SetTextColor(Target.Handle, TextColorBackup); + SetBkColor(Target.Handle, BackColorBackup); + end + else + begin + // Modern alpha blended style. + OffsetRect(TargetRect, WindowOrgX, 0); + if IntersectRect(BlendRect, OrderRect(SelectionRect), TargetRect) then + begin + OffsetRect(BlendRect, -WindowOrgX, 0); + AlphaBlend(0, Target.Handle, BlendRect, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, + ColorToRGB(FColors.SelectionRectangleBlendColor)); + + Target.Brush.Color := FColors.SelectionRectangleBorderColor; + Target.FrameRect(SelectionRect); + end; + end; +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. + +var + TextColorBackup, + BackColorBackup: COLORREF; + FocusRect, + InnerRect: TRect; + RowRect: TRect; + Theme: HTHEME; +const + TREIS_HOTSELECTED = 6; + + //--------------- local functions ------------------------------------------- + + procedure AlphaBlendSelection(Color: TColor); + + var + R: TRect; + + begin + // Take into account any window offset and size limitations in the target bitmap, as this is only as large + // as necessary and might not cover the whole node. For normal painting this does not matter (because of + // clipping) but for the MMX code there is no such check and it will crash badly when bitmap boundaries are + // crossed. + R := InnerRect; + OffsetRect(R, -WindowOrgX, 0); + if R.Left < 0 then + R.Left := 0; + if R.Right > MaxWidth then + R.Right := MaxWidth; + AlphaBlend(0, PaintInfo.Canvas.Handle, R, Point(0, 0), bmConstantAlphaAndColor, + FSelectionBlendFactor, ColorToRGB(Color)); + end; + + //--------------------------------------------------------------------------- + + procedure DrawBackground(State: Integer); + begin + // if the full row selection is disabled or toGridExtensions is in the MiscOptions, draw the selection + // into the InnerRect, otherwise into the RowRect + if not (toFullRowSelect in FOptions.SelectionOptions) or (toGridExtensions in FOptions.MiscOptions) then + DrawThemeBackground(Theme, PaintInfo.Canvas.Handle, TVP_TREEITEM, State, InnerRect, nil) + else + DrawThemeBackground(Theme, PaintInfo.Canvas.Handle, TVP_TREEITEM, State, RowRect, nil); + end; + + procedure DrawThemedFocusRect(State: Integer); + var + Theme: HTHEME; + begin + Theme := OpenThemeData(Application.ActiveFormHandle, 'Explorer::ItemsView'); + if not (toFullRowSelect in FOptions.SelectionOptions) or (toGridExtensions in FOptions.MiscOptions) then + DrawThemeBackground(Theme, PaintInfo.Canvas.Handle, LVP_LISTDETAIL, State, InnerRect, nil) + else + DrawThemeBackground(Theme, PaintInfo.Canvas.Handle, LVP_LISTDETAIL, State, RowRect, nil); + CloseThemeData(Theme); + end; + + //--------------- end local functions --------------------------------------- + +begin + if tsUseExplorerTheme in FStates then + begin + Theme := OpenThemeData(Application.ActiveFormHandle, 'Explorer::TreeView'); + RowRect := Rect(0, PaintInfo.CellRect.Top, FRangeX, PaintInfo.CellRect.Bottom); + if (Header.Columns.Count = 0) and (toFullRowSelect in TreeOptions.SelectionOptions) then + RowRect.Right := Max(ClientWidth, RowRect.Right); + if toShowVertGridLines in FOptions.PaintOptions then + Dec(RowRect.Right); + end; + + with PaintInfo, Canvas do + begin + // Fill cell background if its color differs from tree background. + with FHeader.Columns do + if poColumnColor in PaintOptions then + begin + Brush.Color := Items[Column].GetEffectiveColor; + FillRect(CellRect); + end + else + Brush.Color := FColors.BackGroundColor; + + + // Let the application customize the cell background and the content rectangle. + DoBeforeCellPaint(Canvas, Node, Column, cpmPaint, CellRect, ContentRect); + + InnerRect := ContentRect; + + // The selection rectangle depends on alignment. + if not (toGridExtensions in FOptions.MiscOptions) then + begin + case Alignment of + taLeftJustify: + if InnerRect.Left + NodeWidth < InnerRect.Right then + InnerRect.Right := InnerRect.Left + NodeWidth; + taCenter: + if (InnerRect.Right - InnerRect.Left) > NodeWidth then + begin + InnerRect.Left := Divide(InnerRect.Left + InnerRect.Right - NodeWidth, 2); + InnerRect.Right := InnerRect.Left + NodeWidth; + end; + taRightJustify: + if (InnerRect.Right - InnerRect.Left) > NodeWidth then + InnerRect.Left := InnerRect.Right - NodeWidth; + end; + end; + + // If this specific cell is selected, highlight the whole cell area + // (including empty space up to the next column) even when grid + // extensions are not enabled. + if InternalIsCellSelected(Node, Column) then + InnerRect := CellRect; + + if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.SelectionOptions) or InternalIsCellSelected(Node, Column) then + begin + // Fill the selection rectangle. + if poDrawSelection in PaintOptions then + begin + if Node = FDropTargetNode then + begin + if (FLastDropMode = dmOnNode) or (vsSelected in Node.States) or InternalIsCellSelected(Node, Column) then + begin + Brush.Color := FColors.DropTargetColor; + Pen.Color := FColors.DropTargetBorderColor; + + if (toGridExtensions in FOptions.MiscOptions) or + (toFullRowSelect in FOptions.SelectionOptions) then + InnerRect := CellRect; + if not IsRectEmpty(InnerRect) then + if tsUseExplorerTheme in FStates then + DrawBackground(TREIS_SELECTED) + else + if (toUseBlendedSelection in FOptions.PaintOptions) then + AlphaBlendSelection(Brush.Color) + else + RoundRect(InnerRect.Left, InnerRect.Top, InnerRect.Right, InnerRect.Bottom, FSelectionCurveRadius, FSelectionCurveRadius); + end + else + begin + Brush.Style := bsClear; + end; + end + else + if (vsSelected in Node.States) or InternalIsCellSelected(Node, Column) then + begin + if Focused or (toPopupMode in FOptions.PaintOptions) then + begin + Brush.Color := FColors.FocusedSelectionColor; + Pen.Color := FColors.FocusedSelectionBorderColor; + end + else + begin + Brush.Color := FColors.UnfocusedSelectionColor; + Pen.Color := FColors.UnfocusedSelectionBorderColor; + end; + if (toGridExtensions in FOptions.MiscOptions) or (toFullRowSelect in FOptions.SelectionOptions) then + InnerRect := CellRect; + if not IsRectEmpty(InnerRect) then + if tsUseExplorerTheme in FStates then + begin + // If the node is also hot, its background will be drawn later. + if not (toHotTrack in FOptions.PaintOptions) or (Node <> FCurrentHotNode) or + ((Column <> FCurrentHotColumn) and not (toFullRowSelect in FOptions.SelectionOptions)) then + DrawBackground(IfThen(Self.Focused, TREIS_SELECTED, TREIS_SELECTEDNOTFOCUS)); + end + else + if (toUseBlendedSelection in FOptions.PaintOptions) then + AlphaBlendSelection(Brush.Color) + else + RoundRect(InnerRect.Left, InnerRect.Top, InnerRect.Right, InnerRect.Bottom, FSelectionCurveRadius, FSelectionCurveRadius); + end; + end; + end; + + if (tsUseExplorerTheme in FStates) and (toHotTrack in FOptions.PaintOptions) and (Node = FCurrentHotNode) and + ((Column = FCurrentHotColumn) or (toFullRowSelect in FOptions.SelectionOptions)) then + DrawBackground(IfThen(((vsSelected in Node.States) or InternalIsCellSelected(Node, Column)) and not (toAlwaysHideSelection in FOptions.PaintOptions), + TREIS_HOTSELECTED, TREIS_HOT)); + + if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.SelectionOptions) then + begin + // draw focus rect + if (poDrawFocusRect in PaintOptions) and + (Focused or (toPopupMode in FOptions.PaintOptions)) and (FFocusedNode = Node) and + ( (Column = FFocusedColumn) or + (not (toExtendedFocus in FOptions.SelectionOptions) and + (toFullRowSelect in FOptions.SelectionOptions) and + (tsUseExplorerTheme in FStates) ) ) then + begin + TextColorBackup := GetTextColor(Handle); + SetTextColor(Handle, $FFFFFF); + BackColorBackup := GetBkColor(Handle); + SetBkColor(Handle, 0); + + if not (toExtendedFocus in FOptions.SelectionOptions) and (toFullRowSelect in FOptions.SelectionOptions) and + (tsUseExplorerTheme in FStates) then + FocusRect := RowRect + else + if toGridExtensions in FOptions.MiscOptions then + FocusRect := CellRect + else + FocusRect := InnerRect; + + if tsUseExplorerTheme in FStates then + InflateRect(FocusRect, -1, -1); + + if (tsUseExplorerTheme in FStates) then + begin + //Draw focused unselected style like Windows 7 Explorer + if not ((vsSelected in Node.States) or InternalIsCellSelected(Node, Column)) then + DrawThemedFocusRect(LIS_NORMAL) + else + DrawBackground(TREIS_HOTSELECTED); + end + else + Winapi.Windows.DrawFocusRect(Handle, FocusRect); + SetTextColor(Handle, TextColorBackup); + SetBkColor(Handle, BackColorBackup); + end; + end; + end; + + if tsUseExplorerTheme in FStates then + CloseThemeData(Theme); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +class procedure TBaseVirtualTree.RaiseVTError(const Msg: string; HelpContext: Integer); + +begin + raise EVirtualTreeError.CreateHelp(Msg, HelpContext); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, + ChunkSize: Integer): Boolean; + +// Called while loading a tree structure, Node is already valid (allocated) at this point. +// The function handles the base and user chunks, any other chunk is marked as being unknown (result becomes False) +// and skipped. descendants may handle them by overriding this method. +// Returns True if the chunk could be handled, otherwise False. +type + TAdvancedVersion2Identifier = packed record + ChildCount: Cardinal; + NodeHeight: TDimension; + States: Word; + Align: Byte; + CheckState: TCheckState; + CheckType: TCheckType; + Reserved: Cardinal; + end; + +var + IdBody: TAdvancedVersion2Identifier; + ChunkBody: TBaseChunkBody; + Run: PVirtualNode; + LastPosition: Integer; + +begin + case ChunkType of + BaseChunk: + begin + // Load base chunk's body (chunk header has already been consumed). + case Version of + 1: + begin + with ChunkBody do + begin + // In version prior to 2 there was a smaller chunk body. Hence we have to read it entry by entry now. + Stream.Read(ChildCount, SizeOf(ChildCount)); + Stream.Read(NodeHeight, SizeOf(NodeHeight)); + // TVirtualNodeStates was a byte sized type in version 1. + States := []; + Stream.Read(States, SizeOf(Byte)); + // vsVisible is now in the place where vsSelected was before, but every node was visible in the old version + // so we need to fix this too. + if vsVisible in States then + //sync path note: prior version stream reading, ignored for syncing + Include(States, vsSelected) + else + Include(States, vsVisible); + Stream.Read(Align, SizeOf(Align)); + Stream.Read(CheckState, SizeOf(CheckState)); + Stream.Read(CheckType, SizeOf(CheckType)); + end; + end; + 2: + begin + ZeroMemory(@IdBody, SizeOf(IdBody)); + Stream.Read(IdBody, SizeOf(IdBody)); + // If Align is greater than zero, we have a stream prior to VT version 6.2 + if IdBody.Align > 0 then + with ChunkBody do + begin + ChildCount := IdBody.ChildCount; + NodeHeight := IdBody.NodeHeight; + States := []; + System.Move(IdBody.States, States, SizeOf(IdBody.States)); + CheckState := IdBody.CheckState; + CheckType := IdBody.CheckType; + Reserved := IdBody.Reserved; + end + else + begin + // Stream is compatible with current size of TBaseChunkBody + Stream.Position := Stream.Position - SizeOf(IdBody); + Stream.Read(ChunkBody, SizeOf(ChunkBody)); + end; + end; + 3: + Stream.Read(ChunkBody, SizeOf(ChunkBody)); + end; + + with Node^ do + begin + // Set states first, in case the node is invisible. + States := ChunkBody.States; + SetNodeHeight(ChunkBody.NodeHeight); + TotalHeight := NodeHeight; + Align := ChunkBody.Align; + CheckState := ChunkBody.CheckState; + CheckType := ChunkBody.CheckType; + SetChildCount(ChunkBody.ChildCount); + + // Create and read child nodes. + while ChunkBody.ChildCount > 0 do + begin + Run := MakeNewNode; + + Run.SetPrevSibling(Node.LastChild); + if Assigned(Run.PrevSibling) then + Run.SetIndex(Run.PrevSibling.Index + 1); + if Assigned(Node.LastChild) then + Node.LastChild.SetNextSibling(Run) + else + Node.SetFirstChild(Run); + Node.SetLastChild(Run); + Run.SetParent(Node); + + ReadNode(Stream, Version, Run); + System.Dec(ChunkBody.ChildCount); + end; + end; + Result := True; + end; + UserChunk: + if ChunkSize > 0 then + begin + // need to know whether the data was read + LastPosition := Stream.Position; + DoLoadUserData(Node, Stream); + // compare stream position to learn whether the data was read + Result := Stream.Position > LastPosition; + // Improve stability by advancing the stream to the chunk's real end if + // the application did not read what has been written. + if not Result or (Stream.Position <> (LastPosition + ChunkSize)) then + Stream.Position := LastPosition + ChunkSize; + end + else + Result := True; + else + // unknown chunk, skip it + Stream.Position := Stream.Position + ChunkSize; + Result := False; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ReadNode(Stream: TStream; Version: Integer; Node: PVirtualNode); + +// Reads the anchor chunk of each node and initiates reading the sub chunks for this node + +var + Header: TChunkHeader; + EndPosition: Integer; + +begin + with Stream do + begin + // Read anchor chunk of the node. + Stream.Read(Header, SizeOf(Header)); + if Header.ChunkType = NodeChunk then + begin + EndPosition := Stream.Position + Header.ChunkSize; + // Read all subchunks until the indicated chunk end position is reached in the stream. + while Position < EndPosition do + begin + // Read new chunk header. + Stream.Read(Header, SizeOf(Header)); + ReadChunk(Stream, Version, Node, Header.ChunkType, Header.ChunkSize); + end; + // If the last chunk does not end at the given end position then there is something wrong. + if Position <> EndPosition then + RaiseVTError(SCorruptStream2, hcTFCorruptStream2); + end + else + RaiseVTError(SCorruptStream1, hcTFCorruptStream1); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.RedirectFontChangeEvent(Canvas: TCanvas); + +begin + if @Canvas.Font.OnChange <> @FOldFontChange then + begin + FOldFontChange := Canvas.Font.OnChange; + Canvas.Font.OnChange := FontChanged; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.RemoveFromSelection(Node: PVirtualNode); + +var + Index: Integer; + +begin + if not FSelectionLocked then + begin + Assert(Assigned(Node), 'Node must not be nil!'); + Assert(GetCurrentThreadId = MainThreadId, Self.Classname + '.RemoveFromSelection() must only be called from UI thread.'); + if vsSelected in Node.States then + begin + Assert(FSelectionCount > 0, 'if one node has set the vsSelected flag, SelectionCount must be >0.'); + //sync path note: deselect when a ctrl click removes a selection + Exclude(Node.States, vsSelected); + if SyncCheckstateWithSelection[Node] then + Node.CheckState := csUncheckedNormal; // Avoid using SetCheckState() as it handles toSyncCheckboxesWithSelection as well. + + if FindNodeInSelection(Node, Index, -1, -1) and (Index < FSelectionCount - 1) then + System.Move(FSelection[Index + 1], FSelection[Index], (FSelectionCount - Index - 1) * SizeOf(Pointer)); + if FSelectionCount > 0 then + System.Dec(FSelectionCount); + SetLength(FSelection, FSelectionCount); + + if FSelectionCount = 0 then + ResetRangeAnchor; + + if FSelectionCount <= 1 then + UpdateNextNodeToSelect(Node); + + DoRemoveFromSelection(Node); + InvalidateNode(Node); + Change(Node); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateNextNodeToSelect(Node: PVirtualNode); + +// save a potential node to select after the currently selected node will be deleted. +// This will make the VT to behave more like the Win32 TreeView, which always selecta a new node if the currently +// selected one gets deleted. + +begin + if ([toAlwaysSelectNode, toSelectNextNodeOnRemoval] * TreeOptions.SelectionOptions) = [] then + Exit; + if GetNextSibling(Node) <> nil then + FNextNodeToSelect := GetNextSibling(Node) + else if GetPreviousSibling(Node) <> nil then + FNextNodeToSelect := GetPreviousSibling(Node) + else if Node.Parent <> FRoot then + FNextNodeToSelect := Node.Parent + else + FNextNodeToSelect := nil; +end;//if Assigned(Node); + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ResetRangeAnchor; + +// Called when there is no selected node anymore and the selection range anchor needs a new value. + +begin + FRangeAnchor := FFocusedNode; + FLastSelectionLevel := -1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.RestoreFontChangeEvent(Canvas: TCanvas); + +begin + Canvas.Font.OnChange := FOldFontChange; + FOldFontChange := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SelectNodes(StartNode, EndNode: PVirtualNode; AddOnly: Boolean); + +// Selects a range of nodes and unselects all other eventually selected nodes which are not in this range if +// AddOnly is False. +// EndNode must be visible while StartNode does not necessarily as in the case where the last focused node is the start +// node but it is a child of a node which has been collapsed previously. In this case the first visible parent node +// is used as start node. StartNode can be nil in which case the very first node in the tree is used. + +var + NodeFrom, + NodeTo, + LastAnchor: PVirtualNode; + Index: Integer; + +begin + Assert(Assigned(EndNode), 'EndNode must not be nil!'); + if not FSelectionLocked then + begin + ClearTempCache; + if StartNode = nil then + StartNode := GetFirstVisibleNoInit(nil, True) + else + if not FullyVisible[StartNode] then + begin + StartNode := GetPreviousVisible(StartNode, True); + if StartNode = nil then + StartNode := GetFirstVisibleNoInit(nil, True); + end; + + if CompareNodePositions(StartNode, EndNode, True) < 0 then + begin + NodeFrom := StartNode; + NodeTo := EndNode; + end + else + begin + NodeFrom := EndNode; + NodeTo := StartNode; + end; + + // The range anchor will be reset by the following call. + LastAnchor := FRangeAnchor; + if not AddOnly then + InternalClearSelection; + + while NodeFrom <> NodeTo do + begin + InternalCacheNode(NodeFrom); + NodeFrom := GetNextVisible(NodeFrom, True); + end; + // select last node too + InternalCacheNode(NodeFrom); + // now add them all in "one" step + AddToSelection(FTempNodeCache, FTempNodeCount); + ClearTempCache; + if Assigned(LastAnchor) and FindNodeInSelection(LastAnchor, Index, -1, -1) then + FRangeAnchor := LastAnchor; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SetFocusedNodeAndColumn(Node: PVirtualNode; Column: TColumnIndex); + +var + OldColumn: TColumnIndex; + WasDifferent: Boolean; + +begin + if not FHeader.AllowFocus(Column) then + Column := FFocusedColumn; + + WasDifferent := (Node <> FFocusedNode) or (Column <> FFocusedColumn); + + OldColumn := FFocusedColumn; + FFocusedColumn := Column; + + DoFocusNode(Node, True); + + // Check if the change was accepted. + if FFocusedNode = Node then + begin + CancelEditNode; + if WasDifferent then + DoFocusChange(FFocusedNode, FFocusedColumn); + end + else + // If the user did not accept the new cell to focus then set also the focused column back + // to its original state. + FFocusedColumn := OldColumn; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SkipNode(Stream: TStream); + +// Skips the data for the next node in the given stream (including the child nodes). + +var + Header: TChunkHeader; + +begin + with Stream do + begin + // read achor chunk of the node + Stream.Read(Header, SizeOf(Header)); + if Header.ChunkType = NodeChunk then + Stream.Position := Stream.Position + Header.ChunkSize + else + RaiseVTError(SCorruptStream1, hcTFCorruptStream1); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +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 CreatePanningWindow(const ImageName: TPanningCursor; const Pos: TPoint): TForm; + var + Form: TForm; + Image: TImage; + PanningImage: TIcon; + begin + 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; + + 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; + 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 + ImageName: TPanningCursor; + Pt: TPoint; + +begin + StopTimer(ScrollTimer); + DoStateChange([tsPanning]); + + // Determine correct cursor + if FRangeX > ClientWidth then + begin + if FRangeY > ClientHeight then + ImageName := TPanningCursor.MOVEALL + else + ImageName := TPanningCursor.MOVEEW; + end + else + ImageName := TPanningCursor.MOVENS; + + // 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(); + SetCapture(Handle); + SetTimer(Handle, ScrollTimer, 20, nil); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.StopWheelPanning; + +// Stops panning if currently active and destroys the helper window. + +begin + if tsPanning in FStates then + begin + // Release the mouse capture and stop the panscroll timer. + StopTimer(ScrollTimer); + ReleaseCapture; + DoStateChange([], [tsPanning]); + + // Destroy the helper window. + if Assigned(FPanningWindow) then + FPanningWindow.Release; + DeleteObject(FPanningCursor); + FPanningCursor := 0; + Winapi.Windows.SetCursor(Screen.Cursors[Cursor]); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.StructureChange(Node: PVirtualNode; Reason: TChangeReason); + +begin + AdviseChangeEvent(True, Node, Reason); + + if FUpdateCount = 0 then + begin + if (FChangeDelay > 0) and HandleAllocated and not (tsSynchMode in FStates) then + SetTimer(Handle, StructureChangeTimer, FChangeDelay, nil) + else + DoStructureChange(Node, Reason); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.StyleServices(AControl: TControl): TCustomStyleServices; +begin + if AControl = nil then + AControl := Self; + Result := VTStyleServices(AControl); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.SuggestDropEffect(Source: TObject; Shift: TShiftState; Pt: TPoint; + AllowedEffects: Integer): Integer; + +// determines the drop action to take if the drag'n drop operation ends on this tree +// Note: Source can be any Delphi object not just a virtual tree + +begin + Result := AllowedEffects; + + // prefer MOVE if source and target are the same control, otherwise whatever is allowed as initial value + if Assigned(Source) and (Source = Self) then + if (AllowedEffects and DROPEFFECT_MOVE) <> 0 then + Result := DROPEFFECT_MOVE + else // no change + else + // drag between different applicatons + if (AllowedEffects and DROPEFFECT_COPY) <> 0 then + Result := DROPEFFECT_COPY; + + // consider modifier keys and what is allowed at the moment, if none of the following conditions apply then + // the initial value just set is used + if ssCtrl in Shift then + begin + // copy or link + if ssShift in Shift then + begin + // link + if (AllowedEffects and DROPEFFECT_LINK) <> 0 then + Result := DROPEFFECT_LINK; + end + else + begin + // copy + if (AllowedEffects and DROPEFFECT_COPY) <> 0 then + Result := DROPEFFECT_COPY; + end; + end + else + begin + // move, link or default + if ssShift in Shift then + begin + // move + if (AllowedEffects and DROPEFFECT_MOVE) <> 0 then + Result := DROPEFFECT_MOVE; + end + else + begin + // link or default + if ssAlt in Shift then + begin + // link + if (AllowedEffects and DROPEFFECT_LINK) <> 0 then + Result := DROPEFFECT_LINK; + end; + // else default + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ToggleSelection(StartNode, EndNode: PVirtualNode); + +// Switchs the selection state of a range of nodes. +// Note: This method is specifically designed to help selecting ranges with the keyboard and considers therefore +// the range anchor. + +var + NodeFrom, + NodeTo: PVirtualNode; + NewSize: Integer; + Position: Integer; + +begin + if not FSelectionLocked then + begin + Assert(Assigned(EndNode), 'EndNode must not be nil!'); + if StartNode = nil then + StartNode := FRoot.FirstChild + else + if not FullyVisible[StartNode] then + StartNode := GetPreviousVisible(StartNode, True); + + Position := CompareNodePositions(StartNode, EndNode); + // nothing to do if start and end node are the same + if Position <> 0 then + begin + if Position < 0 then + begin + NodeFrom := StartNode; + NodeTo := EndNode; + end + else + begin + NodeFrom := EndNode; + NodeTo := StartNode; + end; + + ClearTempCache; + + // 1) toggle the start node if it is before the range anchor + if CompareNodePositions(NodeFrom, FRangeAnchor) < 0 then + if not (vsSelected in NodeFrom.States) then + InternalCacheNode(NodeFrom) + else + InternalRemoveFromSelection(NodeFrom); + + // 2) toggle all nodes within the range + NodeFrom := GetNextVisible(NodeFrom, True); + while NodeFrom <> NodeTo do + begin + if not (vsSelected in NodeFrom.States) then + InternalCacheNode(NodeFrom) + else + InternalRemoveFromSelection(NodeFrom); + NodeFrom := GetNextVisible(NodeFrom, True); + end; + + // 3) toggle end node if it is after the range anchor + if CompareNodePositions(NodeFrom, FRangeAnchor) > 0 then + if not (vsSelected in NodeFrom.States) then + InternalCacheNode(NodeFrom) + else + InternalRemoveFromSelection(NodeFrom); + + // Do some housekeeping if there was a change. + NewSize := PackArray(FSelection, FSelectionCount); + if NewSize > -1 then + begin + FSelectionCount := NewSize; + SetLength(FSelection, FSelectionCount); + end; + // If the range went over the anchor then we need to reselect it. + if not (vsSelected in FRangeAnchor.States) then + InternalCacheNode(FRangeAnchor); + if FTempNodeCount > 0 then + AddToSelection(FTempNodeCache, FTempNodeCount); + ClearTempCache; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.TrySetFocus(); +begin + if Visible and CanFocus then + begin + try + Self.SetFocus(); + except + on EInvalidOperation do + Exit; + end; + end;//if +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UnselectNodes(StartNode, EndNode: PVirtualNode); + +// Deselects a range of nodes. +// EndNode must be visible while StartNode must not as in the case where the last focused node is the start node +// but it is a child of a node which has been collapsed previously. In this case the first visible parent node +// is used as start node. StartNode can be nil in which case the very first node in the tree is used. + +var + NodeFrom, + NodeTo: PVirtualNode; + NewSize: Integer; + +begin + if not FSelectionLocked then + begin + Assert(Assigned(EndNode), 'EndNode must not be nil!'); + + if StartNode = nil then + StartNode := FRoot.FirstChild + else + if not FullyVisible[StartNode] then + begin + StartNode := GetPreviousVisible(StartNode, True); + if StartNode = nil then + StartNode := FRoot.FirstChild; + end; + + if CompareNodePositions(StartNode, EndNode) < 0 then + begin + NodeFrom := StartNode; + NodeTo := EndNode; + end + else + begin + NodeFrom := EndNode; + NodeTo := StartNode; + end; + + while NodeFrom <> NodeTo do + begin + InternalRemoveFromSelection(NodeFrom); + NodeFrom := GetNextVisible(NodeFrom, True); + end; + // Deselect last node too. + InternalRemoveFromSelection(NodeFrom); + + // Do some housekeeping. + NewSize := PackArray(FSelection, FSelectionCount); + if NewSize > -1 then + begin + FSelectionCount := NewSize; + SetLength(FSelection, FSelectionCount); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.InternalAddToCellSelection(const Cell: TVTCell; ForceInsert: Boolean): Boolean; +var + i: Integer; +begin + Result := False; + + // prevent duplicates + for i := 0 to FSelectedCellCount - 1 do + if (FSelectedCells[i].Node = Cell.Node) and (FSelectedCells[i].Column = Cell.Column) then + Exit; + + if FSelectedCellCount = Length(FSelectedCells) then + SetLength(FSelectedCells, FSelectedCellCount + 16); + + Header.Columns[Cell.Column].Options := Header.Columns[Cell.Column].Options + + [coMulticellSelected]; + + FSelectedCells[FSelectedCellCount] := Cell; + Inc(FSelectedCellCount); + Result := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalRemoveFromCellSelection(const Cell: TVTCell); +var + i, j: Integer; +begin + for i := 0 to FSelectedCellCount - 1 do + if (FSelectedCells[i].Node = Cell.Node) and (FSelectedCells[i].Column = Cell.Column) then + begin + Header.Columns[Cell.Column].Options := + Header.Columns[Cell.Column].Options - [coMulticellSelected]; + // shift remaining + for j := i to FSelectedCellCount - 2 do + FSelectedCells[j] := FSelectedCells[j + 1]; + Dec(FSelectedCellCount); + Exit; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalClearCellSelection; +var + i: Integer; + LColumnIndex: TColumnIndex; +begin + // Invalidate all previously selected cells so their selection highlight is erased + for i := 0 to FSelectedCellCount - 1 do + begin + LColumnIndex := FSelectedCells[i].Column; + FHeader.Columns[LColumnIndex].Options := + FHeader.Columns[LColumnIndex].Options - [coMulticellSelected]; + + if Assigned(FSelectedCells[i].Node) then + InvalidateNode(FSelectedCells[i].Node) + else + InvalidateColumn(FSelectedCells[i].Column); + end; + SetLength(FSelectedCells, 0); + FSelectedCellCount := 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsCellSelectionEnabled: Boolean; +begin + Result := (toMultiSelect in FOptions.SelectionOptions) and + (toMultiCellSelect in FOptions.SelectionOptions) and + (toExtendedFocus in FOptions.SelectionOptions) and + not (toFullRowSelect in FOptions.SelectionOptions); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AddToCellSelection(const Cell: TVTCell; ForceInsert: Boolean); +begin + if FSelectionLocked or not IsCellSelectionEnabled then + Exit; + if InternalAddToCellSelection(Cell, ForceInsert) then + begin + if Assigned(Cell.Node) then + InvalidateNode(Cell.Node) + else + InvalidateColumn(Cell.Column); + ChangeCell(FSelectedCells); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.RemoveFromCellSelection(const Cell: TVTCell); +begin + if FSelectionLocked or not IsCellSelectionEnabled then + Exit; + InternalRemoveFromCellSelection(Cell); + if Assigned(Cell.Node) then + InvalidateNode(Cell.Node) + else + InvalidateColumn(Cell.Column); + ChangeCell(FSelectedCells); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.InternalIsCellSelected(Node: PVirtualNode; Column: TColumnIndex): Boolean; +var + i: Integer; +begin + for i := 0 to FSelectedCellCount - 1 do + if (FSelectedCells[i].Node = Node) and (FSelectedCells[i].Column = Column) then + Exit(True); + Result := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.InternalIsCellSelected(const Cell: TVTCell): Boolean; +begin + Result := InternalIsCellSelected(Cell.Node, Cell.Column); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalSelectCells(StartCell, EndCell: TVTCell; AddOnly: Boolean); +type + TNextColFunc = function (Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex of object; +var + NodeFrom, NodeTo, NodeIter: PVirtualNode; + ColFrom, ColTo, ColIter: TColumnIndex; + ColNext: TColumnIndex; + TempCell: TVTCell; + NextColFunc: TNextColFunc; +begin + // Normalize start cell + if StartCell.Node = nil then + StartCell.Node := FRoot.FirstChild; + + // Normalize end cell + Assert(Assigned(EndCell.Node), 'EndCell.Node must not be nil!'); + + // Determine node order + if CompareNodePositions(StartCell.Node, EndCell.Node) < 0 then + begin + NodeFrom := StartCell.Node; + NodeTo := EndCell.Node; + end + else + begin + NodeFrom := EndCell.Node; + NodeTo := StartCell.Node; + end; + + // Determine column order + ColFrom := StartCell.Column; + ColTo := EndCell.Column; + if ColFrom = NoColumn then ColFrom := FHeader.MainColumn; + if ColTo = NoColumn then ColTo := FHeader.MainColumn; + + if not AddOnly then + InternalClearCellSelection; + + if ColFrom <= ColTo then + NextColFunc := FHeader.Columns.GetNextVisibleColumn else + NextColFunc := FHeader.Columns.GetPreviousVisibleColumn; + + NodeIter := NodeFrom; + while NodeIter <> NodeTo do + begin + // iterate columns between ColFrom and ColTo (inclusive) + ColIter := ColFrom; + repeat + TempCell.Node := NodeIter; TempCell.Column := ColIter; + AddToCellSelection(TempCell, True); + ColNext := NextColFunc(ColIter); + if ColIter = ColTo then + Break; + ColIter := ColNext; + until ColIter = InvalidColumn; + NodeIter := GetNextVisible(NodeIter, True); + end; + // include last node + if Assigned(NodeTo) then + begin + ColIter := ColFrom; + repeat + TempCell.Node := NodeTo; TempCell.Column := ColIter; + AddToCellSelection(TempCell, True); + ColNext := NextColFunc(ColIter); + if ColIter = ColTo then + Break; + ColIter := ColNext; + until ColIter = InvalidColumn; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InternalUnselectCells(StartCell, EndCell: TVTCell); +var + NodeFrom, NodeTo, NodeIter: PVirtualNode; + ColFrom, ColTo, ColIter: TColumnIndex; + ColNext: TColumnIndex; + TempCell: TVTCell; +begin + if StartCell.Node = nil then + StartCell.Node := FRoot.FirstChild; + + Assert(Assigned(EndCell.Node), 'EndCell.Node must not be nil!'); + + if CompareNodePositions(StartCell.Node, EndCell.Node) < 0 then + begin + NodeFrom := StartCell.Node; + NodeTo := EndCell.Node; + end + else + begin + NodeFrom := EndCell.Node; + NodeTo := StartCell.Node; + end; + + ColFrom := StartCell.Column; + ColTo := EndCell.Column; + if ColFrom = NoColumn then ColFrom := FHeader.MainColumn; + if ColTo = NoColumn then ColTo := FHeader.MainColumn; + + NodeIter := NodeFrom; + while NodeIter <> NodeTo do + begin + if ColFrom <= ColTo then + begin + ColIter := ColFrom; + repeat + begin + TempCell.Node := NodeIter; TempCell.Column := ColIter; + InternalRemoveFromCellSelection(TempCell); + end; + ColNext := FHeader.Columns.GetNextVisibleColumn(ColIter); + if ColIter = ColTo then + Break; + ColIter := ColNext; + until ColIter = InvalidColumn; + end + else + begin + ColIter := ColFrom; + repeat + begin + TempCell.Node := NodeIter; TempCell.Column := ColIter; + InternalRemoveFromCellSelection(TempCell); + end; + ColNext := FHeader.Columns.GetPreviousVisibleColumn(ColIter); + if ColIter = ColTo then + Break; + ColIter := ColNext; + until ColIter = InvalidColumn; + end; + NodeIter := GetNextVisible(NodeIter, True); + end; + // last node + if Assigned(NodeTo) then + begin + if ColFrom <= ColTo then + begin + ColIter := ColFrom; + repeat + begin + TempCell.Node := NodeTo; TempCell.Column := ColIter; + InternalRemoveFromCellSelection(TempCell); + end; + ColNext := FHeader.Columns.GetNextVisibleColumn(ColIter); + if ColIter = ColTo then + Break; + ColIter := ColNext; + until ColIter = InvalidColumn; + end + else + begin + ColIter := ColFrom; + repeat + begin + TempCell.Node := NodeTo; TempCell.Column := ColIter; + InternalRemoveFromCellSelection(TempCell); + end; + ColNext := FHeader.Columns.GetPreviousVisibleColumn(ColIter); + if ColIter = ColTo then + Break; + ColIter := ColNext; + until ColIter = InvalidColumn; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ToggleCellSelection(StartCell, EndCell: TVTCell); +var + NodeFrom, NodeTo, NodeIter: PVirtualNode; + ColFrom, ColTo, ColIter: TColumnIndex; + ColNext: TColumnIndex; + TempCell: TVTCell; + Found: Boolean; + i: Integer; +begin + if FSelectionLocked or not IsCellSelectionEnabled then + Exit; + + if StartCell.Node = nil then + StartCell.Node := FRoot.FirstChild; + + Assert(Assigned(EndCell.Node), 'EndCell.Node must not be nil!'); + + if CompareNodePositions(StartCell.Node, EndCell.Node) < 0 then + begin + NodeFrom := StartCell.Node; + NodeTo := EndCell.Node; + end + else + begin + NodeFrom := EndCell.Node; + NodeTo := StartCell.Node; + end; + + ColFrom := StartCell.Column; + ColTo := EndCell.Column; + if ColFrom = NoColumn then ColFrom := FHeader.MainColumn; + if ColTo = NoColumn then ColTo := FHeader.MainColumn; + + NodeIter := NodeFrom; + while NodeIter <> NodeTo do + begin + if ColFrom <= ColTo then + begin + ColIter := ColFrom; + repeat + TempCell.Node := NodeIter; TempCell.Column := ColIter; + Found := False; + for i := 0 to FSelectedCellCount - 1 do + if (FSelectedCells[i].Node = TempCell.Node) and (FSelectedCells[i].Column = TempCell.Column) then + begin + InternalRemoveFromCellSelection(TempCell); + Found := True; + Break; + end; + if not Found then + InternalAddToCellSelection(TempCell, True); + ColNext := FHeader.Columns.GetNextVisibleColumn(ColIter); + if ColIter = ColTo then + Break; + ColIter := ColNext; + until ColIter = InvalidColumn; + end + else + begin + ColIter := ColFrom; + repeat + TempCell.Node := NodeIter; TempCell.Column := ColIter; + Found := False; + for i := 0 to FSelectedCellCount - 1 do + if (FSelectedCells[i].Node = TempCell.Node) and (FSelectedCells[i].Column = TempCell.Column) then + begin + InternalRemoveFromCellSelection(TempCell); + Found := True; + Break; + end; + if not Found then + InternalAddToCellSelection(TempCell, True); + ColNext := FHeader.Columns.GetPreviousVisibleColumn(ColIter); + if ColIter = ColTo then + Break; + ColIter := ColNext; + until ColIter = InvalidColumn; + end; + NodeIter := GetNextVisible(NodeIter, True); + end; + // last node + if Assigned(NodeTo) then + begin + if ColFrom <= ColTo then + begin + ColIter := ColFrom; + repeat + TempCell.Node := NodeTo; TempCell.Column := ColIter; + Found := False; + for i := 0 to FSelectedCellCount - 1 do + if (FSelectedCells[i].Node = TempCell.Node) and (FSelectedCells[i].Column = TempCell.Column) then + begin + InternalRemoveFromCellSelection(TempCell); + Found := True; + Break; + end; + if not Found then + InternalAddToCellSelection(TempCell, True); + ColNext := FHeader.Columns.GetNextVisibleColumn(ColIter); + if ColIter = ColTo then + Break; + ColIter := ColNext; + until ColIter = InvalidColumn; + end + else + begin + ColIter := ColFrom; + repeat + TempCell.Node := NodeTo; TempCell.Column := ColIter; + Found := False; + for i := 0 to FSelectedCellCount - 1 do + if (FSelectedCells[i].Node = TempCell.Node) and (FSelectedCells[i].Column = TempCell.Column) then + begin + InternalRemoveFromCellSelection(TempCell); + Found := True; + Break; + end; + if not Found then + InternalAddToCellSelection(TempCell, True); + ColNext := FHeader.Columns.GetPreviousVisibleColumn(ColIter); + if ColIter = ColTo then + Break; + ColIter := ColNext; + until ColIter = InvalidColumn; + end; + end; + + DoChangeCell(FSelectedCells); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateColumnCheckState(Col: TVirtualTreeColumn); +var + NewCheckState: TCheckState; +begin + NewCheckState := DetermineNextCheckState(Col.CheckType, Col.CheckState); + if (Col.CheckState <> NewCheckState) and DoColumnChecking(Col.Index, NewCheckState) then + begin + Col.CheckState := NewCheckState; + DoColumnChecked(Col.Index); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateDesigner; + +var + ParentForm: TCustomForm; + +begin + if (csDesigning in ComponentState) and not (csUpdating in ComponentState) then + begin + ParentForm := GetParentForm(Self); + if Assigned(ParentForm) and Assigned(ParentForm.Designer) then + ParentForm.Designer.Modified; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateHeaderRect(); + +// Calculates the rectangle the header occupies in non-client area. +// These coordinates are in window rectangle. + +var + OffsetX, + OffsetY: TDimension; + EdgeSize: TDimension; + Size: TSize; + +begin + FHeaderRect := Rect(0, 0, Width, Height); + + // Consider borders... + if HandleAllocated then begin // Prevent preliminary creation of window handle, see issue #933 + Size := GetBorderDimensions(); + InflateRect(FHeaderRect, Size.cx, Size.cy); + end; + + // ... and bevels. + OffsetX := BorderWidth; + OffsetY := BorderWidth; + if BevelKind <> TBevelKind.bkNone then + begin + EdgeSize := 0; + if BevelInner <> TBevelCut.bvNone then + Inc(EdgeSize, BevelWidth); + if BevelOuter <> TBevelCut.bvNone then + Inc(EdgeSize, BevelWidth); + if TBevelEdge.beLeft in BevelEdges then + Inc(OffsetX, EdgeSize); + if TBevelEdge.beTop in BevelEdges then + Inc(OffsetY, EdgeSize); + end; + + InflateRect(FHeaderRect, -OffsetX, -OffsetY); + + if hoVisible in FHeader.Options then + begin + if FHeaderRect.Left <= FHeaderRect.Right then + FHeaderRect.Bottom := FHeaderRect.Top + FHeader.Height + else + FHeaderRect := Rect(0, 0, 0, 0); + end + else + FHeaderRect.Bottom := FHeaderRect.Top; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateEditBounds; + +// Used to update the bounds of the current node editor if editing is currently active. + +var + R: TRect; + CurrentAlignment: TAlignment; + CurrentBidiMode: TBidiMode; + offsets : TVTOffsets; + offset : TDimension; + +begin + if (tsEditing in FStates) and Assigned(FFocusedNode) and + (FEditColumn < FHeader.Columns.Count) then // prevent EArgumentOutOfRangeException + begin + if (GetCurrentThreadId <> MainThreadID) then + begin + // UpdateEditBounds() will be called at the end of the thread + Exit; + end; + if vsMultiline in FFocusedNode.States then + R := GetDisplayRect(FFocusedNode, FEditColumn, True, False) + else if not (toGridExtensions in FOptions.MiscOptions) then + R := GetDisplayRect(FFocusedNode, FEditColumn, True, True); + + if (toGridExtensions in FOptions.MiscOptions) then + begin + // Use the whole cell when grid extensions are on. + R := GetDisplayRect(FFocusedNode, FEditColumn, False, False); + if FEditColumn = FHeader.MainColumn then + begin + // Calculate an offset for the main column. + GetOffsets(FFocusedNode, offsets, ofsLabel, FEditColumn); + offset := offsets[ofsLabel]; +// if offsets[ofsToggleButton] < 0 then +// Inc(offset, offsets[ofsToggleButton]); + end + else + offset := 0; + + // Adjust edit bounds depending on alignment and bidi mode. + if FEditColumn <= NoColumn then + begin + CurrentAlignment := Alignment; + CurrentBidiMode := BiDiMode; + end + else + begin + CurrentAlignment := FHeader.Columns[FEditColumn].Alignment; + CurrentBidiMode := FHeader.Columns[FEditColumn].BiDiMode; + end; + // Consider bidi mode here. In RTL context does left alignment actually mean right alignment and vice versa. + if CurrentBidiMode <> bdLeftToRight then + ChangeBiDiModeAlignment(CurrentAlignment); + if CurrentAlignment = taLeftJustify then + begin + if CurrentBiDiMode = bdLeftToRight then + Inc(R.Left, offset) + else + Dec(R.Right, offset); + end + else + begin + if CurrentBiDiMode = bdLeftToRight then + Inc(R.Left, offset) + else + Dec(R.Right, offset); + end; + end; + if toShowHorzGridLines in TreeOptions.PaintOptions then + Dec(R.Bottom); + R.Bottom := R.Top + R.Bottom - R.Top; + FEditLink.SetBounds(R); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +const + ScrollMasks: array[Boolean] of Cardinal = (0, SIF_DISABLENOSCROLL); + +const // Region identifiers for GetRandomRgn + CLIPRGN = 1; + METARGN = 2; + APIRGN = 3; + SYSRGN = 4; + +function GetRandomRgn(DC: HDC; Rgn: HRGN; iNum: Integer): Integer; stdcall; external 'GDI32.DLL'; + +procedure TBaseVirtualTree.ValidateCache(); + +// Starts cache validation if not already done by adding this instance to the worker thread's waiter list +// (if not already there) and signalling the thread it can start validating. + +begin + // stop validation if it is currently validating this tree's cache. + InterruptValidation(); + + FStartIndex := 0; + if (tsValidationNeeded in FStates) and (FVisibleCount > CacheThreshold) then + begin + // Tell the thread this tree needs actually something to do. + TWorkerThread.AddTree(Self); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ValidateNodeDataSize(var Size: Integer); + +begin + Size := SizeOf(Pointer); + if Assigned(FOnGetNodeDataSize) then + FOnGetNodeDataSize(Self, Size); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.VclStyleChanged(); + + // Updates the member FVclStyleEnabled, should be called initially and when the VCL style changes + +begin + FVclStyleEnabled := StyleServices.Enabled and not StyleServices.IsSystemStyle {$IF CompilerVersion < 35} and not (csDesigning in ComponentState) {$ifend}; + Header.StyleChanged(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +//PROFILE-NO +procedure TBaseVirtualTree.WndProc(var Message: TMessage); + +var + Handled: Boolean; + +begin + Handled := False; + + // Try the header whether it needs to take this message. + if Assigned(FHeader) and (FHeader.States <> []) then + Handled := TVTHeaderCracker(FHeader).HandleMessage(Message); + if not Handled then + begin + // For auto drag mode, let tree handle itself, instead of TControl. + if not (csDesigning in ComponentState) and + ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) then + begin + if (DragMode = dmAutomatic) and (DragKind = dkDrag) then + begin + if IsControlMouseMsg(TWMMouse(Message)) then + Handled := True; + if not Handled then + begin + ControlState := ControlState + [csLButtonDown]; + Dispatch(Message); // overrides TControl's BeginDrag + Handled := True; + end; + end; + end; + + if not Handled and Assigned(FHeader) then + Handled := TVTHeaderCracker(FHeader).HandleMessage(Message); + + if not Handled then + begin + if (Message.Msg in [WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN, WM_NCMBUTTONDOWN]) and not Focused then + TrySetFocus; + inherited; + end; + end; +end; +//PROFILE-YES + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WriteChunks(Stream: TStream; Node: PVirtualNode); + +// Writes the core chunks for Node into the stream. +// Note: descendants can optionally override this method to add other node specific chunks. +// Keep in mind that this method is also called for the root node. Using this fact in descendants you can +// create a kind of "global" chunks not directly bound to a specific node. + +var + Header: TChunkHeader; + LastPosition, + ChunkSize: Integer; + Chunk: TBaseChunk; + Run: PVirtualNode; + +begin + with Stream do + begin + // 1. The base chunk... + LastPosition := Position; + Chunk.Header.ChunkType := BaseChunk; + with Node^, Chunk do + begin + Body.ChildCount := ChildCount; + Body.NodeHeight := NodeHeight; + // Some states are only temporary so take them out as they make no sense at the new location. + Body.States := States - [vsChecking, vsCutOrCopy, vsDeleting, vsOnFreeNodeCallRequired, vsHeightMeasured]; + Body.Align := Align; + Body.CheckState := GetCheckState(Node); + Body.CheckType := CheckType; + Body.Reserved := 0; + end; + // write the base chunk + Write(Chunk, SizeOf(Chunk)); + + // 2. ... directly followed by the child node chunks (actually they are child chunks of + // the base chunk) + if vsInitialized in Node.States then + begin + Run := Node.FirstChild; + while Assigned(Run) do + begin + WriteNode(Stream, Run); + Run := Run.NextSibling; + end; + end; + + FinishChunkHeader(Stream, LastPosition, Position); + + // 3. write user data + LastPosition := Position; + Header.ChunkType := UserChunk; + Write(Header, SizeOf(Header)); + DoSaveUserData(Node, Stream); + // check if the application actually wrote data + ChunkSize := Position - LastPosition - SizeOf(TChunkHeader); + // seek back to start of chunk if nothing has been written + if ChunkSize = 0 then + begin + Position := LastPosition; + Size := Size - SizeOf(Header); + end + else + FinishChunkHeader(Stream, LastPosition, Position); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.WriteNode(Stream: TStream; Node: PVirtualNode); + +// Writes the "cover" chunk for Node to Stream and initiates writing child nodes and chunks. + +var + LastPosition: Integer; + Header: TChunkHeader; + +begin + // Initialize the node first if necessary and wanted. + if toInitOnSave in FOptions.MiscOptions then + begin + if not (vsInitialized in Node.States) then + InitNode(Node); + if (vsHasChildren in Node.States) and (Node.ChildCount = 0) then + InitChildren(Node); + end; + + with Stream do + begin + LastPosition := Position; + // Emit the anchor chunk. + Header.ChunkType := NodeChunk; + Write(Header, SizeOf(Header)); + // Write other chunks to stream taking their size into this chunk's size. + WriteChunks(Stream, Node); + + // Update chunk size. + FinishChunkHeader(Stream, LastPosition, Position); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.AbsoluteIndex(Node: PVirtualNode): Cardinal; + +begin + Result := 0; + while Assigned(Node) and (Node <> FRoot) do + begin + if not (vsInitialized in Node.States) then + InitNode(Node); + if Assigned(Node.PrevSibling) then + begin + // if there's a previous sibling then add its total count to the result + Node := Node.PrevSibling; + System.Inc(Result, Node.TotalCount); + end + else + begin + Node := Node.Parent; + if Node <> FRoot then + System.Inc(Result); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; + +// Adds a new node to the given parent node. This is simply done by increasing the child count of the +// parent node. If Parent is nil then the new node is added as (last) top level node. +// UserData can be used to set the first SizeOf(Pointer) bytes of the user data area to an initial value which can be used +// in OnInitNode and will also cause to trigger the OnFreeNode event (if <> nil) even if the node is not yet +// "officially" initialized. +// AddChild is a compatibility method and will implicitly validate the parent node. This is however +// against the virtual paradigm and hence I dissuade from its usage. + +begin + if not (toReadOnly in FOptions.MiscOptions) then + Result := InsertNode(Parent, TVTNodeAttachMode.amAddChildLast, UserData) + else + Result := nil; +end; + +function TBaseVirtualTree.AddChild(Parent: PVirtualNode; const UserData: IInterface): PVirtualNode; +begin + UserData._AddRef(); + Result := AddChild(Parent, Pointer(UserData)); + Include(Result.States, vsReleaseCallOnUserDataRequired); +end; + +function TBaseVirtualTree.AddChild(Parent: PVirtualNode; const UserData: TObject): PVirtualNode; +begin + Result := AddChild(Parent, Pointer(UserData)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AddFromStream(Stream: TStream; TargetNode: PVirtualNode); + +// loads nodes from the given stream and adds them to TargetNode +// the current content is not cleared before the load process starts (see also LoadFromStream) + +var + ThisID: TMagicID; + Version, + Count: Cardinal; + Node: PVirtualNode; + +begin + if not (toReadOnly in FOptions.MiscOptions) then + begin + // check first whether this is a stream we can read + Stream.ReadBuffer(ThisID, SizeOf(TMagicID)); + if (ThisID[0] = MagicID[0]) and + (ThisID[1] = MagicID[1]) and + (ThisID[2] = MagicID[2]) and + (ThisID[5] = MagicID[5]) then + begin + Version := Word(ThisID[3]); + if Version <= VTTreeStreamVersion then + begin + BeginUpdate; + try + if Version < 2 then + Count := MaxInt + else + Stream.ReadBuffer(Count, SizeOf(Count)); + + while (Stream.Position < Stream.Size) and (Count > 0) do + begin + System.Dec(Count); + Node := MakeNewNode; + InternalConnectNode(Node, TargetNode, Self, amAddChildLast); + InternalAddFromStream(Stream, Version, Node); + end; + if TargetNode = FRoot then + DoNodeCopied(nil) + else + DoNodeCopied(TargetNode); + finally + EndUpdate; + end; + end + else + RaiseVTError(SWrongStreamVersion, hcTFWrongStreamVersion); + end + else + RaiseVTError(SWrongStreamVersion, hcTFWrongStreamVersion); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AfterConstruction; + +begin + inherited; + + if FRoot = nil then + InitRootNode; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.Assign(Source: TPersistent); + +begin + if (Source is TBaseVirtualTree) and not (toReadOnly in FOptions.MiscOptions) then + with Source as TBaseVirtualTree do + begin + Self.Align := Align; + Self.Anchors := Anchors; + Self.AutoScrollDelay := AutoScrollDelay; + Self.AutoScrollInterval := AutoScrollInterval; + Self.AutoSize := AutoSize; + Self.Background := Background; + Self.BevelEdges := BevelEdges; + Self.BevelInner := BevelInner; + Self.BevelKind := BevelKind; + Self.BevelOuter := BevelOuter; + Self.BevelWidth := BevelWidth; + Self.BiDiMode := BiDiMode; + Self.BorderStyle := BorderStyle; + Self.BorderWidth := BorderWidth; + Self.ChangeDelay := ChangeDelay; + Self.CheckImageKind := CheckImageKind; + Self.Color := Color; + Self.Colors.Assign(Colors); + Self.Constraints.Assign(Constraints); + Self.Ctl3D := Ctl3D; + Self.DefaultNodeHeight := DefaultNodeHeight; + Self.DefaultPasteMode := DefaultPasteMode; + Self.DragCursor := DragCursor; + Self.DragImageKind := DragImageKind; + Self.DragKind := DragKind; + Self.DragMode := DragMode; + Self.Enabled := Enabled; + Self.Font := Font; + Self.Header := Header; + Self.HintMode := HintMode; + Self.HotCursor := HotCursor; + Self.Images := Images; + Self.ImeMode := ImeMode; + Self.ImeName := ImeName; + Self.Indent := Indent; + Self.Margin := Margin; + Self.NodeAlignment := NodeAlignment; + Self.NodeDataSize := NodeDataSize; + Self.TreeOptions := TreeOptions; + Self.ParentBiDiMode := ParentBiDiMode; + Self.ParentColor := ParentColor; + Self.ParentCtl3D := ParentCtl3D; + Self.ParentFont := ParentFont; + Self.ParentShowHint := ParentShowHint; + Self.PopupMenu := PopupMenu; + Self.RootNodeCount := RootNodeCount; + Self.ScrollBarOptions := ScrollBarOptions; + Self.ShowHint := ShowHint; + Self.StateImages := StateImages; + Self.StyleElements := StyleElements; + Self.TabOrder := TabOrder; + Self.TabStop := TabStop; + Self.Visible := Visible; + Self.SelectionCurveRadius := SelectionCurveRadius; + Self.SelectionBlendFactor := SelectionBlendFactor; + Self.EmptyListMessage := EmptyListMessage; + end + else + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.AutoScale(); + +// If toAutoChangeScale is set, this method ensures that the default node height is set correctly. + +var + lTextHeight: TDimension; +begin + if HandleAllocated and (toAutoChangeScale in TreeOptions.AutoOptions) then + 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 + ScaleNodeHeights(lTextHeight, DefaultNodeHeight); + Self.DefaultNodeHeight := lTextHeight; + end;// if + end;// if HandelAllocated +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.BeginDrag(Immediate: Boolean; Threshold: Integer); + +// Reintroduced method to allow to start OLE drag'n drop as well as VCL drag'n drop. + +begin + if FDragType = dtVCL then + begin + DoStateChange([tsVCLDragPending]); + inherited; + end + else + if (FStates * [tsOLEDragPending, tsOLEDragging]) = [] then + begin + // Drag start position has already been recorded in WMMouseDown. + if Threshold < 0 then + FDragThreshold := Mouse.DragThreshold + else + FDragThreshold := Threshold; + if Immediate then + DoDragging(FLastClickPos) + else + DoStateChange([tsOLEDragPending]); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.BeginSynch; + +// Starts the synchronous update mode (if not already active). + +begin + if not (csDestroying in ComponentState) then + begin + if FSynchUpdateCount = 0 then + begin + DoUpdating(usBeginSynch); + + // Stop all timers... + StopTimer(ChangeTimer); + StopTimer(StructureChangeTimer); + StopTimer(ExpandTimer); + StopTimer(EditTimer); + StopTimer(HeaderTimer); + StopTimer(ScrollTimer); + StopTimer(SearchTimer); + FSearchBuffer := ''; + FLastSearchNode := nil; + DoStateChange([], [tsEditPending, tsScrollPending, tsScrolling, tsIncrementalSearching]); + + // ...and trigger pending update states. + if tsStructureChangePending in FStates then + DoStructureChange(FLastStructureChangeNode, FLastStructureChangeReason); + if tsChangePending in FStates then + DoChange(FLastChangedNode); + end + else + DoUpdating(usSynch); + end; + System.Inc(FSynchUpdateCount); + DoStateChange([tsSynchMode]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.BeginUpdate; + +begin + Assert(GetCurrentThreadId = MainThreadId, 'UI controls like ' + Classname + ' should only be manipulated through the main thread.'); + if not (csDestroying in ComponentState) then + begin + if FUpdateCount = 0 then + begin + DoUpdating(usBegin); + SetUpdateState(True); + end + else + DoUpdating(usUpdate); + end; + System.Inc(FUpdateCount); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CancelCutOrCopy; + +// Resets nodes which are marked as being cut. + +var + Run: PVirtualNode; + +begin + if ([tsCutPending, tsCopyPending] * FStates) <> [] then + begin + Run := FRoot.FirstChild; + while Assigned(Run) do + begin + if vsCutOrCopy in Run.States then + Exclude(Run.States, vsCutOrCopy); + Run := GetNextNoInit(Run); + end; + end; + DoStateChange([], [tsCutPending, tsCopyPending]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CancelEditNode: Boolean; + +// Called by the application or the current edit link to cancel the edit action. + +begin + if HandleAllocated and ([tsEditing, tsEditPending] * FStates <> []) then + Result := DoCancelEdit + else + Result := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CancelOperation; + +// Called by the application to cancel a long-running operation. + +begin + if FOperationCount > 0 then + FOperationCanceled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CanEdit(Node: PVirtualNode; Column: TColumnIndex): Boolean; + +// Returns True if the given node can be edited. + +begin + Result := (toEditable in FOptions.MiscOptions) and Enabled and not (toReadOnly in FOptions.MiscOptions) + and ((Column < 0) or (coEditable in FHeader.Columns[Column].Options)); + DoCanEdit(Node, Column, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CanFocus: Boolean; + +var + Form: TCustomForm; + +begin + Result := inherited CanFocus; + + if Result and not (csDesigning in ComponentState) then + begin + Form := GetParentForm(Self); + Result := (Form = nil) or (Form.Enabled and Form.Visible); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.Clear; + +begin + if (not IsEmpty and not (toReadOnly in FOptions.MiscOptions)) or (csDestroying in ComponentState) then + begin + BeginUpdate; + try + InterruptValidation; + if IsEditing then + CancelEditNode; + + if ClipboardStates * FStates <> [] then + begin + OleSetClipboard(nil); + DoStateChange([], ClipboardStates); + end; + ClearSelection; + ClearCellSelection; + FFocusedNode := nil; + FLastSelected := nil; + FCurrentHotNode := nil; + FDropTargetNode := nil; + FLastChangedNode := nil; + FRangeAnchor := nil; + FLastVCLDragTarget := nil; + FLastSearchNode := nil; + DeleteChildren(FRoot, True); + FOffsetX := 0; + FOffsetY := 0; + + finally + EndUpdate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ClearChecked; + +var + Node: PVirtualNode; + +begin + Node := RootNode.FirstChild; + while Assigned(Node) do + begin + if Node.CheckState <> csUncheckedNormal then + CheckState[Node] := csUncheckedNormal; + Node := GetNextNoInit(Node); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ClearSelection(); +begin + ClearSelection(True); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ClearDragManager; +begin + Pointer(FDragManager) := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ClearSelection(pFireChangeEvent: Boolean); + +var + Node: PVirtualNode; + Dummy: TDimension; + R: TRect; + Counter: Integer; + +begin + Assert(GetCurrentThreadId = MainThreadId, Self.Classname + '.ClearSelection() must only be called from UI thread.'); + if not FSelectionLocked and (FSelectionCount > 0) and not (csDestroying in ComponentState) then + begin + if (FUpdateCount = 0) and HandleAllocated and (FVisibleCount > 0) then + begin + // Iterate through nodes currently visible in the client area and invalidate them. + Node := GetNodeAt(0, 0, True, Dummy); + if Assigned(Node) then + R := GetDisplayRect(Node, NoColumn, False); + Counter := FSelectionCount; + + while Assigned(Node) do + begin + R.Bottom := R.Top + NodeHeight[Node]; + if vsSelected in Node.States then + begin + InvalidateRect(@R, False); + System.Dec(Counter); + // Only try as many nodes as are selected. + if Counter = 0 then + Break; + end; + R.Top := R.Bottom; + if R.Top > ClientHeight then + Break; + Node := GetNextVisibleNoInit(Node, True); + end; + end; + + InternalClearSelection; + if pFireChangeEvent then + Change(nil); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CopyTo(Source: PVirtualNode; Tree: TBaseVirtualTree; Mode: TVTNodeAttachMode; + ChildrenOnly: Boolean): PVirtualNode; + +// A simplified CopyTo method to allow to copy nodes to the root of another tree. + +begin + Result := CopyTo(Source, Tree.FRoot, Mode, ChildrenOnly); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CopyTo(Source, Target: PVirtualNode; Mode: TVTNodeAttachMode; + ChildrenOnly: Boolean): PVirtualNode; + +// Copies Source and all its child nodes to Target. +// Mode is used to specify further where to add the new node actually (as sibling of Target or as child of Target). +// Result is the newly created node to which source has been copied if ChildrenOnly is False or just contains Target +// in the other case. +// ChildrenOnly determines whether to copy also the source node or only its child nodes. + +var + TargetTree: TBaseVirtualTree; + Stream: TMemoryStream; + +begin + Assert(TreeFromNode(Source) = Self, 'The source tree must contain the source node.'); + + Result := nil; + if (Mode <> amNoWhere) and Assigned(Source) and (Source <> FRoot) then + begin + // Assume that an empty destination means the root in this (the source) tree. + if Target = nil then + begin + TargetTree := Self; + Target := FRoot; + Mode := amAddChildFirst; + end + else + TargetTree := TreeFromNode(Target); + + if not (toReadOnly in TargetTree.TreeOptions.MiscOptions) then + begin + if Target = TargetTree.FRoot then + begin + case Mode of + amInsertBefore: + Mode := amAddChildFirst; + amInsertAfter: + Mode := amAddChildLast; + end; + end; + + Stream := TMemoryStream.Create; + try + // Write all nodes into a temprary stream depending on the ChildrenOnly flag. + if not ChildrenOnly then + WriteNode(Stream, Source) + else + begin + Source := Source.FirstChild; + while Assigned(Source) do + begin + WriteNode(Stream, Source); + Source := Source.NextSibling; + end; + end; + // Now load the serialized nodes into the target node (tree). + TargetTree.BeginUpdate; + try + Stream.Position := 0; + while Stream.Position < Stream.Size do + begin + Result := TargetTree.MakeNewNode; + InternalConnectNode(Result, Target, TargetTree, Mode); + TargetTree.InternalAddFromStream(Stream, VTTreeStreamVersion, Result); + if not DoNodeCopying(Result, Target) then + begin + TargetTree.DeleteNode(Result); + Result := nil; + end + else + DoNodeCopied(Result); + end; + if ChildrenOnly then + Result := Target; + finally + TargetTree.EndUpdate; + end; + finally + Stream.Free; + end; + + with TargetTree do + begin + InvalidateCache; + if FUpdateCount = 0 then + begin + ValidateCache; + UpdateScrollBars(True); + Invalidate; + end; + StructureChange(Source, crNodeCopied); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DeleteChildren(Node: PVirtualNode; ResetHasChildren: Boolean = False); + +// Removes all children and their children from memory without changing the vsHasChildren style by default. + +var + Run, + Mark: PVirtualNode; + LastTop, + LastLeft: TDimension; + NewSize: Integer; + ParentVisible: Boolean; + +begin + if Assigned(Node) and (Node.ChildCount > 0) and not (toReadOnly in FOptions.MiscOptions) then + begin + Assert(not (tsIterating in FStates), 'Deleting nodes during tree iteration leads to invalid pointers.'); + + // The code below uses some flags for speed improvements which may cause invalid pointers if updates of + // the tree happen. Hence switch updates off until we have finished the operation. + System.Inc(FUpdateCount); + try + InterruptValidation; + LastLeft := -FEffectiveOffsetX; + LastTop := FOffsetY; + + // Make a local copy of the visibility state of this node to speed up + // adjusting the visible nodes count. + ParentVisible := Node = FRoot; + if not ParentVisible then + ParentVisible := FullyVisible[Node] and (vsExpanded in Node.States); + + // Show that we are clearing the child list, to avoid registering structure change events. + Run := Node.LastChild; + while Assigned(Run) do + begin + if ParentVisible and IsEffectivelyVisible[Run] then + System.Dec(FVisibleCount); + + Include(Run.States, vsDeleting); + Mark := Run; + Run := Run.PrevSibling; + // Important, to avoid exchange of invalid pointers while disconnecting the node. + if Assigned(Run) then + Run.SetNextSibling(nil); + DeleteNode(Mark, False, True); + end; + if ResetHasChildren then + Exclude(Node.States, vsHasChildren); + if Node <> FRoot then + Exclude(Node.States, vsExpanded); + Node.SetChildCount(0); + if (Node = FRoot) or (vsDeleting in Node.States) then + begin + Node.TotalHeight := FDefaultNodeHeight + NodeHeight[Node]; + Node.TotalCount := 1; + end + else + begin + AdjustTotalHeight(Node, NodeHeight[Node]); + AdjustTotalCount(Node, 1); + end; + Node.SetFirstChild(nil); + Node.SetLastChild(nil); + finally + System.Dec(FUpdateCount); + end; + + InvalidateCache; + if FUpdateCount = 0 then + begin + NewSize := PackArray(FSelection, FSelectionCount); + if NewSize > -1 then + begin + FSelectionCount := NewSize; + SetLength(FSelection, FSelectionCount); + end; + + ValidateCache; + UpdateScrollBars(True); + // Invalidate entire tree if it scrolled e.g. to make the last node also the + // bottom node in the treeview. + if (LastLeft <> FOffsetX) or (LastTop <> FOffsetY) then + Invalidate + else + InvalidateToBottom(Node); + if tsChangePending in FStates then begin + DoChange(FLastChangedNode); + EnsureNodeSelected(True); + end; + end; + StructureChange(Node, crChildDeleted); + end + else if ResetHasChildren then + Exclude(Node.States, vsHasChildren); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DeleteNode(Node: PVirtualNode; Reindex: Boolean; ParentClearing: Boolean); + +var + LastTop, + LastLeft: TDimension; + LastParent: PVirtualNode; + WasInSynchMode: Boolean; + +begin + if Assigned(Node) and (Node <> FRoot) and not (toReadOnly in FOptions.MiscOptions) then + begin + Assert(not (tsIterating in FStates), 'Deleting nodes during tree iteration leads to invalid pointers.'); + + // Determine parent node for structure change notification. + LastParent := Node.Parent; + + if not ParentClearing then + begin + if LastParent = FRoot then + StructureChange(nil, crChildDeleted) + else + StructureChange(LastParent, crChildDeleted); + if Node = FNextNodeToSelect then + FNextNodeToSelect := nil; + end; + + LastLeft := -FEffectiveOffsetX; + LastTop := FOffsetY; + + if tsHint in FStates then + begin + Application.CancelHint; + DoStateChange([], [tsHint]); + end; + + if not ParentClearing then + InterruptValidation; + + DeleteChildren(Node); + + if vsSelected in Node.States then + begin + if FUpdateCount = 0 then + begin + // Go temporarily into sync mode to avoid a delayed change event for the node + // when unselecting. + WasInSynchMode := tsSynchMode in FStates; + Include(FStates, tsSynchMode); + RemoveFromSelection(Node); + //EnsureNodeSelected(); // also done in DoFreeNode() + if not WasInSynchMode then + Exclude(FStates, tsSynchMode); + InvalidateToBottom(LastParent); + end + else + InternalRemoveFromSelection(Node); + end + else + InvalidateToBottom(LastParent); + + InternalDisconnectNode(Node, False, Reindex); + DoFreeNode(Node); + + if not ParentClearing then + begin + if FUpdateCount = 0 then + DetermineHiddenChildrenFlag(LastParent) + else + Include(FStates, tsUpdateHiddenChildrenNeeded); + InvalidateCache; + if FUpdateCount = 0 then + begin + ValidateCache; + UpdateScrollBars(True); + // Invalidate entire tree if it scrolled e.g. to make the last node also the + // bottom node in the treeview. + if (LastLeft <> FOffsetX) or (LastTop <> FOffsetY) then + Invalidate; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DeleteNode(Node: PVirtualNode; pReIndex: Boolean = True); +begin + DeleteNode(Node, pReIndex, False); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DeleteNodes(const pNodes: TNodeArray); + + // Deletes all given nodes. + // Best performance is achieved if nodes are sorted by parent + +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 + begin + LevelChange := pNodes[I].Parent <> pNodes[I - 1].Parent; + DeleteNode(pNodes[I], LevelChange, False); + end; + DeleteNode(pNodes[0]); + finally + EndUpdate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DeleteSelectedNodes; + +// Deletes all currently selected nodes (including their child nodes). + +var + lNodes: TNodeArray; +begin + lNodes := nil; + if (FSelectionCount > 0) and not (toReadOnly in FOptions.MiscOptions) then + begin + lNodes := GetSortedSelection(True); + DeleteNodes(lNodes); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.Dragging: Boolean; + +begin + // Check for both OLE drag'n drop as well as VCL drag'n drop. + Result := ([tsOLEDragPending, tsOLEDragging] * FStates <> []) or inherited Dragging; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.EditNode(Node: PVirtualNode; Column: TColumnIndex): Boolean; + +// Application triggered edit event for the given node. +// Returns True if the tree started editing otherwise False. + +begin + Assert(Assigned(Node), 'Node must not be nil.'); + Assert((Column > InvalidColumn) and (Column < FHeader.Columns.Count), + 'Column must be a valid column index (-1 if no header is shown).'); + + Result := tsEditing in FStates; + // If the tree is already editing then we don't disrupt this. + if not Result and not (toReadOnly in FOptions.MiscOptions) then + begin + FocusedNode := Node; + if Assigned(FFocusedNode) and (Node = FFocusedNode) and CanEdit(FFocusedNode, Column) then + begin + FEditColumn := Column; + if not (vsInitialized in Node.States) then + InitNode(Node); + DoEdit; + Result := tsEditing in FStates; + end + else + Result := False; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.EndEditNode: Boolean; + +// Called to finish a current edit action or stop the edit timer if an edit operation is pending. +// Returns True if editing was successfully ended or the control was not in edit mode +// Returns False if the control could not leave the edit mode e.g. due to an invalid value that was entered. + +begin + if [tsEditing, tsEditPending] * FStates <> [] then + Result := DoEndEdit + else + Result := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.EndSynch; + +begin + if FSynchUpdateCount > 0 then + System.Dec(FSynchUpdateCount); + + if not (csDestroying in ComponentState) then + begin + if FSynchUpdateCount = 0 then + begin + DoStateChange([], [tsSynchMode]); + DoUpdating(usEndSynch); + end + else + DoUpdating(usSynch); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.EndUpdate; + +var + NewSize: Integer; + +begin + if FUpdateCount = 0 then + exit; + System.Dec(FUpdateCount); + + if not (csDestroying in ComponentState) then + begin + if (FUpdateCount = 0) then + begin + if tsUpdateHiddenChildrenNeeded in FStates then + begin + DetermineHiddenChildrenFlagAllNodes; + Exclude(FStates, tsUpdateHiddenChildrenNeeded); + end; + + NewSize := PackArray(FSelection, FSelectionCount); + if NewSize > -1 then + begin + FSelectionCount := NewSize; + SetLength(FSelection, FSelectionCount); + end; + + InvalidateCache; + ValidateCache; + if HandleAllocated then + UpdateScrollBars(False); + + if tsStructureChangePending in FStates then + DoStructureChange(FLastStructureChangeNode, FLastStructureChangeReason); + try + if tsChangePending in FStates then + DoChange(FLastChangedNode); + finally + if (toAutoSort in FOptions.AutoOptions) then + SortTree(FHeader.SortColumn, FHeader.SortDirection, True); + + SetUpdateState(False); + if HandleAllocated then + Invalidate; + UpdateDesigner; + end; + NotifyAccessibleEvent(); // See issue #1174 + + DoUpdating(usEnd); + EnsureNodeSelected(False); + end + else + DoUpdating(usUpdate); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ExecuteAction(Action: TBasicAction): Boolean; + +// Some support for standard actions. + +begin + Result := inherited ExecuteAction(Action); + + if not Result then + begin + Result := Action is TEditSelectAll; + if Result then + SelectAll(False) + else + begin + Result := Action is TEditCopy; + if Result then + CopyToClipboard + else + if not (toReadOnly in FOptions.MiscOptions) then + begin + Result := Action is TEditCut; + if Result then + CutToClipboard + else + begin + Result := Action is TEditPaste; + if Result then + PasteFromClipboard + else + begin + Result := Action is TEditDelete; + if Result then + DeleteSelectedNodes; + end; + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.FinishCutOrCopy; + +// Deletes nodes which are marked as being cutted. + +var + Run: PVirtualNode; + +begin + if tsCutPending in FStates then + begin + Run := FRoot.FirstChild; + while Assigned(Run) do + begin + if vsCutOrCopy in Run.States then + DeleteNode(Run); + Run := GetNextNoInit(Run); + end; + DoStateChange([], [tsCutPending]); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.FlushClipboard; + +// Used to render the data which is currently on the clipboard (finishes delayed rendering). + +begin + if ClipboardStates * FStates <> [] then + begin + DoStateChange([tsClipboardFlushing]); + OleFlushClipboard; + CancelCutOrCopy; + DoStateChange([], [tsClipboardFlushing]); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.FullCollapse(Node: PVirtualNode = nil); + +// This routine collapses all expanded nodes in the subtree given by Node or the whole tree if Node is FRoot or nil. +// Only nodes which are expanded will be collapsed. This excludes uninitialized nodes but nodes marked as visible +// will still be collapsed if they are expanded. + +var + Stop: PVirtualNode; + +begin + if FRoot.TotalCount > 1 then + begin + if Node = FRoot then + Node := nil; + + DoStateChange([tsCollapsing]); + BeginUpdate; + try + Stop := Node; + Node := GetLastVisibleNoInit(Node, True); + + if Assigned(Node) then + begin + repeat + if [vsHasChildren, vsExpanded] * Node.States = [vsHasChildren, vsExpanded] then + ToggleNode(Node); + Node := GetPreviousNoInit(Node, True); + until (Node = Stop) or not Assigned(Node); + + // Collapse the start node too. + if Assigned(Stop) and ([vsHasChildren, vsExpanded] * Stop.States = [vsHasChildren, vsExpanded]) then + ToggleNode(Stop); + end; + finally + EndUpdate; + DoStateChange([], [tsCollapsing]); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.FullExpand(Node: PVirtualNode = nil); + +// This routine expands all collapsed nodes in the subtree given by Node or the whole tree if Node is FRoot or nil. +// All nodes on the way down are initialized so this procedure might take a long time. +// Since all nodes are validated, the tree cannot make use of optimatizations. Hence it is counter productive and you +// should consider avoiding its use. + +var + Stop: PVirtualNode; + +begin + if FRoot.TotalCount > 1 then + begin + DoStateChange([tsExpanding]); + StartOperation(TVTOperationKind.okExpand); + BeginUpdate; + try + if Node = nil then + begin + Node := FRoot.FirstChild; + Stop := nil; + end + else + begin + Stop := Node.NextSibling; + if Stop = nil then + begin + Stop := Node; + repeat + Stop := Stop.Parent; + until (Stop = FRoot) or Assigned(Stop.NextSibling); + if Stop = FRoot then + Stop := nil + else + Stop := Stop.NextSibling; + end; + end; + + // Initialize the start node. Others will be initialized in GetNext. + if not (vsInitialized in Node.States) then + InitNode(Node); + + repeat + if not (vsExpanded in Node.States) then + ToggleNode(Node); + Node := GetNext(Node); + until (Node = Stop) or OperationCanceled; + finally + EndOperation(TVTOperationKind.okExpand); + EndUpdate; + DoStateChange([], [tsExpanding]); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetControlsAlignment: TAlignment; + +begin + Result := FAlignment; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetDisplayRect(Node: PVirtualNode; Column: TColumnIndex; TextOnly: Boolean; + Unclipped: Boolean = False; ApplyCellContentMargin: Boolean = False): TRect; + +// Determines the client coordinates the given node covers, depending on scrolling, expand state etc. +// If the given node cannot be found (because one of its parents is collapsed or it is invisible) then an empty +// rectangle is returned. +// If TextOnly is True then only the text bounds are returned, that is, the resulting rectangle's left and right border +// are updated according to bidi mode, alignment and text width of the node. +// If Unclipped is True (which only makes sense if also TextOnly is True) then the calculated text rectangle is +// not clipped if the text does not entirely fit into the text space. This is special handling needed for hints. +// If ApplyCellContentMargin is True (which only makes sense if also TextOnly is True) then the calculated text +// rectangle respects the cell content margin. +// If Column is -1 then the entire client width is used before determining the node's width otherwise the bounds of the +// particular column are used. +// Note: Column must be a valid column and is used independent of whether the header is visible or not. + +var + Temp: PVirtualNode; + LeftOffset: TDimension; + TopOffset: TNodeHeight; + CacheIsAvailable: Boolean; + TextWidth: TDimension; + CurrentBidiMode: TBidiMode; + CurrentAlignment: TAlignment; + MaxUnclippedHeight: TDimension; + TM: TTextMetric; + ExtraVerticalMargin: TDimension; + lOffsets: TVTOffsets; +begin + Assert(Assigned(Node), 'Node must not be nil.'); + Assert(Node <> FRoot, 'Node must not be the hidden root node.'); + + if not (vsInitialized in Node.States) then + InitNode(Node); + + Result := Rect(0, 0, 0, 0); + + // Check whether the node is visible (determine indentation level btw.). + if not IsEffectivelyVisible[Node] then + Exit; + + // Here we know the node is visible. + TopOffset := 0; + CacheIsAvailable := False; + if tsUseCache in FStates then + begin + // If we can use the position cache then do a binary search to find a cached node which is as close as possible + // to the current node. Iterate then through all following and visible nodes and sum up their heights. + Temp := FindInPositionCache(Node, TopOffset); + CacheIsAvailable := Assigned(Temp); + while Assigned(Temp) and (Temp <> Node) do + begin + Inc(TopOffset, NodeHeight[Temp]); + Temp := GetNextVisibleNoInit(Temp, True); + end; + end; + if not CacheIsAvailable then + begin + // If the cache is not available then go straight through all nodes up to the root and sum up their heights. + Temp := Node; + repeat + Temp := GetPreviousVisibleNoInit(Temp, True); + if Temp = nil then + Break; + Inc(TopOffset, NodeHeight[Temp]); + until False; + end; + + Result := Rect(0, TopOffset, Max(FRangeX, ClientWidth), TopOffset + NodeHeight[Node]); + + // Limit left and right bounds to the given column (if any) and move bounds according to current scroll state. + if Column > NoColumn then + begin + FHeader.Columns.GetColumnBounds(Column, Result.Left, Result.Right); + // The right column border is not part of this cell. + Dec(Result.Right); + OffsetRect(Result, 0, FOffsetY); + end + else + OffsetRect(Result, -FEffectiveOffsetX, FOffsetY); + + // Limit left and right bounds further if only the text area is required. + if TextOnly then + begin + // If the text of a node is involved then we have to consider directionality and alignment too. + if Column <= NoColumn then + begin + CurrentBidiMode := BidiMode; + CurrentAlignment := Alignment; + end + else + begin + CurrentBidiMode := FHeader.Columns[Column].BidiMode; + CurrentAlignment := FHeader.Columns[Column].Alignment; + end; + + GetOffsets(Node, lOffsets, TVTElement.ofsLabel, Column); + LeftOffset := lOffSets[TVTElement.ofsLabel]; + // Offset contains now the distance from the left or right border of the rectangle (depending on bidi mode). + // Now consider the alignment too and calculate the final result. + if CurrentBidiMode = bdLeftToRight then + begin + Inc(Result.Left, LeftOffset); + // Left-to-right reading does not need any special adjustment of the alignment. + end + else + begin + Dec(Result.Right, LeftOffset); + + // Consider bidi mode here. In RTL context does left alignment actually mean right alignment and vice versa. + ChangeBiDiModeAlignment(CurrentAlignment); + end; + + TextWidth := DoGetNodeWidth(Node, Column); + + // Keep cell height before applying cell content margin in order to increase cell height if text does not fit + // and Unclipped it true (see below). + MaxUnclippedHeight := Result.Bottom - Result.Top; + + if ApplyCellContentMargin then + DoBeforeCellPaint(Self.Canvas, Node, Column, cpmGetContentMargin, Result, Result); + + if Unclipped then + begin + // The caller requested the text coordinates unclipped. This means they must be calculated so as would + // there be enough space, regardless of column bounds etc. + // The layout still depends on the available space too, because this determines the position + // of the unclipped text rectangle. + if Result.Right - Result.Left < TextWidth - 1 then + if CurrentBidiMode = bdLeftToRight then + CurrentAlignment := taLeftJustify + else + CurrentAlignment := taRightJustify; + + // Increase cell height (up to MaxUnclippedHeight determined above) if text does not fit. + GetTextMetrics(Self.Canvas, TM); + ExtraVerticalMargin := System.Math.Min(TM.tmHeight, MaxUnclippedHeight) - (Result.Bottom - Result.Top); + if ExtraVerticalMargin > 0 then + InflateRect(Result, 0, Divide(ExtraVerticalMargin + 1, 2)); + + case CurrentAlignment of + taCenter: + begin + Result.Left := Divide(Result.Left + Result.Right - TextWidth, 2); + Result.Right := Result.Left + TextWidth; + end; + taRightJustify: + Result.Left := Result.Right - TextWidth; + else // taLeftJustify + Result.Right := Result.Left + TextWidth - 1; + end; + end + else + // Modify rectangle only if the text fits entirely into the given room. + if Result.Right - Result.Left > TextWidth then + case CurrentAlignment of + taCenter: + begin + Result.Left := Divide(Result.Left + Result.Right - TextWidth, 2); + Result.Right := Result.Left + TextWidth; + end; + taRightJustify: + Result.Left := Result.Right - TextWidth; + else // taLeftJustify + Result.Right := Result.Left + TextWidth; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetEffectivelyFiltered(Node: PVirtualNode): Boolean; + +// Checks if a node is effectively filtered out. This depends on the nodes state and the paint options. + +begin + if Assigned(Node) then + Result := (vsFiltered in Node.States) and not (toShowFilteredNodes in FOptions.PaintOptions) + else + Result := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetEffectivelyVisible(Node: PVirtualNode): Boolean; + +begin + Result := (vsVisible in Node.States) and not IsEffectivelyFiltered[Node]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirst(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the first node in the tree while optionally considering toChildrenAbove. + +begin + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + if vsHasChildren in FRoot.States then + begin + Result := FRoot; + + // Child nodes are the first choice if possible. + if Assigned(Result.FirstChild) then + begin + while Assigned(Result.FirstChild) do + begin + Result := Result.FirstChild; + if not (vsInitialized in Result.States) then + InitNode(Result); + + if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then + InitChildren(Result); + end; + end + else + Result := nil; + end + else + Result := nil; + end + else + Result := FRoot.FirstChild; + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstChecked(State: TCheckState = csCheckedNormal; + ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the first node in the tree with the given check state. + +begin + Result := GetNextChecked(nil, State, ConsiderChildrenAbove); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstChild(Node: PVirtualNode): PVirtualNode; + +// Returns the first child of the given node. The result node is initialized before exit. + +begin + if (Node = nil) or (Node = FRoot) then + Result := FRoot.FirstChild + else + begin + if not (vsInitialized in Node.States) then + InitNode(Node); + if vsHasChildren in Node.States then + begin + if Node.ChildCount = 0 then + InitChildren(Node); + Result := Node.FirstChild; + end + else + Result := nil; + end; + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstChildNoInit(Node: PVirtualNode): PVirtualNode; +// Determines the first child of the given node but does not initialize it. + +begin + if (Node = nil) or (Node = FRoot) then + Result := FRoot.FirstChild + else + begin + if vsHasChildren in Node.States then + Result := Node.FirstChild + else + Result := nil; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstCutCopy(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the first node in the tree which is currently marked for a clipboard operation. +// See also GetNextCutCopy for comments on initialization. + +begin + Result := GetNextCutCopy(nil, ConsiderChildrenAbove); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstInitialized(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the first node which is already initialized. + +begin + Result := GetFirstNoInit(ConsiderChildrenAbove); + if Assigned(Result) and not (vsInitialized in Result.States) then + Result := GetNextInitialized(Result, ConsiderChildrenAbove); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstLeaf: PVirtualNode; + +// Returns the first node in the tree which has currently no children. +// The result is initialized if necessary. + +begin + Result := GetNextLeaf(nil); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstLevel(NodeLevel: Cardinal): PVirtualNode; + +// Returns the first node in the tree on a specific level. +// The result is initialized if necessary. + +begin + Result := GetFirstNoInit(True); + while Assigned(Result) and (GetNodeLevel(Result) <> NodeLevel) do + Result := GetNextNoInit(Result, True); + + if Assigned(Result) and (GetNodeLevel(Result) <> NodeLevel) then // i.e. there is no node with the desired level in the tree + Result := nil; + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstNoInit(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the first node in the tree while optionally considering toChildrenAbove. +// No initialization is performed. + +begin + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + if vsHasChildren in FRoot.States then + begin + Result := FRoot; + + // Child nodes are the first choice if possible. + if Assigned(Result.FirstChild) then + begin + while Assigned(Result.FirstChild) do + Result := Result.FirstChild; + end + else + Result := nil; + end + else + Result := nil; + end + else + Result := FRoot.FirstChild; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstSelected(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the first node in the current selection while optionally considering toChildrenAbove. + +begin + Result := GetNextSelected(nil, ConsiderChildrenAbove); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeFiltered: Boolean = False): PVirtualNode; + +// Returns the first visible node in the tree while optionally considering toChildrenAbove. +// If necessary nodes are initialized on demand. + +begin + Result := Node; + if not Assigned(Result) then + Result := FRoot; + + if vsHasChildren in Result.States then + begin + if Result.ChildCount = 0 then + InitChildren(Result); + + // Child nodes are the first choice if possible. + if Assigned(Result.FirstChild) then + begin + Result := GetFirstChild(Result); + + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + repeat + // Search the first visible sibling. + while Assigned(Result.NextSibling) and not (vsVisible in Result.States) do + begin + Result := Result.NextSibling; + // Init node on demand as this might change the visibility. + if not (vsInitialized in Result.States) then + InitNode(Result); + end; + + // If there are no visible siblings take the parent. + if not (vsVisible in Result.States) then + begin + Result := Result.Parent; + if Result = FRoot then + Result := nil; + Break; + end + else + begin + if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then + InitChildren(Result); + if (not Assigned(Result.FirstChild)) or (not (vsExpanded in Result.States)) then + Break; + end; + + Result := Result.FirstChild; + if not (vsInitialized in Result.States) then + InitNode(Result); + until False; + end + else + begin + // If there are no children or the first child is not visible then search the sibling nodes or traverse parents. + if not (vsVisible in Result.States) then + begin + repeat + // Is there a next sibling? + if Assigned(Result.NextSibling) then + begin + Result := Result.NextSibling; + // The visible state can be removed during initialization so init the node first. + 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; + end + else + Result := nil; + end + else + Result := nil; + + if Assigned(Result) and not IncludeFiltered and IsEffectivelyFiltered[Result] then + Result := GetNextVisible(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstVisibleChild(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + +// Returns the first visible child node of Node. If necessary nodes are initialized on demand. + +begin + if Node = nil then + Node := FRoot; + Result := GetFirstChild(Node); + + if Assigned(Result) and (not (vsVisible in Result.States) or + (not IncludeFiltered and IsEffectivelyFiltered[Result])) then + Result := GetNextVisibleSibling(Result, IncludeFiltered); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + +// Returns the first visible child node of Node. + +begin + if Node = nil then + Node := FRoot; + Result := Node.FirstChild; + if Assigned(Result) and (not (vsVisible in Result.States) or + (not IncludeFiltered and IsEffectivelyFiltered[Result])) then + Result := GetNextVisibleSiblingNoInit(Result, IncludeFiltered); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstVisibleNoInit(Node: PVirtualNode = nil; + ConsiderChildrenAbove: Boolean = True; IncludeFiltered: Boolean = False): PVirtualNode; + +// Returns the first visible node in the tree or given subtree while optionally considering toChildrenAbove. +// No initialization is performed. + +begin + Result := Node; + if not Assigned(Result) then + Result := FRoot; + + if vsHasChildren in Result.States then + begin + // Child nodes are the first choice if possible. + if Assigned(Result.FirstChild) then + begin + Result := Result.FirstChild; + + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + repeat + // Search the first visible sibling. + while Assigned(Result.NextSibling) and not (vsVisible in Result.States) do + Result := Result.NextSibling; + + // If there a no visible siblings take the parent. + if not (vsVisible in Result.States) then + begin + Result := Result.Parent; + if Result = FRoot then + Result := nil; + Break; + end + else + if (not Assigned(Result.FirstChild)) or (not (vsExpanded in Result.States))then + Break; + + Result := Result.FirstChild; + until False; + end + else + begin + // If there are no children or the first child is not visible then search the sibling nodes or traverse parents. + if 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; + end + else + Result := nil; + end + else + Result := nil; + + if Assigned(Result) and not IncludeFiltered and IsEffectivelyFiltered[Result] then + Result := GetNextVisibleNoInit(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.GetHitTestInfoAt(X, Y: TDimension; Relative: Boolean; var HitInfo: THitInfo; ShiftState: TShiftState=[]); + +// Determines the node that occupies the specified point or nil if there's none. The parameter Relative determines +// whether to consider X and Y as being client coordinates (if True) or as being absolute tree coordinates. +// HitInfo is filled with flags describing the hit further. + +var + ColLeft, + ColRight: TDimension; + NodeTop: TDimension; + InitialColumn, + NextColumn: TColumnIndex; + CurrentBidiMode: TBidiMode; + CurrentAlignment: TAlignment; + NodeRect: TRect; + +begin + HitInfo.HitNode := nil; + HitInfo.HitPositions := []; + HitInfo.HitColumn := NoColumn; + + if ShiftState=[] then + ShiftState:= KeyboardStateToShiftState(); + HitInfo.ShiftState:= ShiftState; + + // Determine if point lies in the tree's client area. + if X < 0 then + Include(HitInfo.HitPositions, hiToLeft) + else + if X > Max(FRangeX, ClientWidth) then + Include(HitInfo.HitPositions, hiToRight); + + if Y < 0 then + Include(HitInfo.HitPositions, hiAbove) + else + if Y > Max(FRangeY, ClientHeight) then + Include(HitInfo.HitPositions, hiBelow); + + // Convert position into absolute coordinate if necessary. + if Relative then + begin + if X >= Header.Columns.GetVisibleFixedWidth then + Inc(X, FEffectiveOffsetX); + Inc(Y, -FOffsetY); + end; + HitInfo.HitPoint.X := X; + HitInfo.HitPoint.Y := Y; + + // If the point is in the tree area then check the nodes. + if HitInfo.HitPositions = [] then + begin + HitInfo.HitNode := GetNodeAt(X, Y, False, NodeTop); + if HitInfo.HitNode = nil then + Include(HitInfo.HitPositions, hiNowhere) + else + begin + // At this point we need some info about the node, so it must be initialized. + if not (vsInitialized in HitInfo.HitNode.States) then + InitNode(HitInfo.HitNode); + + if FHeader.UseColumns then + begin + HitInfo.HitColumn := TVirtualTreeColumnsCracker(FHeader.Columns).GetColumnAndBounds(Point(X, Y), ColLeft, ColRight, False); + // If auto column spanning is enabled then look for the last non empty column. + if toAutoSpanColumns in FOptions.AutoOptions then + begin + InitialColumn := HitInfo.HitColumn; + // Search to the left of the hit column for empty columns. + while (HitInfo.HitColumn > NoColumn) and ColumnIsEmpty(HitInfo.HitNode, HitInfo.HitColumn) do + begin + NextColumn := FHeader.Columns.GetPreviousVisibleColumn(HitInfo.HitColumn); + if NextColumn = InvalidColumn then + Break; + HitInfo.HitColumn := NextColumn; + Dec(ColLeft, FHeader.Columns[NextColumn].Width); + end; + // Search to the right of the hit column for empty columns. + repeat + InitialColumn := FHeader.Columns.GetNextVisibleColumn(InitialColumn); + if (InitialColumn = InvalidColumn) or not ColumnIsEmpty(HitInfo.HitNode, InitialColumn) then + Break; + Inc(ColRight, FHeader.Columns[InitialColumn].Width); + until False; + end; + // Make the X position and the right border relative to the start of the column. + Dec(X, ColLeft); + Dec(ColRight, ColLeft); + end + else + begin + HitInfo.HitColumn := NoColumn; + ColRight := Max(FRangeX, ClientWidth); + end; + ColLeft := 0; + + if HitInfo.HitColumn = InvalidColumn then + Include(HitInfo.HitPositions, hiNowhere) + else + begin + // From now on X is in "column" coordinates (relative to the left column border). + HitInfo.HitPositions := [hiOnItem]; + + // Avoid getting the display rect if this is not necessary. + if toNodeHeightResize in FOptions.MiscOptions then + begin + NodeRect := GetDisplayRect(HitInfo.HitNode, HitInfo.HitColumn, False); + if Y <= (NodeRect.Top - FOffsetY + 1) then + Include(HitInfo.HitPositions, hiUpperSplitter) + else + if Y >= (NodeRect.Bottom - FOffsetY - 3) then + Include(HitInfo.HitPositions, hiLowerSplitter); + end; + + if HitInfo.HitColumn <= NoColumn then + begin + CurrentBidiMode := BidiMode; + CurrentAlignment := Alignment; + end + else + begin + CurrentBidiMode := FHeader.Columns[HitInfo.HitColumn].BidiMode; + CurrentAlignment := FHeader.Columns[HitInfo.HitColumn].Alignment; + end; + + if CurrentBidiMode = bdLeftToRight then + DetermineHitPositionLTR(HitInfo, X, ColRight, CurrentAlignment) + else + DetermineHitPositionRTL(HitInfo, X, ColRight, CurrentAlignment); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetLast(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the very last node in the tree branch given by Node and initializes the nodes all the way down including the +// result. toChildrenAbove is optionally considered. By using Node = nil the very last node in the tree is returned. + +var + Next: PVirtualNode; + +begin + Result := GetLastChild(Node); + if not ConsiderChildrenAbove or not (toChildrenAbove in FOptions.PaintOptions) then + while Assigned(Result) 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 := GetLastChild(Result); + if Next = nil then + Break; + Result := Next; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetLastInitialized(Node: PVirtualNode = nil; + ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the very last initialized child node in the tree branch given by Node. + +begin + Result := GetLastNoInit(Node, ConsiderChildrenAbove); + if Assigned(Result) and not (vsInitialized in Result.States) then + Result := GetPreviousInitialized(Result, ConsiderChildrenAbove); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetLastNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the very last node in the tree branch given by Node without initialization. + +var + Next: PVirtualNode; + +begin + Result := GetLastChildNoInit(Node); + if not ConsiderChildrenAbove or not (toChildrenAbove in FOptions.PaintOptions) then + while Assigned(Result) 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 Next = nil then + Break; + Result := Next; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetLastChild(Node: PVirtualNode): PVirtualNode; + +// Determines the last child of the given node and initializes it if there is one. + +begin + if (Node = nil) or (Node = FRoot) then + Result := FRoot.LastChild + else + begin + if not (vsInitialized in Node.States) then + InitNode(Node); + if vsHasChildren in Node.States then + begin + if Node.ChildCount = 0 then + InitChildren(Node); + Result := Node.LastChild; + end + else + Result := nil; + end; + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetLastChildNoInit(Node: PVirtualNode): PVirtualNode; + +// Determines the last child of the given node but does not initialize it. + +begin + if (Node = nil) or (Node = FRoot) then + Result := FRoot.LastChild + else + begin + if vsHasChildren in Node.States then + Result := Node.LastChild + else + Result := nil; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetLastSelected(ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the last node in the current selection while optionally considering toChildrenAbove. + +begin + Result := GetPreviousSelected(nil, ConsiderChildrenAbove); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetLastVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeFiltered: Boolean = False): PVirtualNode; + +// Returns the very last visible node in the tree while optionally considering toChildrenAbove. +// The nodes are intialized all the way up including the result node. + +var + Run: PVirtualNode; + +begin + Result := GetLastVisibleNoInit(Node, ConsiderChildrenAbove); + + Run := Result; + while Assigned(Run) and (Run <> Node) and (Run <> RootNode) do + begin + if not (vsInitialized in Run.States) then + InitNode(Run); + Run := Run.Parent; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetLastVisibleChild(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + +// Determines the last visible child of the given node and initializes it if necessary. + +begin + if (Node = nil) or (Node = FRoot) then + Result := GetLastChild(FRoot) + else + if FullyVisible[Node] and (vsExpanded in Node.States) then + Result := GetLastChild(Node) + else + Result := nil; + + if Assigned(Result) and (not (vsVisible in Result.States) or + (not IncludeFiltered and IsEffectivelyFiltered[Result])) then + Result := GetPreviousVisibleSibling(Result, IncludeFiltered); + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetLastVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + +// Determines the last visible child of the given node without initialization. + +begin + if (Node = nil) or (Node = FRoot) then + Result := GetLastChildNoInit(FRoot) + else + if FullyVisible[Node] and (vsExpanded in Node.States) then + Result := GetLastChildNoInit(Node) + else + Result := nil; + + if Assigned(Result) and (not (vsVisible in Result.States) or + (not IncludeFiltered and IsEffectivelyFiltered[Result])) then + Result := GetPreviousVisibleSiblingNoInit(Result, IncludeFiltered); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +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 + Run: PVirtualNode; + +begin + 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; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): TDimension; + +// This method determines the width of the largest node in the given column. +// If UseSmartColumnWidth is True then only the visible nodes which are in view will be considered +// Note: If UseSmartColumnWidth is False then every visible node in the tree will be initialized contradicting so +// the virtual paradigm. + +var + Run, + LastNode, + NextNode: PVirtualNode; + TextLeft, + CurrentWidth: TDimension; + lOffsets: TVTOffsets; +begin + if OperationCanceled then + begin + // Behave non-destructive. + Result := FHeader.Columns[Column].Width; + Exit; + end + else + Result := 0; + + StartOperation(okGetMaxColumnWidth); + try + if Assigned(FOnBeforeGetMaxColumnWidth) then + FOnBeforeGetMaxColumnWidth(FHeader, Column, UseSmartColumnWidth); + + if UseSmartColumnWidth then // Get first visible node which is in view. + Run := GetTopNode + else + Run := GetFirstVisible(nil, True); + + // Decide where to stop. + if UseSmartColumnWidth then + LastNode := GetNextVisible(BottomNode) + else + LastNode := nil; + + if hoAutoResizeInclCaption in FHeader.Options then + Result := Result + (2 * Header.Columns[Column].Margin + Header.Columns[Column].CaptionWidth + 2); + + while Assigned(Run) and not OperationCanceled do + begin + GetOffsets(Run, lOffsets, TVTElement.ofsLabel, Column); + TextLeft := lOffsets[TVTElement.ofsLabel]; + CurrentWidth := DoGetNodeWidth(Run, Column); + Inc(CurrentWidth, DoGetNodeExtraWidth(Run, Column)); + Inc(CurrentWidth, DoGetCellContentMargin(Run, Column).X); + + // Background for fix: + // DoGetNodeWidth works correctly to return just the + // headerwidth in vsMultiline state of the node. But the + // following code was adding TextLeft unnecessarily. This + // caused a width increase each time a column splitter + // was double-clicked for the option hoDblClickResize that + // really does not apply for vsMultiline case. + // Fix: If the node is multiline, leave the current width as + // it is as returned by DoGetNodeWidth logic above. + if (Column > NoColumn) and (vsMultiline in Run.States) then + Result := CurrentWidth + else + if Result < (TextLeft + CurrentWidth) then + Result := TextLeft + CurrentWidth; + + // Get next visible node and update left node position if needed. + NextNode := GetNextVisible(Run, True); + if NextNode = LastNode then + Break; + Run := NextNode; + end; + if toShowVertGridLines in FOptions.PaintOptions then + Inc(Result); + + if Assigned(FOnAfterGetMaxColumnWidth) then + FOnAfterGetMaxColumnWidth(FHeader, Column, Result); + + finally + EndOperation(okGetMaxColumnWidth); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNext(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns next node in tree while optionally considering toChildrenAbove. The Result will be initialized if needed. + +begin + Result := Node; + if Assigned(Result) then + begin + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + // If this node has no siblings use the parent. + if not Assigned(Result.NextSibling) then + begin + Result := Result.Parent; + if Result = FRoot then + begin + Result := nil; + end; + end + else + begin + // There is at least one sibling so take it. + Result := Result.NextSibling; + + // Has this node got children? Initialize them if necessary. + if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then + InitChildren(Result); + + // Now take a look at the children. + while Assigned(Result.FirstChild) do + begin + Result := Result.FirstChild; + if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then + InitChildren(Result); + end; + end; + end + else + begin + // Has this node got children? + if vsHasChildren in Result.States then + begin + // Yes, there are child nodes. Initialize them if necessary. + if Result.ChildCount = 0 then + InitChildren(Result); + end; + + // if there is no child node try siblings + if Assigned(Result.FirstChild) then + Result := Result.FirstChild + else + begin + repeat + // Is there a next sibling? + if Assigned(Result.NextSibling) then + begin + Result := Result.NextSibling; + 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; + end; + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; + ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +begin + if (Node = nil) or (Node = FRoot) then + Result := GetFirstNoInit(ConsiderChildrenAbove) + else + Result := GetNextNoInit(Node, ConsiderChildrenAbove); + + while Assigned(Result) and (GetCheckState(Result) <> State) do + Result := GetNextNoInit(Result, ConsiderChildrenAbove); + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextChecked(Node: PVirtualNode; ConsiderChildrenAbove: Boolean): PVirtualNode; +begin + Result := Self.GetNextChecked(Node, csCheckedNormal, ConsiderChildrenAbove); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextCutCopy(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the next node in the tree which is currently marked for a clipboard operation. Since only visible nodes can +// be marked (or they are hidden after they have been marked) it is not necessary to initialize nodes to check for +// child nodes. The result, however, is initialized if necessary. + +begin + if ClipboardStates * FStates <> [] then + begin + if (Node = nil) or (Node = FRoot) then + Result := GetFirstNoInit(ConsiderChildrenAbove) + else + Result := GetNextNoInit(Node, ConsiderChildrenAbove); + while Assigned(Result) and not (vsCutOrCopy in Result.States) do + Result := GetNextNoInit(Result, ConsiderChildrenAbove); + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); + end + else + Result := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextInitialized(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the next node in tree which is initialized. + +begin + Result := Node; + repeat + Result := GetNextNoInit(Result, ConsiderChildrenAbove); + until (Result = nil) or (vsInitialized in Result.States); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextLeaf(Node: PVirtualNode): PVirtualNode; + +// Returns the next node in the tree which has currently no children. +// The result is initialized if necessary. + +begin + if (Node = nil) or (Node = FRoot) then + Result := FRoot.FirstChild + else + Result := GetNext(Node); + while Assigned(Result) and (vsHasChildren in Result.States) do + Result := GetNext(Result); + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextLevel(Node: PVirtualNode; NodeLevel: Cardinal): PVirtualNode; + +// Returns the next node in the tree on a specific level. +// The result is initialized if necessary. + +var + StartNodeLevel: Cardinal; + +begin + Result := nil; + + if Assigned(Node) and (Node <> FRoot) then + begin + StartNodeLevel := GetNodeLevel(Node); + + if StartNodeLevel < NodeLevel then + begin + Result := GetNext(Node); + if Assigned(Result) and (GetNodeLevel(Result) <> NodeLevel) then + Result := GetNextLevel(Result, NodeLevel); + end + else + if StartNodeLevel = NodeLevel then + begin + Result := Node.NextSibling; + if not Assigned(Result) then // i.e. start node was a last sibling + begin + Result := Node.Parent; + if Assigned(Result) then + begin + // go to next anchestor of the start node which has a next sibling (if exists) + while Assigned(Result) and not Assigned(Result.NextSibling) do + Result := Result.Parent; + if Assigned(Result) then + Result := GetNextLevel(Result.NextSibling, NodeLevel); + end; + end; + end + else + // i.e. StartNodeLevel > NodeLevel + Result := GetNextLevel(Node.Parent, NodeLevel); + end; + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean): PVirtualNode; + +// Optimized version of GetNext performing no initialization, but optionally considering toChildrenAbove. + +begin + Result := Node; + if Assigned(Result) then + begin + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + // If this node has no siblings use the parent. + if not Assigned(Result.NextSibling) then + begin + Result := Result.Parent; + if Result = FRoot then + begin + Result := nil; + end; + end + else + begin + // There is at least one sibling so take it. + Result := Result.NextSibling; + + // Now take a look at the children. + while Assigned(Result.FirstChild) do + begin + Result := Result.FirstChild; + end; + end; + end + else + begin + // If there is no child node try siblings. + if Assigned(Result.FirstChild) then + Result := Result.FirstChild + else + begin + repeat + // Is there a next sibling? + if Assigned(Result.NextSibling) then + begin + Result := Result.NextSibling; + 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; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextSelected(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the next node in the tree which is currently selected. Since children of unitialized nodes cannot be +// in the current selection (because they simply do not exist yet) it is not necessary to initialize nodes here. +// The result however is initialized if necessary. + +begin + if FSelectionCount > 0 then + begin + if (Node = nil) or (Node = FRoot) then + Result := GetFirstNoInit(ConsiderChildrenAbove) + else + Result := GetNextNoInit(Node, ConsiderChildrenAbove); + while Assigned(Result) and not (vsSelected in Result.States) do + Result := GetNextNoInit(Result, ConsiderChildrenAbove); + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); + end + else + Result := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextSibling(Node: PVirtualNode): PVirtualNode; + +// Returns the next sibling of Node and initializes it if necessary. + +begin + Result := Node; + if Assigned(Result) then + begin + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + Result := Result.NextSibling; + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); + end; +end; + +function TBaseVirtualTree.GetNextSiblingNoInit(Node: PVirtualNode): PVirtualNode; + +// Returns the next sibling of Node. + +begin + Result := Node; + if Assigned(Result) then + begin + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + Result := Result.NextSibling; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; + +// Returns next node in tree, with regard to Node, which is visible. +// Nodes which need an initialization (including the result) are initialized. +// toChildrenAbove is optionally considered which is the default here. + +var + TopInvisibleParent: PVirtualNode; + ForceSearch: Boolean; + +begin + Result := Node; + if not Assigned(Result) then Exit; + + 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 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 + // 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 + // No sibling anymore, so use the parent's next sibling. + else 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; + until False; + end; + end; + until not Assigned(Result) or IsEffectivelyVisible[Result]; + + Assert(Result <> Node, 'Node cannot be its own visible successor.'); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; + +// Returns the next node in tree, with regard to Node, which is visible. +// No initialization is done. +// toChildrenAbove is optionally considered which is the default here. + +var + TopInvisibleParent: PVirtualNode; + ForceSearch: Boolean; + +begin + Result := Node; + if not Assigned(Result) then Exit; + + 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 + // Is there a next sibling? + if Assigned(Result.NextSibling) then + begin + 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 are no further nodes to examine, hence there is no further visible node. + Result := nil; + Break; + end; + until False; + end; + end; + until not Assigned(Result) or IsEffectivelyVisible[Result]; + + Assert(Result <> Node, 'Node cannot be its own visible successor.'); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + +// Returns the next visible sibling after Node. Initialization is done implicitly. + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); + + Result := Node; + repeat + Result := GetNextSibling(Result); + until not Assigned(Result) or ((vsVisible in Result.States) and + (IncludeFiltered or not IsEffectivelyFiltered[Result])); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNextVisibleSiblingNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + +// Returns the next visible sibling after Node. + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); + + Result := Node; + repeat + Result := Result.NextSibling; + until not Assigned(Result) or ((vsVisible in Result.States) and + (IncludeFiltered or not IsEffectivelyFiltered[Result])); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNodeAt(X, Y: TDimension): PVirtualNode; + +// Overloaded variant of GetNodeAt to easy life of application developers which do not need to have the exact +// top position returned and always use client coordinates. + +var + Dummy: TDimension; + +begin + Result := GetNodeAt(X, Y, True, Dummy); +end; + +function TBaseVirtualTree.GetNodeAt(const P: TPoint): PVirtualNode; +begin + Result := GetNodeAt(P.X, P.Y); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNodeAt(X, Y: TDimension; Relative: Boolean; var NodeTop: TDimension): PVirtualNode; + +// This method returns the node that occupies the specified point, or nil if there's none. +// If Releative is True then X and Y are given in client coordinates otherwise they are considered as being +// absolute values into the virtual tree image (regardless of the current offsets in the tree window). +// NodeTop gets the absolute or relative top position of the node returned or is untouched if no node +// could be found. + +var + AbsolutePos, + CurrentPos: TNodeHeight; + +begin + if Y < 0 then + Y := 0; + + AbsolutePos := Y; + if Relative then + Inc(AbsolutePos, -FOffsetY); + + // CurrentPos tracks a running term of the current position to test for. + // It corresponds always to the top position of the currently considered node. + CurrentPos := 0; + + // If the cache is available then use it. + if tsUseCache in FStates then + Result := FindInPositionCache(AbsolutePos, CurrentPos) + else + Result := GetFirstVisibleNoInit(nil, True); + + // Determine node, of which position and height corresponds to the scroll position most closely. + while Assigned(Result) and (Result <> FRoot) do + begin + if AbsolutePos < (CurrentPos + NodeHeight[Result]) then + Break; + Inc(CurrentPos, NodeHeight[Result]); + Result := GetNextVisibleNoInit(Result, True); + end; + + if Result = FRoot then + Result := nil; + + // Since the given vertical position is likely not the same as the top position + // of the found node this top position is returned. + if Assigned(Result) then + begin + NodeTop := CurrentPos; + if Relative then + Inc(NodeTop, FOffsetY); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + + +function TBaseVirtualTree.GetNodeData(Node: PVirtualNode): Pointer; + +// Returns the address of the user defined data area in the node. + +begin + Assert((FNodeDataSize > 0) or not Assigned(Node), 'NodeDataSize not initialized.'); + if (FNodeDataSize <= 0) or (Node = nil) or (Node = FRoot) then + Result := nil + else + begin + Result := Node.GetData(); + Include(Node.States, vsOnFreeNodeCallRequired); // We now need to call OnFreeNode, see bug #323 + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNodeData(pNode: PVirtualNode): T; + +// Returns the associated data converted to the class given in the generic part of the function. + +var + P: Pointer; +begin + P := Self.GetNodeData(pNode); + if Assigned(P) then + Exit(T(P^)) + else + Exit(Default(T)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetInterfaceFromNodeData(pNode: PVirtualNode): T; +begin + if Assigned(pNode) then + Result := T(Self.GetNodeData(pNode)^) + else + Result := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNodeDataAt(pXCoord, pYCoord: Integer): T; + +// Returns the associated data at the specified coordinates converted to the type given in the generic part of the function. + +var + lNode: PVirtualNode; +begin + lNode := GetNodeAt(pXCoord, pYCoord); + Result := Self.GetNodeData(lNode); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetFirstSelectedNodeData(): T; + +// Returns of the first selected node associated data converted to the type given in the generic part of the function. + +begin + Result := Self.GetNodeData(GetFirstSelected()); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetNodeLevel(Node: PVirtualNode): Cardinal; + +// returns the level of the given node + +var + Run: PVirtualNode; + +begin + Result := 0; + if Assigned(Node) and (Node <> FRoot) then + begin + Run := Node.Parent; + while Run <> FRoot do + begin + Run := Run.Parent; + System.Inc(Result); + end; + end; +end; + + +//---------------------------------------------------------------------------------------------------------------------- +// Function introduced to avoid spaghetti code to fix setting of FLastSelectionLevel +// at various places that now needs to avoid setting it for a disabled node +function TBaseVirtualTree.GetNodeLevelForSelectConstraint(Node: PVirtualNode): integer; +begin + if Assigned(Node) and not (vsDisabled in Node.States) then + result := GetNodeLevel(Node) + else + result := -1; +end; + + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPrevious(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns previous node in tree. If ConsiderChildrenAbove is True the function considers +// whether toChildrenAbove is currently set, otherwise the result will always be the previous +// node in top-down order regardless of the current PaintOptions. +// The Result will be initialized if needed. + +var + Run: PVirtualNode; + +begin + Result := Node; + if Assigned(Result) then + begin + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + // Has this node got children? Initialize them if necessary. + if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then + InitChildren(Result); + + // If there is a last child, take it; if not try the previous sibling. + if Assigned(Result.LastChild) then + Result := Result.LastChild + else + if Assigned(Result.PrevSibling) then + Result := Result.PrevSibling + else + begin + // If neither a last child nor a previous sibling exist, go the tree upwards and + // look, wether one of the parent nodes have a previous sibling. If not the result + // will ne nil. + repeat + Result := Result.Parent; + Run := nil; + if Result <> FRoot then + Run := Result.PrevSibling + else + Result := nil; + until Assigned(Run) or (Result = nil); + + if Assigned(Run) then + Result := Run; + end; + end + else + begin + // Is there a previous sibling? + if Assigned(Node.PrevSibling) then + begin + // Go down and find the last child node. + Result := GetLast(Node.PrevSibling); + if Result = nil then + Result := Node.PrevSibling; + end + else + // no previous sibling so the parent of the node is the previous visible node + if Node.Parent <> FRoot then + Result := Node.Parent + else + Result := nil; + end; + end; + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; + ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +begin + if (Node = nil) or (Node = FRoot) then + Result := GetLastNoInit(nil, ConsiderChildrenAbove) + else + Result := GetPreviousNoInit(Node, ConsiderChildrenAbove); + + while Assigned(Result) and (GetCheckState(Result) <> State) do + Result := GetPreviousNoInit(Result, ConsiderChildrenAbove); + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousCutCopy(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the previous node in the tree which is currently marked for a clipboard operation. Since only visible nodes can +// be marked (or they are hidden after they have been marked) it is not necessary to initialize nodes to check for +// child nodes. The result, however, is initialized if necessary. + +begin + if ClipboardStates * FStates <> [] then + begin + if (Node = nil) or (Node = FRoot) then + Result := GetLastNoInit(nil, ConsiderChildrenAbove) + else + Result := GetPreviousNoInit(Node, ConsiderChildrenAbove); + while Assigned(Result) and not (vsCutOrCopy in Result.States) do + Result := GetPreviousNoInit(Result, ConsiderChildrenAbove); + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); + end + else + Result := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousInitialized(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the previous node in tree which is initialized. + +begin + Result := Node; + repeat + Result := GetPreviousNoInit(Result, ConsiderChildrenAbove); + until (Result = nil) or (vsInitialized in Result.States); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousLeaf(Node: PVirtualNode): PVirtualNode; + +// Returns the previous node in the tree which has currently no children. +// The result is initialized if necessary. + +begin + if (Node = nil) or (Node = FRoot) then + Result := FRoot.LastChild + else + Result := GetPrevious(Node); + while Assigned(Result) and (vsHasChildren in Result.States) do + Result := GetPrevious(Result); + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousLevel(Node: PVirtualNode; NodeLevel: Cardinal): PVirtualNode; + +// Returns the previous node in the tree on a specific level. +// The result is initialized if necessary. + +var + StartNodeLevel: Cardinal; + Run: PVirtualNode; + +begin + Result := nil; + + if Assigned(Node) and (Node <> FRoot) then + begin + StartNodeLevel := GetNodeLevel(Node); + + if StartNodeLevel < NodeLevel then + begin + Result := Node.PrevSibling; + if Assigned(Result) then + begin + // go to last descendant of previous sibling with desired node level (if exists) + Run := Result; + while Assigned(Run) and (GetNodeLevel(Run) < NodeLevel) do + begin + Result := Run; + Run := GetLastChild(Run); + end; + if Assigned(Run) and (GetNodeLevel(Run) = NodeLevel) then + Result := Run + else + begin + if Assigned(Result.PrevSibling) then + Result := GetPreviousLevel(Result, NodeLevel) + else + if Assigned(Result) and (Result.Parent <> FRoot) then + Result := GetPreviousLevel(Result.Parent, NodeLevel) + else + Result := nil; + end; + end + else + Result := GetPreviousLevel(Node.Parent, NodeLevel); + end + else + if StartNodeLevel = NodeLevel then + begin + Result := Node.PrevSibling; + if not Assigned(Result) then // i.e. start node was a first sibling + begin + Result := Node.Parent; + if Assigned(Result) then + Result := GetPreviousLevel(Result, NodeLevel); + end; + end + else // i.e. StartNodeLevel > NodeLevel + Result := GetPreviousLevel(Node.Parent, NodeLevel); + end; + + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns previous node in tree, optionally considering toChildrenAbove. No initialization is performed. + +var + Run: PVirtualNode; + +begin + Result := Node; + if Assigned(Result) then + begin + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.PaintOptions) then + begin + // If there is a last child, take it; if not try the previous sibling. + if Assigned(Result.LastChild) then + Result := Result.LastChild + else + if Assigned(Result.PrevSibling) then + Result := Result.PrevSibling + else + begin + // If neither a last child nor a previous sibling exist, go the tree upwards and + // look, wether one of the parent nodes have a previous sibling. If not the result + // will ne nil. + repeat + Result := Result.Parent; + Run := nil; + if Result <> FRoot then + Run := Result.PrevSibling + else + Result := nil; + until Assigned(Run) or (Result = nil); + + if Assigned(Run) then + Result := Run; + end; + end + else + begin + // Is there a previous sibling? + if Assigned(Node.PrevSibling) then + begin + // Go down and find the last child node. + Result := GetLastNoInit(Node.PrevSibling); + if Result = nil then + Result := Node.PrevSibling; + end + else + // No previous sibling so the parent of the node is the previous node. + if Node.Parent <> FRoot then + Result := Node.Parent + else + Result := nil; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousSelected(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; + +// Returns the previous node in the tree which is currently selected. Since children of unitialized nodes cannot be +// in the current selection (because they simply do not exist yet) it is not necessary to initialize nodes here. +// The result however is initialized if necessary. + +begin + if FSelectionCount > 0 then + begin + if (Node = nil) or (Node = FRoot) then + Result := GetLastNoInit(nil, ConsiderChildrenAbove) + else + Result := GetPreviousNoInit(Node, ConsiderChildrenAbove); + while Assigned(Result) and not (vsSelected in Result.States) do + Result := GetPreviousNoInit(Result, ConsiderChildrenAbove); + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); + end + else + Result := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousSibling(Node: PVirtualNode): PVirtualNode; + +// Returns the previous sibling of Node and initializes it if necessary. + +begin + Result := Node; + if Assigned(Result) then + begin + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + Result := Result.PrevSibling; + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); + end; +end; + +function TBaseVirtualTree.GetPreviousSiblingNoInit(Node: PVirtualNode): PVirtualNode; + +// Returns the previous sibling of Node + +begin + Result := Node; + if Assigned(Result) then + begin + Assert(Result <> FRoot, 'Node must not be the hidden root node.'); + + Result := Result.PrevSibling; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; + +// Returns the previous node in tree, with regard to Node, which is visible. +// Nodes which need an initialization (including the result) are initialized. +// toChildrenAbove is optionally considered which is the default here. + +var + TopInvisibleParent: PVirtualNode; + ForceSearch: Boolean; + +begin + Result := Node; + if not Assigned(Result) then Exit; + + 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 + 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 + 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 + // 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 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; + +//---------------------------------------------------------------------------------------------------------------------- + +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 + TopInvisibleParent: PVirtualNode; + ForceSearch: Boolean; + +begin + Result := Node; + if not Assigned(Result) then Exit; + + 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 := Result.LastChild; + ForceSearch := False; + end else + ForceSearch := True; + + if ForceSearch or not (vsVisible in Result.States) then + begin + 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 + 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.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; + 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; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + +// Returns the previous visible sibling before Node. Initialization is done implicitly. + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); + + Result := Node; + repeat + Result := GetPreviousSibling(Result); + until not Assigned(Result) or ((vsVisible in Result.States) and + (IncludeFiltered or not IsEffectivelyFiltered[Result])); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetPreviousVisibleSiblingNoInit(Node: PVirtualNode; + IncludeFiltered: Boolean = False): PVirtualNode; + +// Returns the previous visible sibling before Node. + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); + + Result := Node; + repeat + Result := Result.PrevSibling; + until not Assigned(Result) or ((vsVisible in Result.States) and + (IncludeFiltered or not IsEffectivelyFiltered[Result])); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.Nodes(ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; + +// Enumeration for all nodes + +begin + Result.FMode := vneAll; + Result.FTree := Self; + Result.FConsiderChildrenAbove := ConsiderChildrenAbove; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CheckedNodes(State: TCheckState; ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; + +// Enumeration for all checked nodes + +begin + Result.FMode := vneChecked; + Result.FTree := Self; + Result.FState := State; + Result.FConsiderChildrenAbove := ConsiderChildrenAbove; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ChildNodes(Node: PVirtualNode): TVTVirtualNodeEnumeration; + +// Enumeration for child nodes + +begin + Result.FMode := vneChild; + Result.FTree := Self; + Result.FNode := Node; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.CutCopyNodes(ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; + +// Enumeration for cut copy node + +begin + Result.FMode := vneCutCopy; + Result.FTree := Self; + Result.FConsiderChildrenAbove := ConsiderChildrenAbove; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.CutToClipboard; +begin + if (toReadOnly in TreeOptions.MiscOptions) then + exit; + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.InitializedNodes(ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; + +// Enumeration for initialized nodes + +begin + Result.FMode := vneInitialized; + Result.FTree := Self; + Result.FConsiderChildrenAbove := ConsiderChildrenAbove; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.LeafNodes: TVTVirtualNodeEnumeration; + +// Enumeration for leaf nodes + +begin + Result.FMode := vneLeaf; + Result.FTree := Self; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.LevelNodes(NodeLevel: Cardinal): TVTVirtualNodeEnumeration; + +// Enumeration for level nodes + +begin + Result.FMode := vneLevel; + Result.FTree := Self; + 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; + +// Enumeration for no init nodes +begin + Result.FMode := vneNoInit; + Result.FTree := Self; + Result.FConsiderChildrenAbove := ConsiderChildrenAbove; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.SelectedCells: TVTCellArray; +begin + if FSelectedCellCount = 0 then + Result := [] else + begin + // Makes a copy of the selected cells, so the actual selected array + // cannot be changed + Result := Copy(FSelectedCells); + SetLength(Result, FSelectedCellCount); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.SelectedNodes(ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; + +// Enumeration for selected nodes + +begin + Result.FMode := vneSelected; + Result.FTree := Self; + Result.FConsiderChildrenAbove := ConsiderChildrenAbove; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.VisibleNodes(Node: PVirtualNode; ConsiderChildrenAbove: Boolean; + IncludeFiltered: Boolean): TVTVirtualNodeEnumeration; + +// Enumeration for visible nodes + +begin + Result.FMode := vneVisible; + Result.FTree := Self; + Result.FNode := Node; + Result.FConsiderChildrenAbove := ConsiderChildrenAbove; + Result.FIncludeFiltered := IncludeFiltered; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.VisibleChildNodes(Node: PVirtualNode; IncludeFiltered: Boolean): TVTVirtualNodeEnumeration; + +// Enumeration for visible child nodes + +begin + Result.FMode := vneVisibleChild; + Result.FTree := Self; + Result.FNode := Node; + Result.FIncludeFiltered := IncludeFiltered; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.VisibleChildNoInitNodes(Node: PVirtualNode; IncludeFiltered: Boolean): TVTVirtualNodeEnumeration; + +// Enumeration for visible child no init nodes + +begin + Result.FMode := vneVisibleNoInitChild; + Result.FTree := Self; + Result.FNode := Node; + Result.FIncludeFiltered := IncludeFiltered; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.VisibleNoInitNodes(Node: PVirtualNode; ConsiderChildrenAbove: Boolean; + IncludeFiltered: Boolean): TVTVirtualNodeEnumeration; + +// Enumeration for visible no init nodes + +begin + Result.FMode := vneVisibleNoInit; + Result.FTree := Self; + Result.FNode := Node; + Result.FConsiderChildrenAbove := ConsiderChildrenAbove; + Result.FIncludeFiltered := IncludeFiltered; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetSortedCutCopySet(Resolve: Boolean): TNodeArray; + +// Same as GetSortedSelection but with nodes marked as being part in the current cut/copy set (e.g. for clipboard). + +var + Run: PVirtualNode; + Counter: Cardinal; + + //--------------- local function -------------------------------------------- + + procedure IncludeThisNode(Node: PVirtualNode); + + // adds the given node to the result + + var + Len: Cardinal; + + begin + Len := Length(Result); + if Counter = Len then + begin + if Len < 100 then + Len := 100 + else + Len := Len + Len div 10; + SetLength(Result, Len); + end; + Result[Counter] := Node; + System.Inc(Counter); + end; + + //--------------- end local function ---------------------------------------- + +begin + Run := FRoot.FirstChild; + Counter := 0; + if Resolve then + begin + // Resolving is actually easy: just find the first cutted node in logical order + // and then never go deeper in level than this node as long as there's a sibling node. + // Restart the search for a cutted node (at any level) if there are no further siblings. + while Assigned(Run) do + begin + if vsCutOrCopy in Run.States then + begin + IncludeThisNode(Run); + if Assigned(Run.NextSibling) then + Run := Run.NextSibling + else + begin + // If there are no further siblings then go up one or more levels until a node is + // found or all nodes have been processed. Although we consider here only initialized + // nodes we don't need to make any special checks as only initialized nodes can also be selected. + repeat + Run := Run.Parent; + until (Run = FRoot) or Assigned(Run.NextSibling); + if Run = FRoot then + Break + else + Run := Run.NextSibling; + end; + end + else + Run := GetNextNoInit(Run); + end; + end + else + while Assigned(Run) do + begin + if vsCutOrCopy in Run.States then + IncludeThisNode(Run); + Run := GetNextNoInit(Run); + end; + + // set the resulting array to its real length + SetLength(Result, Counter); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetSortedSelection(Resolve: Boolean): TNodeArray; + +// Returns a list of selected nodes sorted in logical order, that is, as they appear in the tree. +// If Resolve is True then nodes which are children of other selected nodes are not put into the new array. +// This feature is in particuar important when doing drag'n drop as in this case all selected node plus their children +// need to be considered. A selected node which is child (grand child etc.) of another selected node is then +// automatically included and doesn't need to be explicitely mentioned in the returned selection array. +// +// Note: The caller is responsible for freeing the array. Allocation is done here. Usually, though, freeing the array +// doesn't need additional attention as it is automatically freed by Delphi when it gets out of scope. + +var + Run: PVirtualNode; + Counter: Cardinal; + +begin + SetLength(Result, FSelectionCount); + if FSelectionCount > 0 then + begin + Run := FRoot.FirstChild; + Counter := 0; + if Resolve then + begin + // Resolving is actually easy: just find the first selected node in logical order + // and then never go deeper in level than this node as long as there's a sibling node. + // Restart the search for a selected node (at any level) if there are no further siblings. + while Assigned(Run) do + begin + if vsSelected in Run.States then + begin + Result[Counter] := Run; + System.Inc(Counter); + if Assigned(Run.NextSibling) then + Run := Run.NextSibling + else + begin + // If there are no further siblings then go up one or more levels until a node is + // found or all nodes have been processed. Although we consider here only initialized + // nodes we don't need to make any special checks as only initialized nodes can also be selected. + repeat + Run := Run.Parent; + until (Run = FRoot) or Assigned(Run.NextSibling); + if Run = FRoot then + Break + else + Run := Run.NextSibling; + end; + end + else + Run := GetNextNoInit(Run); + end; + end + else + while Assigned(Run) do + begin + if vsSelected in Run.States then + begin + Result[Counter] := Run; + System.Inc(Counter); + end; + Run := GetNextNoInit(Run); + end; + + // Since we may have skipped some nodes the result array is likely to be smaller than the + // selection array, hence shorten the result to true length. + if Integer(Counter) < Length(Result) then + SetLength(Result, Counter); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.GetTextInfo(Node: PVirtualNode; Column: TColumnIndex; const AFont: TFont; var R: TRect; + var Text: string); + +// Generic base method for editors, hint windows etc. to get some info about a node. + +begin + R := Rect(0, 0, 0, 0); + Text := ''; + if Assigned(Font) then // 1 EConvertError due to Font being nil seen here in 01/2019, See issue #878 + AFont.Assign(Font); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetTreeRect: TRect; + +// Returns the true size of the tree in pixels. This size is at least ClientHeight x ClientWidth and depends on +// the expand state, header size etc. +// Note: if no columns are used then the width of the tree is determined by the largest node which is currently in the +// client area. This might however not be the largest node in the entire tree. + +begin + Result := Rect(0, 0, Max(FRangeX, ClientWidth), Max(FRangeY, ClientHeight)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetVisibleParent(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; + +// Returns the first (nearest) parent node of Node which is visible. +// This method is one of the seldom cases where the hidden root node could be returned. + +begin + Assert(Assigned(Node), 'Node must not be nil.'); + Assert(Node <> FRoot, 'Node must not be the hidden root node.'); + + Result := Node.Parent; + while (Result <> FRoot) and (not FullyVisible[Result] or (not IncludeFiltered and IsEffectivelyFiltered[Result])) do + Result := Result.Parent; +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. + +var + Run: PVirtualNode; + +begin + Result := Assigned(Node) and Assigned(PotentialParent) and (Node <> PotentialParent); + if Result then + begin + Run := Node; + while (Run <> FRoot) and (Run <> PotentialParent) do + Run := Run.Parent; + Result := Run = PotentialParent; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.InsertNode(Node: PVirtualNode; Mode: TVTNodeAttachMode; UserData: Pointer = nil): PVirtualNode; + +// Adds a new node relative to Node. The final position is determined by Mode. +// UserData can be used to set the first SizeOf(Pointer) bytes of the user data area to an initial value which can be used +// in OnInitNode and will also cause to trigger the OnFreeNode event (if <> nil) even if the node is not yet +// "officially" initialized. +// InsertNode is a compatibility method and will implicitly validate the given node if the new node +// is to be added as child node. This is however against the virtual paradigm and hence I dissuade from its usage. + +begin + if Mode <> amNoWhere then + begin + CancelEditNode; + + if Node = nil then + Node := FRoot; + // we need a new node... + Result := MakeNewNode; + // avoid erronous attach modes + if Node = FRoot then + begin + case Mode of + amInsertBefore: + Mode := amAddChildFirst; + amInsertAfter: + Mode := amAddChildLast; + end; + end; + + // Validate given node in case the new node becomes its child. + if (Mode in [amAddChildFirst, amAddChildLast]) and not (vsInitialized in Node.States) then + InitNode(Node); + InternalConnectNode(Result, Node, Self, Mode); + + // Check if there is initial user data and there is also enough user data space allocated. + if Assigned(UserData) then + SetNodeData(Result, UserData); + + if FUpdateCount = 0 then + begin + case Mode of + amInsertBefore, + amInsertAfter: + begin + // Here no initialization is necessary because *if* a node has already got children then it + // must also be initialized. + // Note: Node can never be FRoot at this point. + StructureChange(Result, crNodeAdded); + // If auto sort is enabled then sort the node or its parent (depending on the insert mode). + if (toAutoSort in FOptions.AutoOptions) and (FHeader.SortColumn > InvalidColumn) then + Sort(Node.Parent, FHeader.SortColumn, FHeader.SortDirection, True); + InvalidateToBottom(Result) + end; + amAddChildFirst, + amAddChildLast: + begin + StructureChange(Node, crChildAdded); + // If auto sort is enabled then sort the node or its parent (depending on the insert mode). + if (toAutoSort in FOptions.AutoOptions) and (FHeader.SortColumn > InvalidColumn) then + Sort(Node, FHeader.SortColumn, FHeader.SortDirection, True); + InvalidateToBottom(Node); + end; + end; + InvalidateCache(); + UpdateScrollBars(True); + end; + end + else + Result := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InvalidateChildren(Node: PVirtualNode; Recursive: Boolean); + +// Invalidates Node and its immediate children. +// If Recursive is True then all grandchildren are invalidated as well. +// The node itself is initialized if necessary and its child nodes are created (and initialized too if +// Recursive is True). + +var + Run: PVirtualNode; + +begin + if Assigned(Node) then + begin + if not (vsInitialized in Node.States) then + InitNode(Node); + InvalidateNode(Node); + if (vsHasChildren in Node.States) and (Node.ChildCount = 0) then + InitChildren(Node); + Run := Node.FirstChild; + end + else + Run := FRoot.FirstChild; + + while Assigned(Run) do + begin + InvalidateNode(Run); + if Recursive then + InvalidateChildren(Run, True); + Run := Run.NextSibling; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InvalidateColumn(Column: TColumnIndex); + +// Invalidates the client area part of a column. + +var + R: TRect; + +begin + if (FUpdateCount = 0) and HandleAllocated and FHeader.Columns.IsValidColumn(Column) then + begin + R := ClientRect; + FHeader.Columns.GetColumnBounds(Column, R.Left, R.Right); + InvalidateRect(@R, False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.InvalidateNode(Node: PVirtualNode): TRect; + +// Initiates repaint of the given node and returns the just invalidated rectangle. + +begin + Assert(Assigned(Node), 'Node must not be nil.'); + Assert(GetCurrentThreadId = MainThreadId, 'UI controls may only be chnaged in UI thread.'); + // Reset height measured flag too to cause a re-issue of the OnMeasureItem event. + Exclude(Node.States, vsHeightMeasured); + if (FUpdateCount = 0) and HandleAllocated then + begin + Result := GetDisplayRect(Node, NoColumn, False); + InvalidateRect(@Result, False); + end + else + result := Rect(-1,-1,-1,-1); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InvalidateToBottom(Node: PVirtualNode); + +// Initiates repaint of client area starting at given node. If this node is not visible or not yet initialized +// then nothing happens. + +var + R: TRect; + +begin + if (FUpdateCount = 0) and HandleAllocated then + begin + if (Node = nil) or (Node = FRoot) then + Invalidate + else + if (vsInitialized in Node.States) and IsEffectivelyVisible[Node] then + begin + R := GetDisplayRect(Node, NoColumn, False); + if R.Top < ClientHeight then + begin + if (toChildrenAbove in FOptions.PaintOptions) and (vsExpanded in Node.States) then + Dec(R.Top, Node.TotalHeight + NodeHeight[Node]); + R.Bottom := ClientHeight; + InvalidateRect(@R, False); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.InvertSelection(VisibleOnly: Boolean); + +// Inverts the current selection (so nodes which are selected become unselected and vice versa). +// If VisibleOnly is True then only visible nodes are considered. + +var + Run: PVirtualNode; + NewSize: Integer; + NextFunction: TGetNextNodeProc; + TriggerChange: Boolean; + +begin + if not FSelectionLocked and (toMultiSelect in FOptions.SelectionOptions) then + begin + Run := FRoot.FirstChild; + ClearTempCache; + if VisibleOnly then + NextFunction := GetNextVisibleNoInit + else + NextFunction := GetNextNoInit; + while Assigned(Run) do + begin + if vsSelected in Run.States then + InternalRemoveFromSelection(Run) + else + InternalCacheNode(Run); + Run := NextFunction(Run); + end; + + // do some housekeeping + // Need to trigger the OnChange event from here if nodes were only deleted but not added. + TriggerChange := False; + NewSize := PackArray(FSelection, FSelectionCount); + if NewSize > -1 then + begin + FSelectionCount := NewSize; + SetLength(FSelection, FSelectionCount); + TriggerChange := True; + end; + if FTempNodeCount > 0 then + begin + AddToSelection(FTempNodeCache, FTempNodeCount); + ClearTempCache; + TriggerChange := False; + end; + Invalidate; + if TriggerChange then + Change(nil); + if Self.SelectedCount = 0 then + FNextNodeToSelect := nil;//Ensure that no other node is selected now + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsEditing: Boolean; + +begin + Result := tsEditing in FStates; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsMouseSelecting: Boolean; + +begin + Result := (tsDrawSelPending in FStates) or (tsDrawSelecting in FStates); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsStored_BackgroundOffsetXY(const Index: Integer): Boolean; +begin + case Index of + 0: + Result:= CompareValue(FBackgroundOffsetX, 0)<>EqualsValue; + 1: + Result:= CompareValue(FBackgroundOffsetY, 0)<>EqualsValue; + else + // Clear warning only + Result:= false; + RaiseVTError('Unknown index in TBaseVirtualTree.IsStored_BackgroundOffsetXY', 0); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsStored_BottomSpace: Boolean; +begin + Result:= CompareValue(FBottomSpace, 0)<>EqualsValue; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsStored_DefaultNodeHeight: Boolean; +begin + Result:= CompareValue(FDefaultNodeHeight, cInitialDefaultNodeHeight)<>EqualsValue; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsStored_Indent: Boolean; +begin + Result:= CompareValue(FIndent, 18)<>EqualsValue; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsStored_Margin: Boolean; +begin + Result:= CompareValue(FMargin, 4)<>EqualsValue; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsStored_TextMargin: Boolean; +begin + Result:= CompareValue(FTextMargin, cDefaultTextMargin) <> EqualsValue; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsUpdating: Boolean; +// The tree does currently not update its window because a BeginUpdate has not yet ended. +begin + Exit(UpdateCount > 0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +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) +// and calls for each node the provided callback method (which must not be empty). +// Filter determines which nodes to consider (an empty set denotes all nodes). +// If DoInit is True then nodes which aren't initialized yet will be initialized. +// Note: During execution of the callback the application can set Abort to True. In this case the iteration is stopped +// and the last accessed node (the one on which the callback set Abort to True) is returned to the caller. +// Otherwise (no abort) nil is returned. + +var + Stop: PVirtualNode; + Abort: Boolean; + GetNextNode: TGetNextNodeProc; + WasIterating: Boolean; + +begin + Assert(StartNode <> FRoot, 'Node must not be the hidden root node.'); + + WasIterating := tsIterating in FStates; + DoStateChange([tsIterating]); + try + // prepare function to be used when advancing + if DoInit then + GetNextNode := GetNext + else + GetNextNode := GetNextNoInit; + + Abort := False; + Result := StartNode; + if Result = nil then + begin + Stop := nil; + // Use first node if we start with the root. + Result := GetFirstNoInit; + end + else + begin + 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 := Result.NextSibling; + if Stop = nil then + begin + Stop := Result; + repeat + Stop := Stop.Parent; + until (Stop = FRoot) or Assigned(Stop.NextSibling); + if Stop = FRoot then + Stop := nil + else + Stop := Stop.NextSibling; + end; + end; + + if Assigned(Result) then + begin + if not (vsInitialized in Result.States) and DoInit then + InitNode(Result); + + // Skip given node if only the child nodes are requested. + if ChildNodesOnly and (StartNode <> nil ) then + begin + if Result.ChildCount = 0 then + Result := nil + else + Result := GetNextNode(Result); + end; + + if Filter = [] then + begin + // unfiltered loop + while Assigned(Result) and (Result <> Stop) do + begin + Callback(Self, Result, Data, Abort); + if Abort then + Break; + Result := GetNextNode(Result); + end; + end + else + begin + // filtered loop + while Assigned(Result) and (Result <> Stop) do + begin + if Result.States * Filter = Filter then + Callback(Self, Result, Data, Abort); + if Abort then + Break; + Result := GetNextNode(Result); + end; + end; + end; + + if not Abort then + Result := nil; + finally + if not WasIterating then + DoStateChange([], [tsIterating]); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.LoadFromFile(const FileName: TFileName); + +var + FileStream: TFileStream; + +begin + FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(FileStream); + finally + FileStream.Free; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.LoadFromStream(Stream: TStream); + +// Clears the current content of the tree and loads a new structure from the given stream. + +var + ThisID: TMagicID; + Version, + Count: Cardinal; + Node: PVirtualNode; + +begin + if not (toReadOnly in FOptions.MiscOptions) then + begin + Clear; + // Check first whether this is a stream we can read. + if Stream.Read(ThisID, SizeOf(TMagicID)) < SizeOf(TMagicID) then + RaiseVTError(SStreamTooSmall, hcTFStreamTooSmall); + + if (ThisID[0] = MagicID[0]) and + (ThisID[1] = MagicID[1]) and + (ThisID[2] = MagicID[2]) and + (ThisID[5] = MagicID[5]) then + begin + Version := Word(ThisID[3]); + if Version <= VTTreeStreamVersion then + begin + BeginUpdate; + try + if Version < 2 then + Count := MaxInt + else + Stream.ReadBuffer(Count, SizeOf(Count)); + + while (Stream.Position < Stream.Size) and (Count > 0) do + begin + System.Dec(Count); + Node := MakeNewNode; + InternalConnectNode(Node, FRoot, Self, amAddChildLast); + InternalAddFromStream(Stream, Version, Node); + end; + DoNodeCopied(nil); + if Assigned(FOnLoadTree) then + FOnLoadTree(Self, Stream); + finally + EndUpdate; + end; + end + else + RaiseVTError(SWrongStreamVersion, hcTFWrongStreamVersion); + end + else + RaiseVTError(SWrongStreamFormat, hcTFWrongStreamFormat); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.MeasureItemHeight(const Canvas: TCanvas; Node: PVirtualNode); + +// If the height of the given node has not yet been measured then do it now. + +var + NewNodeHeight: TDimension; + +begin + if not (vsHeightMeasured in Node.States) then + begin + Include(Node.States, vsHeightMeasured); + if (toVariableNodeHeight in FOptions.MiscOptions) then + begin + NewNodeHeight := Node.NodeHeight; + // Anonymous methods help to make this thread safe easily. + if (MainThreadId <> GetCurrentThreadId) then + begin + AtomicIncrement(FPendingSyncProcs); + TThread.Synchronize(nil, + procedure + begin + //swish:Decrement invoke refs + AtomicDecrement(FPendingSyncProcs); + DoMeasureItem(Canvas, Node, NewNodeHeight); + SetNodeHeight(Node, NewNodeHeight); + end + ) + end + else + begin + DoMeasureItem(Canvas, Node, NewNodeHeight); + SetNodeHeight(Node, NewNodeHeight); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.MoveTo(Node: PVirtualNode; Tree: TBaseVirtualTree; Mode: TVTNodeAttachMode; + ChildrenOnly: Boolean); + +// A simplified method to allow to move nodes to the root of another tree. + +begin + MoveTo(Node, Tree.FRoot, Mode, ChildrenOnly); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.MoveTo(Source, Target: PVirtualNode; Mode: TVTNodeAttachMode; ChildrenOnly: Boolean); + +// Moves the given node (and all its children) to Target. Source must belong to the tree instance which calls this +// MoveTo method. Mode determines how to connect Source to Target. +// This method might involve a change of the tree if Target belongs to a different tree than Source. + +var + TargetTree: TBaseVirtualTree; + Allowed: Boolean; + NewNode: PVirtualNode; + Stream: TMemoryStream; + +begin + Assert(TreeFromNode(Source) = Self, 'The source tree must contain the source node.'); + + // When moving nodes then source and target must not be the same node unless only the source's children are + // moved and they are inserted before or after the node itself. + Allowed := (Source <> Target) or ((Mode in [amInsertBefore, amInsertAfter]) and ChildrenOnly); + + if Allowed and (Mode <> amNoWhere) and Assigned(Source) and (Source <> FRoot) and + not (toReadOnly in FOptions.MiscOptions) then + begin + // Assume that an empty destination means the root in this (the source) tree. + if Target = nil then + begin + TargetTree := Self; + Target := FRoot; + Mode := amAddChildFirst; + end + else + TargetTree := TreeFromNode(Target); + + if Target = TargetTree.FRoot then + begin + case Mode of + amInsertBefore: + Mode := amAddChildFirst; + amInsertAfter: + Mode := amAddChildLast; + end; + end; + + // Make sure the target node is initialized. + if not (vsInitialized in Target.States) then + TargetTree.InitNode(Target) + else + if (vsHasChildren in Target.States) and (Target.ChildCount = 0) then + TargetTree.InitChildren(Target); + + if TargetTree = Self then + begin + // Simple case: move node(s) within the same tree. + if Target = FRoot then + Allowed := DoNodeMoving(Source, nil) + else + Allowed := DoNodeMoving(Source, Target); + if Allowed then + begin + // Check first that Source is not added as new child to a target node which + // is already a child of Source. + // Consider the case Source and Target are the same node, but only child nodes are moved. + if (Source <> Target) and HasAsParent(Target, Source) then + RaiseVTError(SWrongMoveError, hcTFWrongMoveError); + + if not ChildrenOnly then + begin + // Disconnect from old location. + InternalDisconnectNode(Source, True); + // Connect to new location. + InternalConnectNode(Source, Target, Self, Mode); + DoNodeMoved(Source); + end + else + begin + // Only child nodes should be moved. Insertion order depends on move mode. + if Mode = amAddChildFirst then + begin + Source := Source.LastChild; + while Assigned(Source) do + begin + NewNode := Source.PrevSibling; + // Disconnect from old location. + InternalDisconnectNode(Source, True, False); + // Connect to new location. + InternalConnectNode(Source, Target, Self, Mode); + DoNodeMoved(Source); + Source := NewNode; + end; + end + else + begin + Source := Source.FirstChild; + while Assigned(Source) do + begin + NewNode := Source.NextSibling; + // Disconnect from old location. + InternalDisconnectNode(Source, True, False); + // Connect to new location. + InternalConnectNode(Source, Target, Self, Mode); + DoNodeMoved(Source); + Source := NewNode; + end; + end; + end; + end; + end + else + begin + // Difficult case: move node(s) to another tree. + // In opposition to node copying we ask only once if moving is allowed because + // we cannot take back a move once done. + if Target = TargetTree.FRoot then + Allowed := DoNodeMoving(Source, nil) + else + Allowed := DoNodeMoving(Source, Target); + + if Allowed then + begin + Stream := TMemoryStream.Create; + try + // Write all nodes into a temporary stream depending on the ChildrenOnly flag. + if not ChildrenOnly then + WriteNode(Stream, Source) + else + begin + Source := Source.FirstChild; + while Assigned(Source) do + begin + WriteNode(Stream, Source); + Source := Source.NextSibling; + end; + end; + // Now load the serialized nodes into the target node (tree). + TargetTree.BeginUpdate; + try + Stream.Position := 0; + while Stream.Position < Stream.Size do + begin + NewNode := TargetTree.MakeNewNode; + InternalConnectNode(NewNode, Target, TargetTree, Mode); + TargetTree.InternalAddFromStream(Stream, VTTreeStreamVersion, NewNode); + DoNodeMoved(NewNode); + end; + finally + TargetTree.EndUpdate; + end; + finally + Stream.Free; + end; + // finally delete original nodes + BeginUpdate; + try + if ChildrenOnly then + DeleteChildren(Source) + else + DeleteNode(Source); + finally + EndUpdate; + end; + end; + end; + + InvalidateCache; + if (FUpdateCount = 0) and Allowed then + begin + ValidateCache; + UpdateScrollBars(True); + Invalidate; + if TargetTree <> Self then + TargetTree.Invalidate; + end; + StructureChange(Source, crNodeMoved); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Target: TPoint; + PaintOptions: TVTInternalPaintOptions; PixelFormat: TPixelFormat); + +// This is the core paint routine of the tree. It is responsible for maintaining the paint cycles per node as well +// as coordinating drawing of the various parts of the tree image. +// TargetCanvas is the canvas to which to draw the tree image. This is usually the tree window itself but could well +// be a bitmap or printer canvas. +// Window determines which part of the entire tree image to draw. The full size of the virtual image is determined +// by GetTreeRect. +// Target is the position in TargetCanvas where to draw the tree part specified by Window. +// PaintOptions determines what of the tree to draw. For different tasks usually different parts need to be drawn, with +// a full image in the window, selected only nodes for a drag image etc. + +const + ImageKind: array[Boolean] of TVTImageKind = (ikNormal, ikSelected); + +var + DrawSelectionRect, + UseBackground, + ShowCheckImages, + UseColumns, + IsMainColumn: Boolean; + + IndentSize, + ButtonY: TDimension; // Y position of toggle button within the node's rect + LineImage: TLineImage; + PaintInfo: TVTPaintInfo; // all necessary information about a node to pass to the paint routines + + R, // the area of an entire node in its local coordinate + TargetRect, // the area of a node (part) in the target canvas + SelectionRect, // ordered rectangle used for drawing the selection focus rect + ClipRect: TRect; // area to which the canvas will be clipped when painting a node's content + NextColumn: TColumnIndex; + BaseOffset: TDimension; // top position of the top node to draw given in absolute tree coordinates + NodeBitmap: TBitmap; // small buffer to draw flicker free + MaximumRight, // maximum horizontal target position + MaximumBottom: TDimension; // maximum vertical target position + SelectLevel: Integer; // > 0 if current node is selected or child/grandchild etc. of a selected node + FirstColumn: TColumnIndex; // index of first column which is at least partially visible in the given window + + MaxRight, + ColLeft, + ColRight: TDimension; + + SavedTargetDC: Integer; + PaintWidth: TDimension; + CurrentNodeHeight: TDimension; + lEmptyListTextMargin: TDimension; + + CellIsTouchingClientRight: Boolean; + CellIsInLastColumn: Boolean; + ColumnIsFixed: Boolean; + +begin + if not (tsPainting in FStates) then + begin + DoStateChange([tsPainting]); + try + DoBeforePaint(TargetCanvas); + + if poUnbuffered in PaintOptions then + SavedTargetDC := SaveDC(TargetCanvas.Handle) + else + SavedTargetDC := 0; + + // Prepare paint info structure. + ZeroMemory(@PaintInfo, SizeOf(PaintInfo)); + + PaintWidth := Window.Right - Window.Left; + + if not (poUnbuffered in PaintOptions) then + begin + // Create small bitmaps and initialize default values. + // The bitmaps are used to paint one node at a time and to draw the result to the target (e.g. screen) in one step, + // to prevent flickering. + NodeBitmap := TBitmap.Create; + // For alpha blending we need the 32 bit pixel format. For other targets there might be a need for a certain + // pixel format (e.g. printing). + if ((FDrawSelectionMode = smBlendedRectangle) or (tsUseThemes in FStates) or + (toUseBlendedSelection in FOptions.PaintOptions)) then + NodeBitmap.PixelFormat := pf32Bit + else + NodeBitmap.PixelFormat := PixelFormat; + + NodeBitmap.Width := PaintWidth; + + // Make sure the buffer bitmap and target bitmap use the same transformation mode. + SetMapMode(NodeBitmap.Canvas.Handle, GetMapMode(TargetCanvas.Handle)); + PaintInfo.Canvas := NodeBitmap.Canvas; + end + else + begin + PaintInfo.Canvas := TargetCanvas; + NodeBitmap := nil; + end; + + // Lock the canvas to avoid that it gets freed on the way. + PaintInfo.Canvas.Lock; + try + // Prepare the current selection rectangle once. The corner points are absolute tree coordinates. + SelectionRect := OrderRect(FNewSelRect); + DrawSelectionRect := IsMouseSelecting and not IsRectEmpty(SelectionRect) and (GetKeyState(VK_LBUTTON) < 0); + + // R represents an entire node (all columns), but is a bit unprecise when it comes to + // trees without any column defined, because FRangeX only represents the maximum width of all + // nodes in the client area (not all defined nodes). There might be, however, wider nodes somewhere. Without full + // validation I cannot better determine the width, though. By using at least the control's width it is ensured + // that the tree is fully displayed on screen. + R := Rect(0, 0, Max(FRangeX, ClientWidth), 0); + + // For quick checks some intermediate variables are used. + UseBackground := (toShowBackground in FOptions.PaintOptions) and Assigned(FBackground.Graphic) and + (poBackground in PaintOptions); + ShowCheckImages := Assigned(FCheckImages) and (toCheckSupport in FOptions.MiscOptions); + UseColumns := FHeader.UseColumns; + + // Adjust paint options to tree settings. Hide selection if told so or the tree is unfocused. + if (toAlwaysHideSelection in FOptions.PaintOptions) or + (not Focused and (toHideSelection in FOptions.PaintOptions)) then + Exclude(PaintOptions, poDrawSelection); + if toHideFocusRect in FOptions.PaintOptions then + Exclude(PaintOptions, poDrawFocusRect); + + // Determine node to start drawing with. + BaseOffset := 0; + PaintInfo.Node := GetNodeAt(0, Window.Top, False, BaseOffset); + if PaintInfo.Node = nil then + BaseOffset := Window.Top; + + // Transform selection rectangle into node bitmap coordinates. + if DrawSelectionRect then + OffsetRect(SelectionRect, 0, -BaseOffset); + + // The target rectangle holds the coordinates of the exact area to blit in target canvas coordinates. + // It is usually smaller than an entire node and wanders while the paint loop advances. + MaximumRight := Target.X + (Window.Right - Window.Left); + MaximumBottom := Target.Y + (Window.Bottom - Window.Top); + + TargetRect := Rect(Target.X, Target.Y - (Window.Top - BaseOffset), MaximumRight, 0); + TargetRect.Bottom := TargetRect.Top; + TargetCanvas.Font := Self.Font; + + // This marker gets the index of the first column which is visible in the given window. + // This is needed for column based background colors. + FirstColumn := InvalidColumn; + + if Assigned(PaintInfo.Node) then + begin + + // ----- main node paint loop + while Assigned(PaintInfo.Node) do + begin + // Determine LineImage, SelectionLevel and IndentSize + SelectLevel := DetermineLineImageAndSelectLevel(PaintInfo.Node, LineImage); + IndentSize := Length(LineImage); + + // Initialize node if not already done. + if not (vsInitialized in PaintInfo.Node.States) then + InitNode(PaintInfo.Node); + if (vsSelected in PaintInfo.Node.States) and not (toChildrenAbove in FOptions.PaintOptions) then + System.Inc(SelectLevel); + + // Ensure the node's height is determined. + MeasureItemHeight(PaintInfo.Canvas, PaintInfo.Node); + + // Adjust the brush origin for dotted lines depending on the current source position. + // It is applied some lines later, as the canvas might get reallocated, when changing the node bitmap. + PaintInfo.BrushOrigin := Point(Window.Left and 1, BaseOffset and 1); + Inc(BaseOffset, PaintInfo.Node.NodeHeight); + + TargetRect.Bottom := TargetRect.Top + PaintInfo.Node.NodeHeight; + + // If poSelectedOnly is active then do the following stuff only for selected nodes or nodes + // which are children of selected nodes. + if (SelectLevel > 0) or not (poSelectedOnly in PaintOptions) then + begin + if not (poUnbuffered in PaintOptions) then + begin + // Adjust height of temporary node bitmap. + with NodeBitmap do + begin + if Height <> PaintInfo.Node.NodeHeight then + begin + // Avoid that the VCL copies the bitmap while changing its height. + Height := 0; + Height := PaintInfo.Node.NodeHeight; + SetCanvasOrigin(Canvas, Window.Left, 0); + end; + end; + end + else + begin + SetCanvasOrigin(PaintInfo.Canvas, -TargetRect.Left + Window.Left, -TargetRect.Top); + ClipCanvas(PaintInfo.Canvas, Rect(0, 0, TargetRect.Right - TargetRect.Left, + Min(TargetRect.Bottom - TargetRect.Top, MaximumBottom - TargetRect.Top))); // See issue #579 + end; + + // Set the origin of the canvas' brush. This depends on the node heights. + with PaintInfo do + SetBrushOrigin(Canvas, BrushOrigin.X, BrushOrigin.Y); + + CurrentNodeHeight := PaintInfo.Node.NodeHeight; + R.Bottom := CurrentNodeHeight; + + // Let application decide whether the node should normally be drawn or by the application itself. + if not DoBeforeItemPaint(PaintInfo.Canvas, PaintInfo.Node, R) then + begin + // Init paint options for the background painting. + PaintInfo.PaintOptions := PaintOptions; + + // The node background can contain a single color, a bitmap or can be drawn by the application. + ClearNodeBackground(PaintInfo, UseBackground, True, Rect(Window.Left, TargetRect.Top, Window.Right, + TargetRect.Bottom)); + + // Prepare column, position and node clipping rectangle. + PaintInfo.CellRect := R; + if UseColumns then + InitializeFirstColumnValues(PaintInfo); + + // Now go through all visible columns (there's still one run if columns aren't used). + with TVirtualTreeColumnsCracker(FHeader.Columns) do + begin + while ((PaintInfo.Column > InvalidColumn) or not UseColumns) + and (PaintInfo.CellRect.Left < Window.Right) do + begin + if UseColumns then + begin + PaintInfo.Column := PositionToIndex[PaintInfo.Position]; + if FirstColumn = InvalidColumn then + FirstColumn := PaintInfo.Column; + PaintInfo.BidiMode := Items[PaintInfo.Column].BiDiMode; + PaintInfo.Alignment := Items[PaintInfo.Column].Alignment; + end + else + begin + PaintInfo.Column := NoColumn; + PaintInfo.BidiMode := BidiMode; + PaintInfo.Alignment := FAlignment; + end; + GetOffSets(PaintInfo.Node, PaintInfo.Offsets, TVTElement.ofsText, PaintInfo.Column); + + PaintInfo.PaintOptions := PaintOptions; + with PaintInfo do + begin + if (tsEditing in FStates) and (Node = FFocusedNode) and + ((Column = FEditColumn) or not UseColumns) then + Exclude(PaintOptions, poDrawSelection); + if not UseColumns or + ((vsSelected in Node.States) and (toFullRowSelect in FOptions.SelectionOptions) and + (poDrawSelection in PaintOptions)) or + (coParentColor in Items[PaintInfo.Column].Options) or + ((coStyleColor in Items[PaintInfo.Column].Options) and VclStyleEnabled) + then + Exclude(PaintOptions, poColumnColor); + end; + IsMainColumn := PaintInfo.Column = FHeader.MainColumn; + + // Consider bidi mode here. In RTL context means left alignment actually right alignment and vice versa. + if PaintInfo.BidiMode <> bdLeftToRight then + ChangeBiDiModeAlignment(PaintInfo.Alignment); + + // Paint the current cell if it is marked as being visible or columns aren't used and + // if this cell belongs to the main column if only the main column should be drawn. + if (not UseColumns or (coVisible in Items[PaintInfo.Column].Options)) and + (not (poMainOnly in PaintOptions) or IsMainColumn) then + begin + AdjustPaintCellRect(PaintInfo, NextColumn); + + // Paint the cell only if it is in the current window. + if PaintInfo.CellRect.Right > Window.Left then + begin + with PaintInfo do + begin + // Fill in remaining values in the paint info structure. + NodeWidth := DoGetNodeWidth(Node, Column, Canvas); + + if ShowCheckImages and IsMainColumn then + begin + ImageInfo[iiCheck].Index := GetCheckImage(Node); + ImageInfo[iiCheck].Images := FCheckImages; + ImageInfo[iiCheck].Ghosted := False; + end + else + ImageInfo[iiCheck].Index := -1; + GetImageIndex(PaintInfo, ikState, iiState); + GetImageIndex(PaintInfo, ImageKind[vsSelected in Node.States], iiNormal); + + CalculateVerticalAlignments(PaintInfo, ButtonY); + // Take the space for the tree lines into account. + PaintInfo.AdjustImageCoordinates(); + if UseColumns then + begin + ClipRect := CellRect; + if poUnbuffered in PaintOptions then + begin + ClipRect.Left := Max(ClipRect.Left, Window.Left); + ClipRect.Right := Min(ClipRect.Right, Window.Right); + ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); + ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0); + end; + ClipCanvas(Canvas, ClipRect); + end; + + // Paint the horizontal grid line. + if (poGridLines in PaintOptions) and (toShowHorzGridLines in FOptions.PaintOptions) then + begin + Canvas.Font.Color := FColors.GridLineColor; + if IsMainColumn and (FLineMode = lmBands) then + begin + if BidiMode = bdLeftToRight then + begin + 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, LineWidth, IndentSize) * FIndent - 1, CellRect.Bottom - LineWidth); + end; + end + else + DrawGridHLine(PaintInfo, CellRect.Left, CellRect.Right, CellRect.Bottom - LineWidth); + + Dec(CellRect.Bottom); + Dec(ContentRect.Bottom); + end; + + if UseColumns then + begin + ColumnIsFixed := coFixed in FHeader.Columns[Column].Options; + // Paint vertical grid line. + if (poGridLines in PaintOptions) and (toShowVertGridLines in FOptions.PaintOptions) then + begin + // These variables and the nested if conditions shall make the logic + // easier to understand. + CellIsTouchingClientRight := PaintInfo.CellRect.Right = ClientRect.Right; + CellIsInLastColumn := Position = TColumnPosition(Count - 1); + + // Don't draw if this is the last column and the header is in autosize mode. + if not ((hoAutoResize in FHeader.Options) and CellIsInLastColumn) then + begin + // We have to take spanned cells into account which we determine + // by checking if CellRect.Right equals the Window.Right. + // But since the PaintTree procedure is called twice in + // TBaseVirtualTree.Paint (i.e. for fixed columns and other columns. + // CellIsTouchingClientRight does not work for fixed columns.) + // we have to paint fixed column grid line anyway. + if not CellIsTouchingClientRight or ColumnIsFixed then + begin + if (BidiMode = bdLeftToRight) or not ColumnIsEmpty(Node, Column) then + begin + DrawGridVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - LineWidth, ColumnIsFixed and (NextColumn >= 0)); + end; + + Dec(CellRect.Right); + end; + end; + // Reduce the content rect size nonetheless to retain correct alignment + // relative to header content (especially if "PaintInfo.Alignment = alRightJustify"). + Dec(ContentRect.Right); + end// if poGridLines + else + begin + if ColumnIsFixed then + begin + if (BidiMode = bdLeftToRight) or not ColumnIsEmpty(Node, Column) then + begin + DrawGridVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - LineWidth, ColumnIsFixed and (NextColumn >= 0)); + end; + Dec(CellRect.Right); + end; + end//else + end; + + // Prepare background and focus rect for the current cell. + PrepareCell(PaintInfo, Window.Left, PaintWidth); + + // Some parts are only drawn for the main column. + if IsMainColumn then + begin + if (toShowTreeLines in FOptions.PaintOptions) and + (not (toHideTreeLinesIfThemed in FOptions.PaintOptions) or + not (tsUseThemes in FStates)) then + PaintTreeLines(PaintInfo, IfThen(toFixedIndent in FOptions.PaintOptions, 1, + IndentSize), LineImage); + // Show node button if allowed, if there child nodes and at least one of the child + // nodes is visible or auto button hiding is disabled. + if (toShowButtons in FOptions.PaintOptions) and (vsHasChildren in Node.States) and + not ((vsAllChildrenHidden in Node.States) and + (toAutoHideButtons in TreeOptions.AutoOptions)) and + ((toShowRoot in TreeOptions.PaintOptions) or (GetNodeLevel(Node) > 0)) + then + PaintNodeButton(Canvas, Node, Column, CellRect, Offsets[ofsToggleButton], ButtonY, BidiMode); // Relative X position of toggle button is needed for proper BiDi calculation + + if ImageInfo[iiCheck].Index > -1 then + PaintCheckImage(Canvas, PaintInfo.ImageInfo[iiCheck], vsSelected in PaintInfo.Node.States); + end; + + if ImageInfo[iiState].Index > -1 then + PaintImage(PaintInfo, iiState, False); + if ImageInfo[iiNormal].Index > -1 then + PaintImage(PaintInfo, iiNormal, True); + + // Now let descendants or applications draw whatever they want, + // but don't draw the node if it is currently being edited. + if not ((tsEditing in FStates) and (Node = FFocusedNode) and + ((Column = FEditColumn) or not UseColumns)) then + DoPaintNode(PaintInfo); + + DoAfterCellPaint(Canvas, Node, Column, CellRect); + end; + end; + + // leave after first run if columns aren't used + if not UseColumns then + Break; + end + else + NextColumn := GetNextVisibleColumn(PaintInfo.Column); + + SelectClipRgn(PaintInfo.Canvas.Handle, 0); + // Stop column loop if there are no further columns in the given window. + if (PaintInfo.CellRect.Left >= Window.Right) or (NextColumn = InvalidColumn) then + Break; + + // Move on to next column which might not be the one immediately following the current one + // because of auto span feature. + PaintInfo.Position := Items[NextColumn].Position; + + // Move clip rectangle and continue. + if coVisible in Items[NextColumn].Options then + with PaintInfo do + begin + TVirtualTreeColumnCracker(Items[NextColumn]).GetAbsoluteBounds(CellRect.Left, CellRect.Right); + CellRect.Bottom := Node.NodeHeight; + ContentRect.Bottom := Node.NodeHeight; + end; + end; + end; + + // This node is finished, notify descendants/application. + with PaintInfo do + begin + DoAfterItemPaint(Canvas, Node, R); + + // Final touch for this node: mark it if it is the current drop target node. + if (Node = FDropTargetNode) and (toShowDropmark in FOptions.PaintOptions) and + (poDrawDropMark in PaintOptions) then + DoPaintDropMark(Canvas, Node, R); + end; + end; // if not DoBeforeItemPaint() (no custom drawing) + + + with PaintInfo.Canvas do + begin + if DrawSelectionRect then + begin + PaintSelectionRectangle(PaintInfo.Canvas, Window.Left, SelectionRect, Rect(0, 0, PaintWidth, + CurrentNodeHeight)); + end; + + // Put the constructed node image onto the target canvas. + if not (poUnbuffered in PaintOptions) then + with NodeBitmap do + BitBlt(TargetCanvas.Handle, TargetRect.Left, TargetRect.Top, TargetRect.Width, TargetRect.Height, Canvas.Handle, Window.Left, 0, SRCCOPY); + end; + end; + + Inc(TargetRect.Top, PaintInfo.Node.NodeHeight); + if TargetRect.Top >= MaximumBottom then + Break; + + // Keep selection rectangle coordinates in sync. + if DrawSelectionRect then + OffsetRect(SelectionRect, 0, -PaintInfo.Node.NodeHeight); + + // Advance to next visible node. + PaintInfo.Node := GetNextVisible(PaintInfo.Node, True); + end; + end; + + // Erase rest of window not covered by a node. + if TargetRect.Top < MaximumBottom then + begin + // Keep the horizontal target position to determine the selection rectangle offset later (if necessary). + BaseOffset := Target.X; + Target := TargetRect.TopLeft; + R := Rect(TargetRect.Left, 0, TargetRect.Left, MaximumBottom - Target.Y); + TargetRect := Rect(0, 0, MaximumRight - Target.X, MaximumBottom - Target.Y); + + if not (poUnbuffered in PaintOptions) then + begin + // Avoid unnecessary copying of bitmap content. This will destroy the DC handle too. + NodeBitmap.Height := 0; + NodeBitmap.PixelFormat := pf32Bit; + NodeBitmap.SetSize(TargetRect.Right - TargetRect.Left, TargetRect.Bottom - TargetRect.Top); + end; + + // Call back application/descendants whether they want to erase this area. + if not DoPaintBackground(PaintInfo.Canvas, TargetRect) then + begin + if UseBackground then + begin + SetCanvasOrigin(PaintInfo.Canvas, 0, 0); + if toStaticBackground in TreeOptions.PaintOptions then + StaticBackground(FBackground, PaintInfo.Canvas, Target, TargetRect, FColors.BackGroundColor) + else + TileBackground(FBackground, PaintInfo.Canvas, Target, TargetRect, FColors.BackGroundColor); + end + else + begin + // Consider here also colors of the columns. + SetCanvasOrigin(PaintInfo.Canvas, Target.X, 0); // This line caused issue #313 when it was placed above the if-statement + if UseColumns then + begin + with FHeader.Columns do + begin + // If there is no content in the tree then the first column has not yet been determined. + if FirstColumn = InvalidColumn then + begin + FirstColumn := GetFirstVisibleColumn; + repeat + if FirstColumn <> InvalidColumn then + begin + R.Left := Items[FirstColumn].Left; + R.Right := R.Left + Items[FirstColumn].Width; + if R.Right > TargetRect.Left then + Break; + FirstColumn := GetNextVisibleColumn(FirstColumn); + end; + until FirstColumn = InvalidColumn; + end + else + begin + R.Left := Items[FirstColumn].Left; + R.Right := R.Left + Items[FirstColumn].Width; + end; + + // Initialize MaxRight. + MaxRight := Target.X - 1; + + PaintInfo.Canvas.Font.Color := FColors.GridLineColor; + while (FirstColumn <> InvalidColumn) and (MaxRight < TargetRect.Right + Target.X) do + begin + // Determine left and right coordinate of the current column + ColLeft := Items[FirstColumn].Left; + ColRight := (ColLeft + Items[FirstColumn].Width); + + // Check wether this column needs to be painted at all. + if (ColRight >= MaxRight) then + begin + R.Left := MaxRight; // Continue where we left off + R.Right := ColRight; // Paint to the right of the column + MaxRight := ColRight; // And record were to start the next column. + + if (poGridLines in PaintOptions) and + (toFullVertGridLines in FOptions.PaintOptions) and + (toShowVertGridLines in FOptions.PaintOptions) and + (not (hoAutoResize in FHeader.Options) or (Cardinal(FirstColumn) < TColumnPosition(Count - 1))) then + begin + DrawGridVLine(PaintInfo, R.Top, R.Bottom, R.Right - 1); + Dec(R.Right); + end; + + if not (coParentColor in Items[FirstColumn].Options) then + PaintInfo.Canvas.Brush.Color := Items[FirstColumn].Color + else + PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; + PaintInfo.Canvas.FillRect(R); + end; + FirstColumn := GetNextVisibleColumn(FirstColumn); + end; + + // Erase also the part of the tree not covert by a column. + if R.Right < TargetRect.Right + Target.X then + begin + R.Left := R.Right; + R.Right := TargetRect.Right + Target.X; + // Prevent erasing the last vertical grid line. + if (poGridLines in PaintOptions) and + (toFullVertGridLines in FOptions.PaintOptions) and (toShowVertGridLines in FOptions.PaintOptions) and + (not (hoAutoResize in FHeader.Options)) then + Inc(R.Left); + PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; + PaintInfo.Canvas.FillRect(R); + end; + end; + SetCanvasOrigin(PaintInfo.Canvas, 0, 0); + end + else + begin + // No columns nor bitmap background. Simply erase it with the tree color. + SetCanvasOrigin(PaintInfo.Canvas, 0, 0); + PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; + PaintInfo.Canvas.FillRect(TargetRect); + end; + end; + end; + SetCanvasOrigin(PaintInfo.Canvas, 0, 0); + + if DrawSelectionRect then + begin + R := OrderRect(FNewSelRect); + // Remap the selection rectangle to the current window of the tree. + // Since Target has been used for other tasks BaseOffset got the left extent of the target position here. + OffsetRect(R, -Target.X + BaseOffset - Window.Left, -Target.Y + FOffsetY); + SetBrushOrigin(PaintInfo.Canvas, 0, Target.X and 1); + PaintSelectionRectangle(PaintInfo.Canvas, 0, R, TargetRect); + end; + + if not (poUnBuffered in PaintOptions) then + with Target, NodeBitmap do + BitBlt(TargetCanvas.Handle, X, Y, Width, Height, Canvas.Handle, 0, 0, SRCCOPY); + end; + finally + PaintInfo.Canvas.Unlock; + if poUnbuffered in PaintOptions then + RestoreDC(TargetCanvas.Handle, SavedTargetDC) + else + NodeBitmap.Free; + end;//try..finally + + if (FEmptyListMessage <> '') and ((ChildCount[nil] = 0) or (GetFirstVisible = nil)) then + begin + // output a message if no items are to display + Canvas.Font := Self.Font; + Canvas.Font.Size := Round(Canvas.Font.Size * 1.25); // Use slightly larger font to attract awareness of user, there is enough space ince the list is empty. + SetBkMode(TargetCanvas.Handle, TRANSPARENT); + lEmptyListTextMargin := ScaledPixels(Max(cDefaultTextMargin, Self.TextMargin) * 2); // Since the list is empty and the font is slightly larger make sure text id not too close at the edges so that it looks good. + R.Left := OffSetX + lEmptyListTextMargin; + R.Top := lEmptyListTextMargin; + R.Right := R.Left + Width - lEmptyListTextMargin; + R.Bottom := Height - lEmptyListTextMargin; + TargetCanvas.Font.Color := StyleServices.GetStyleFontColor(TStyleFont.sfTreeItemTextDisabled);//clGrayText; + TargetCanvas.TextRect(R, FEmptyListMessage, [tfNoClip, tfLeft, tfWordBreak, tfExpandTabs]); + end; + + DoAfterPaint(TargetCanvas); + finally + DoStateChange([], [tsPainting]); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: TVTDragDataObject); + +// Initiates an image drag operation. HotSpot is the position of the mouse in client coordinates. + +var + PaintOptions: TVTInternalPaintOptions; + TreeRect, + PaintRect: TRect; + LocalSpot, + PaintTarget: TPoint; + lDragImage: TVTDragImage; // drag image management + Image: TBitmap; + +begin + if CanShowDragImage then + begin + lDragImage := TVTDragImage.Create(Self); + try + // Determine the drag rectangle which is a square around the hot spot. Operate in virtual tree space. + LocalSpot := HotSpot; + Dec(LocalSpot.X, -FEffectiveOffsetX); + Dec(LocalSpot.Y, FOffsetY); + TreeRect := Rect(LocalSpot.X - FDragWidth div 2, LocalSpot.Y - FDragHeight div 2, LocalSpot.X + FDragWidth div 2, + LocalSpot.Y + FDragHeight div 2); + + // Check that we have a valid rectangle. + PaintRect := TreeRect; + if TreeRect.Left < 0 then + begin + PaintTarget.X := -TreeRect.Left; + PaintRect.Left := 0; + end + else + PaintTarget.X := 0; + if TreeRect.Top < 0 then + begin + PaintTarget.Y := -TreeRect.Top; + PaintRect.Top := 0; + end + else + PaintTarget.Y := 0; + + Image := TBitmap.Create; + with Image do + try + PixelFormat := pf32Bit; + SetSize(TreeRect.Right - TreeRect.Left, TreeRect.Bottom - TreeRect.Top); + // Erase the entire image with the color key value, for the case not everything + // in the image is covered by the tree image. + Canvas.Brush.Color := FColors.BackGroundColor; + Canvas.FillRect(Rect(0, 0, Width, Height)); + + PaintOptions := [poDrawSelection, poSelectedOnly]; + if FDragImageKind = diMainColumnOnly then + Include(PaintOptions, poMainOnly); + PaintTree(Image.Canvas, PaintRect, PaintTarget, PaintOptions); + + // Once we have got the drag image we can convert all necessary coordinates into screen space. + OffsetRect(TreeRect, -FEffectiveOffsetX, FOffsetY); + HotSpot.X := Width div 2; + HotSpot.Y := Height div 2; + + lDragImage.PrepareDrag(Image, HotSpot, DataObject, FColors.BackGroundColor); + finally + Image.Free; + end; + finally + lDragImage.Free; + end; // try..finally + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.Print(Printer: TPrinter; PrintHeader: Boolean); + +var + SaveTreeFont: TFont; // Remembers the tree's current font. + SaveHeaderFont: TFont; // Remembers the header's current font. + ImgRect, // Describes the dimensions of Image. + TreeRect, // The total VTree dimensions. + DestRect, // Dimensions of PrinterImage. + SrcRect: TRect; // Clip dimensions from Image -> PrinterImage + P: TPoint; // Used by PaintTree. + Options: TVTInternalPaintOptions; // Used by PaintTree. + Image, // Complete Tree is drawn to this image. + PrinterImage: TBitmap; // This is the image that gets printed. + SaveColor: TColor; // Remembers the VTree Color. + pTxtHeight, // Height of font in the TPrinter.Canvas + vTxtHeight, // Height of font in the VTree Canvas + vPageWidth, + vPageHeight, // Printer height in VTree resolution + xPageNum, yPageNum, // # of pages (except the occasional last one) + xPage, yPage: Integer; // Loop counter + Scale: Extended; // Scale factor between Printer Canvas and VTree Canvas + LogFont: TLogFont; + +begin + if Assigned(Printer) then + begin + BeginUpdate; + + // Grid lines are the only parts which are desirable when printing. + Options := [poGridLines]; + + // Remember the tree font. + SaveTreeFont := TFont.Create; + SaveTreeFont.Assign(Font); + // Create a new font for printing which does not use clear type output (but is antialiased, if possible) + // and which has the highest possible quality. + GetObject(Font.Handle, SizeOf(TLogFont), @LogFont); + LogFont.lfQuality := ANTIALIASED_QUALITY; + Font.Handle := CreateFontIndirect(LogFont); + + // Create an image that will hold the complete VTree + Image := TBitmap.Create; + Image.PixelFormat := pf32Bit; + PrinterImage := nil; + try + TreeRect := GetTreeRect; + + Image.Width := TreeRect.Right - TreeRect.Left; + P := Point(0, 0); + if (hoVisible in FHeader.Options) and PrintHeader then + begin + Inc(TreeRect.Bottom, FHeader.Height); + Inc(P.Y, FHeader.Height); + end; + Image.Height := TreeRect.Bottom - TreeRect.Top; + + ImgRect.Left := 0; + ImgRect.Top := 0; + ImgRect.Right := Image.Width; + + // Force the background to white color during the rendering. + SaveColor := FColors.BackGroundColor; + Color := clWhite; + // Print header if it is visible. + if (hoVisible in FHeader.Options) and PrintHeader then + begin + SaveHeaderFont := TFont.Create; + try + SaveHeaderFont.Assign(FHeader.Font); + // Create a new font for printing which does not use clear type output (but is antialiased, if possible) + // and which has the highest possible quality. + GetObject(FHeader.Font.Handle, SizeOf(TLogFont), @LogFont); + LogFont.lfQuality := ANTIALIASED_QUALITY; + FHeader.Font.Handle := CreateFontIndirect(LogFont); + ImgRect.Bottom := FHeader.Height; + FHeader.Columns.PaintHeader(Image.Canvas.Handle, ImgRect, 0); + FHeader.Font := SaveHeaderFont; + finally + SaveHeaderFont.Free; + end; + end; + // The image's height is already adjusted for the header if it is visible. + ImgRect.Bottom := Image.Height; + + PaintTree(Image.Canvas, ImgRect, P, Options, pf32Bit); + Color := SaveColor; + + // Activate the printer + Printer.BeginDoc; + Printer.Canvas.Font := Font; + + // Now we can calculate the scaling : + pTxtHeight := Printer.Canvas.TextHeight('Tj'); + vTxtHeight := Canvas.TextHeight('Tj'); + + Scale := pTxtHeight / vTxtHeight; + + // Create an Image that has the same dimensions as the printer canvas but + // scaled to the VTree resolution: + PrinterImage := TBitmap.Create; + + vPageHeight := Round(Printer.PageHeight / Scale); + vPageWidth := Round(Printer.PageWidth / Scale); + + // We do a minumum of one page. + xPageNum := Trunc(Image.Width / vPageWidth); + yPageNum := Trunc(Image.Height / vPageHeight); + + PrinterImage.SetSize(vPageWidth, vPageHeight); + + // Split vertically: + for yPage := 0 to yPageNum do + begin + DestRect.Left := 0; + DestRect.Top := 0; + DestRect.Right := PrinterImage.Width; + DestRect.Bottom := PrinterImage.Height; + + // Split horizontally: + for xPage := 0 to xPageNum do + begin + SrcRect.Left := vPageWidth * xPage; + SrcRect.Top := vPageHeight * yPage; + SrcRect.Right := vPageWidth * xPage + PrinterImage.Width; + SrcRect.Bottom := SrcRect.Top + vPageHeight; + + // Clear the image + PrinterImage.Canvas.Brush.Color := clWhite; + PrinterImage.Canvas.FillRect(Rect(0, 0, PrinterImage.Width, PrinterImage.Height)); + PrinterImage.Canvas.CopyRect(DestRect, Image.Canvas, SrcRect); + PrtStretchDrawDIB(Printer.Canvas, Rect(0, 0, Printer.PageWidth, Printer.PageHeight - 1), PrinterImage); + if xPage <> xPageNum then + Printer.NewPage; + end; + if yPage <> yPageNum then + Printer.NewPage; + end; + + // Restore tree font. + Font := SaveTreeFont; + SaveTreeFont.Free; + Printer.EndDoc; + finally + PrinterImage.Free; + Image.Free; + EndUpdate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ProcessDrop(const DataObject: TVTDragDataObject; TargetNode: PVirtualNode; var Effect: Integer; + Mode: TVTNodeAttachMode): Boolean; + +// Recreates the (sub) tree structure serialized into memory and provided by DataObject. The new nodes are attached to +// the passed node or FRoot if TargetNode is nil. +// Returns True on success, i.e. the CF_VIRTUALTREE format is supported by the data object and the structure could be +// recreated, otherwise False. + +var + Source: TBaseVirtualTree; + +begin + Result := False; + if Mode = amNoWhere then + Effect := DROPEFFECT_NONE + else + begin + BeginUpdate; + // try to get the source tree of the operation + Source := TVTDragManager.GetTreeFromDataObject(DataObject); + if Assigned(Source) then + Source.BeginUpdate; + try + try + // Before adding the new nodes try to optimize the operation if source and target tree reside in + // the same application and operation is a move. + if ((Effect and DROPEFFECT_MOVE) <> 0) and Assigned(Source) then + begin + // If both copy and move are specified then prefer a copy because this is not destructing. + Result := ProcessOLEData(Source, DataObject, TargetNode, Mode, (Effect and DROPEFFECT_COPY) = 0); + // Since we made an optimized move or a copy there's no reason to act further after DoDragging returns. + Effect := DROPEFFECT_NONE; + end + else + // Act only if move or copy operation is requested. + if (Effect and (DROPEFFECT_MOVE or DROPEFFECT_COPY)) <> 0 then + Result := ProcessOLEData(Source, DataObject, TargetNode, Mode, False) + else + Result := False; + except + Effect := DROPEFFECT_NONE; + end; + finally + if Assigned(Source) then + Source.EndUpdate; + EndUpdate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +type + // needed to handle OLE global memory objects + TOLEMemoryStream = class(TCustomMemoryStream) + public + function Write(const Buffer; Count: Integer): Integer; override; + end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TOLEMemoryStream.Write(const Buffer; Count: Integer): Integer; + +begin + raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError)); +end; + +//----------------- TBaseVirtualTree ----------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoDrawHint(Canvas: TCanvas; Node: PVirtualNode; R: + TRect; Column: TColumnIndex); + +begin + if Assigned(FOnDrawHint) then + FOnDrawHint(Self, Canvas, Node, R, Column); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoGetHintSize(Node: PVirtualNode; Column: + TColumnIndex; var R: TRect); + +begin + if Assigned(FOnGetHintSize) then + FOnGetHintSize(Self, Node, Column, R); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.DoGetHintKind(Node: PVirtualNode; Column: + TColumnIndex; var Kind: TVTHintKind); + +begin + if Assigned(FOnGetHintKind) then + FOnGetHintKind(Self, Node, Column, Kind) + else + Kind := DefaultHintKind; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.GetDefaultHintKind: TVTHintKind; + +begin + Result := vhkText; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ProcessOLEData(Source: TBaseVirtualTree; const DataObject: IDataObject; TargetNode: PVirtualNode; + Mode: TVTNodeAttachMode; Optimized: Boolean): Boolean; + +// Recreates the (sub) tree structure serialized into memory and provided by DataObject. The new nodes are attached to +// the passed node or FRoot if TargetNode is nil according to Mode. Optimized can be set to True if the entire operation +// happens within the same process (i.e. sender and receiver of the OLE operation are located in the same process). +// Optimize = True makes only sense if the operation to carry out is a move hence it is also the indication of the +// operation to be done here. Source is the source of the OLE data and only of use (and usually assigned) when +// an OLE operation takes place in the same application. +// Returns True on success, i.e. the CF_VIRTUALTREE format is supported by the data object and the structure could be +// recreated, otherwise False. + +var + Medium: TStgMedium; + Stream: TStream; + Data: Pointer; + Node: PVirtualNode; + Nodes: TNodeArray; + I: Integer; + Res: HRESULT; + ChangeReason: TChangeReason; + +begin + Nodes := nil; + // Check the data format available by the data object. + with StandardOLEFormat do + begin + // Read best format. + cfFormat := CF_VIRTUALTREE; + end; + Result := DataObject.QueryGetData(StandardOLEFormat) = S_OK; + if Result and not (toReadOnly in FOptions.MiscOptions) then + begin + BeginUpdate; + Result := False; + try + if TargetNode = nil then + TargetNode := FRoot; + if TargetNode = FRoot then + begin + case Mode of + amInsertBefore: + Mode := amAddChildFirst; + amInsertAfter: + Mode := amAddChildLast; + end; + end; + + // Optimized means source is known and in the same process so we can access its pointers, which avoids duplicating + // the data while doing a serialization. Can only be used with cut'n paste and drag'n drop with move effect. + if Optimized then + begin + if tsOLEDragging in Source.FStates then + Nodes := Source.FDragSelection + else + Nodes := Source.GetSortedCutCopySet(True); + + if Mode in [amInsertBefore,amAddChildLast] then + begin + for I := 0 to High(Nodes) do + if not HasAsParent(TargetNode, Nodes[I]) then + Source.MoveTo(Nodes[I], TargetNode, Mode, False); + end + else + begin + for I := High(Nodes) downto 0 do + if not HasAsParent(TargetNode, Nodes[I]) then + Source.MoveTo(Nodes[I], TargetNode, Mode, False); + end; + Result := True; + end + else + begin + if Source = Self then + ChangeReason := crNodeCopied + else + ChangeReason := crNodeAdded; + Res := DataObject.GetData(StandardOLEFormat, Medium); + if Res = S_OK then + begin + case Medium.tymed of + TYMED_ISTREAM, // IStream interface + TYMED_HGLOBAL: // global memory block + begin + Stream := nil; + if Medium.tymed = TYMED_ISTREAM then + Stream := TOLEStream.Create(IUnknown(Medium.stm) as IStream) + else + begin + Data := GlobalLock(Medium.hGlobal); + if Assigned(Data) then + begin + // Get the total size of data to retrieve. + I := PCardinal(Data)^; + Inc(PCardinal(Data)); + Stream := TOLEMemoryStream.Create; + TOLEMemoryStream(Stream).SetPointer(Data, I); + end; + end; + + if Assigned(Stream) then + try + while Stream.Position < Stream.Size do + begin + Node := MakeNewNode; + InternalConnectNode(Node, TargetNode, Self, Mode); + InternalAddFromStream(Stream, VTTreeStreamVersion, Node); + // This seems a bit strange because of the callback for granting to add the node + // which actually comes after the node has been added. The reason is that the node must + // contain valid data otherwise I don't see how the application can make a funded decision. + if not DoNodeCopying(Node, TargetNode) then + begin + DeleteNode(Node); + end + else + begin + DoNodeCopied(Node); + StructureChange(Node, ChangeReason); + // In order to maintain the same node order when restoring nodes in the case of amInsertAfter + // we have to move the reference node continously. Othwise we would end up with reversed node order. + if Mode = amInsertAfter then + TargetNode := Node; + end; + end; + Result := True; + finally + Stream.Free; + if Medium.tymed = TYMED_HGLOBAL then + GlobalUnlock(Medium.hGlobal); + end; + end; + end; + ReleaseStgMedium(Medium); + end; + end; + finally + EndUpdate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ReinitChildren(Node: PVirtualNode; Recursive: + Boolean; ForceReinit: Boolean = False); + +// Forces all child nodes of Node to be reinitialized. +// If Recursive is True then also the grandchildren are reinitialized. + +var + Run: PVirtualNode; + +begin + if Assigned(Node) then + begin + InitChildren(Node); + Run := Node.FirstChild; + end + else + begin + InitChildren(FRoot); + Run := FRoot.FirstChild; + end; + + while Assigned(Run) do + begin + ReinitNode(Run, Recursive, ForceReinit); + Run := Run.NextSibling; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ReinitNode(Node: PVirtualNode; Recursive: Boolean; + ForceReinit: Boolean = False); + +// Reinitializes Node if it has previously been initialized +// If Recursive, initialized children are also re-initialized recursively +// If ForceReinit, Node is always initialized and if Recursive children +// are always re-initialized as well +// InitNode is called with ivsReInit in InitialStates, if the Node has already +// been initialized. + +begin + if Assigned(Node) and (Node <> FRoot) then + begin + // Remove dynamic styles. + Node.States := Node.States - [vsChecking, vsCutOrCopy, vsDeleting, vsHeightMeasured]; + if (vsInitialized in Node.States) or ForceReinit then + InitNode(Node); + end + else if not Assigned(Node) then + Node := FRoot; + + // Prevent previoulsy uninitilaized children from being initialized + // unless ForceReinit is True. Issue #1145 + if Recursive and (ForceReinit or (Node.ChildCount > 0)) then + ReinitChildren(Node, True, ForceReinit); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.RepaintNode(Node: PVirtualNode); + +// Causes an immediate repaint of the given node. + +var + R: Trect; + +begin + if Assigned(Node) and (Node <> FRoot) then + begin + R := GetDisplayRect(Node, NoColumn, False); + RedrawWindow(@R, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE or RDW_VALIDATE or RDW_NOCHILDREN); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ResetNode(Node: PVirtualNode); + +// Deletes all children of the given node and marks it as being uninitialized. + +begin + DoCancelEdit; + if (Node = nil) or (Node = FRoot) then + Clear + else + begin + DoReset(Node); + DeleteChildren(Node); + // Remove initialized and other dynamic styles, keep persistent styles. + Node.States := Node.States - [vsInitialized, vsChecking, vsCutOrCopy, vsDeleting, vsHasChildren, vsExpanded, + vsHeightMeasured]; + InvalidateNode(Node); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SaveToFile(const FileName: TFileName); + +// Saves the entire content of the tree into a file (see further notes in SaveToStream). + +var + FileStream: TFileStream; + +begin + FileStream := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(FileStream); + finally + FileStream.Free; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SaveToStream(Stream: TStream; Node: PVirtualNode = nil); + +// Saves Node and all its children to Stream. If Node is nil then all top level nodes will be stored. +// Note: You should be careful about assuming what is actually saved. The problem here is that we are dealing with +// virtual data. The tree can so not know what it has to save. The only fact we reliably know is the tree's +// structure. To be flexible for future enhancements as well as unknown content (unknown to the tree class which +// is saving/loading the stream) a chunk based approach is used here. Every tree class handles only those +// chunks which are not handled by an anchestor class and are known by the class. +// +// The base tree class saves only the structure of the tree along with application provided data. descendants may +// optionally add their own chunks to store additional information. See: WriteChunks. + +var + Count: Cardinal; + +begin + Stream.Write(MagicID, SizeOf(MagicID)); + if Node = nil then + begin + // Keep number of top level nodes for easy restauration. + Count := FRoot.ChildCount; + Stream.WriteBuffer(Count, SizeOf(Count)); + + // Save entire tree here. + Node := FRoot.FirstChild; + while Assigned(Node) do + begin + WriteNode(Stream, Node); + Node := Node.NextSibling; + end; + end + else + begin + Count := 1; + Stream.WriteBuffer(Count, SizeOf(Count)); + WriteNode(Stream, Node); + end; + if Assigned(FOnSaveTree) then + FOnSaveTree(Self, Stream); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ScrollIntoView(Node: PVirtualNode; Center: Boolean; Horizontally: Boolean = False): Boolean; + +// Scrolls the tree so that the given node is in the client area and returns True if the tree really has been +// scrolled (e.g. to avoid further updates) else returns False. If extened focus is enabled then the tree will also +// be horizontally scrolled if needed. +// Note: All collapsed parents of the node are expanded. + +var + R: TRect; + Run: PVirtualNode; + UseColumns, + HScrollBarVisible: Boolean; + OldOffsetY: TDimension; + ScrolledVertically, + ScrolledHorizontally: Boolean; + +begin + ScrolledVertically := False; + ScrolledHorizontally := False; + + if Assigned(Node) and (Node <> FRoot) and HandleAllocated then // We don't want to create the handle if it has not yet been created, see issue #897 + begin + // Make sure all parents of the node are expanded. + Run := Node.Parent; + while Run <> FRoot do + begin + if not (vsExpanded in Run.States) then + ToggleNode(Run); + Run := Run.Parent; + end; + UseColumns := FHeader.UseColumns; + if UseColumns and FHeader.Columns.IsValidColumn(FFocusedColumn) then + R := GetDisplayRect(Node, FFocusedColumn, not (toGridExtensions in FOptions.MiscOptions)) + else + R := GetDisplayRect(Node, NoColumn, not (toGridExtensions in FOptions.MiscOptions)); + + // The returned rectangle can never be empty after the expand code above. + // 1) scroll vertically + OldOffsetY := FOffsetY; + if R.Top < 0 then + begin + if Center then + SetOffsetY(FOffsetY - R.Top + Divide(ClientHeight, 2)) + else + SetOffsetY(FOffsetY - R.Top); + end + else + if (R.Bottom > ClientHeight) or Center then + begin + HScrollBarVisible := (ScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssBoth, System.UITypes.TScrollStyle.ssHorizontal]) and + (ScrollBarOptions.AlwaysVisible or (FRangeX > ClientWidth)); + if Center then + SetOffsetY(FOffsetY - R.Bottom + Divide(ClientHeight, 2)) + else + SetOffsetY(FOffsetY - R.Bottom + ClientHeight); + // When scrolling up and the horizontal scroll appears because of the operation + // then we have to move up the node the horizontal scrollbar's height too + // in order to avoid that the scroll bar hides the node which we wanted to have in view. + if not UseColumns and not HScrollBarVisible and (FRangeX > ClientWidth) then + SetOffsetY(FOffsetY - GetSystemMetrics(SM_CYHSCROLL)); + end; + ScrolledVertically := OldOffsetY <> FOffsetY; + + if Horizontally then + // 2) scroll horizontally + // Center only if there is enough space for the focused column, otherwise left align, see issue #397. + ScrolledHorizontally := ScrollIntoView(FFocusedColumn, Center and (R.Width <= (ClientWidth - Header.Columns.GetVisibleFixedWidth)), Node); + end; + + Result := ScrolledVertically or ScrolledHorizontally; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.ScaledPixels(pPixels: TDimension): TDimension; + + /// Returns the given pixels scaled to the current dpi assuming that we designed at 96dpi (100%) +begin + Result := MulDiv(pPixels, {$if CompilerVersion > 31}Self.FCurrentPPI{$else}Screen.PixelsPerInch{$ifend}, 96); +end; + +function TBaseVirtualTree.ScrollIntoView(Column: TColumnIndex; Center: Boolean; Node: PVirtualNode = nil): Boolean; + +// Scrolls the columns so that the given column is in the client area and returns True if the columns really have been +// scrolled (e.g. to avoid further updates) else returns False. + +var + ColumnLeft, + ColumnRight: TDimension; + NewOffset, + OldOffset: TDimension; + R: TRect; + +begin + Result := False; + + if FHeader.UseColumns and FHeader.Columns.IsValidColumn(Column) then begin + ColumnLeft := Header.Columns.Items[Column].Left; + ColumnRight := ColumnLeft + Header.Columns.Items[Column].Width; + end else if Assigned(Node) and (toCenterScrollIntoView in FOptions.SelectionOptions) then begin + Center := False; + R := GetDisplayRect(Node, NoColumn, not (toGridExtensions in FOptions.MiscOptions)); + ColumnLeft := R.Left; + ColumnRight := R.Right; + end else + Exit; + + OldOffset := FOffsetX; + NewOffset := FEffectiveOffsetX; + if not (FHeader.UseColumns and (coFixed in Header.Columns[Column].Options)) and (not Center) then + begin + if ColumnRight > ClientWidth then + NewOffset := FEffectiveOffsetX + Min(ColumnRight - ClientWidth, + - (Header.Columns.GetVisibleFixedWidth - ColumnLeft)) + else if ColumnLeft < Header.Columns.GetVisibleFixedWidth then + NewOffset := FEffectiveOffsetX - (Header.Columns.GetVisibleFixedWidth - ColumnLeft); + if NewOffset <> FEffectiveOffsetX then + begin + if UseRightToLeftAlignment then + SetOffsetX(-FRangeX + ClientWidth + NewOffset) + else + SetOffsetX(-NewOffset); + end; + end + else if Center then + begin + NewOffset := FEffectiveOffsetX + ColumnLeft - Divide(Header.Columns.GetVisibleFixedWidth, 2) - Divide(ClientWidth, 2) + Divide(ColumnRight - ColumnLeft, 2); + if NewOffset <> FEffectiveOffsetX then + begin + if UseRightToLeftAlignment then + SetOffsetX(-FRangeX + ClientWidth + NewOffset) + else + SetOffsetX(-NewOffset); + end; + end; + Result := OldOffset <> FOffsetX; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SelectAll(VisibleOnly: Boolean); + +// Select all nodes in the tree. +// If VisibleOnly is True then only visible nodes are selected. + +var + Run: PVirtualNode; + NextFunction: TGetNextNodeProc; +begin + if not FSelectionLocked and (toMultiSelect in FOptions.SelectionOptions) then + begin + ClearTempCache; + if VisibleOnly then + begin + Run := GetFirstVisible(nil, True); + NextFunction := GetNextVisible; + end + else + begin + Run := GetFirst; + NextFunction := GetNext; + end; + BeginUpdate(); // Improve performance, see issue #690 + try + while Assigned(Run) do + begin + if not(vsSelected in Run.States) then + InternalCacheNode(Run); + Run := NextFunction(Run); + end;//while + if FTempNodeCount > 0 then + AddToSelection(FTempNodeCache, FTempNodeCount); + ClearTempCache; + finally + EndUpdate(); + end;//try..finally + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); + +// Sorts the given node. The application is queried about how to sort via the OnCompareNodes event. +// Column is simply passed to the the compare function so the application can also sort in a particular column. +// In order to free the application from taking care about the sort direction the parameter Direction is used. +// This way the application can always sort in increasing order, while this method reorders nodes according to this flag. + + //--------------- local functions ------------------------------------------- + + function MergeAscending(A, B: PVirtualNode): PVirtualNode; + + // Merges A and B (which both must be sorted via Compare) into one list. + + var + Dummy: TVirtualNode; + CompareResult: Integer; + begin + // This avoids checking for Result = nil in the loops. + Result := @Dummy; + while Assigned(A) and Assigned(B) do + begin + if OperationCanceled then + CompareResult := 0 + else + CompareResult := DoCompare(A, B, Column); + + if CompareResult <= 0 then + begin + Result.SetNextSibling(A); + Result := A; + A := A.NextSibling; + end + else + begin + Result.SetNextSibling(B); + Result := B; + B := B.NextSibling; + end; + end; + + // Just append the list which is not nil (or set end of result list to nil if both lists are nil). + if Assigned(A) then + Result.SetNextSibling(A) + else + Result.SetNextSibling(B); + // return start of the new merged list + Result := Dummy.NextSibling; + end; + + //--------------------------------------------------------------------------- + + function MergeDescending(A, B: PVirtualNode): PVirtualNode; + + // Merges A and B (which both must be sorted via Compare) into one list. + + var + Dummy: TVirtualNode; + CompareResult: Integer; + + begin + // this avoids checking for Result = nil in the loops + Result := @Dummy; + while Assigned(A) and Assigned(B) do + begin + if OperationCanceled then + CompareResult := 0 + else + CompareResult := DoCompare(A, B, Column); + + if CompareResult >= 0 then + begin + Result.SetNextSibling(A); + Result := A; + A := A.NextSibling; + end + else + begin + Result.SetNextSibling(B); + Result := B; + B := B.NextSibling; + end; + end; + + // Just append the list which is not nil (or set end of result list to nil if both lists are nil). + if Assigned(A) then + Result.SetNextSibling(A) + else + Result.SetNextSibling(B); + // Return start of the newly merged list. + Result := Dummy.NextSibling; + end; + + //--------------------------------------------------------------------------- + + function MergeSortAscending(var Node: PVirtualNode; N: Cardinal): PVirtualNode; + + // Sorts the list of nodes given by Node (which must not be nil). + + var + A, B: PVirtualNode; + + begin + if N > 1 then + begin + A := MergeSortAscending(Node, N div 2); + B := MergeSortAscending(Node, (N + 1) div 2); + Result := MergeAscending(A, B); + end + else + begin + Result := Node; + Node := Node.NextSibling; + Result.SetNextSibling(nil); + end; + end; + + //--------------------------------------------------------------------------- + + function MergeSortDescending(var Node: PVirtualNode; N: Cardinal): PVirtualNode; + + // Sorts the list of nodes given by Node (which must not be nil). + + var + A, B: PVirtualNode; + + begin + if N > 1 then + begin + A := MergeSortDescending(Node, N div 2); + B := MergeSortDescending(Node, (N + 1) div 2); + Result := MergeDescending(A, B); + end + else + begin + Result := Node; + Node := Node.NextSibling; + Result.SetNextSibling(nil); + end; + end; + + //--------------- end local functions --------------------------------------- + +var + Run: PVirtualNode; + Index: Cardinal; + +begin + InterruptValidation; + if tsEditPending in FStates then + begin + StopTimer(EditTimer); + DoStateChange([], [tsEditPending]); + end; + + if not (tsEditing in FStates) or DoEndEdit then + begin + if Node = nil then + Node := FRoot; + if vsHasChildren in Node.States then + begin + if (Node.ChildCount = 0) and DoInit then + InitChildren(Node); + // Make sure the children are valid, so they can be sorted at all. + if DoInit and (Node.ChildCount > 0) then + ValidateChildren(Node, False); + // Child count might have changed. + if Node.ChildCount > 1 then + begin + StartOperation(okSortNode); + try + // Sort the linked list, check direction flag only once. + if Direction = sdAscending then + Node.SetFirstChild(MergeSortAscending(Node.FirstChild, Node.ChildCount)) + else + Node.SetFirstChild(MergeSortDescending(Node.FirstChild, Node.ChildCount)); + finally + EndOperation(okSortNode); + end; + // Consolidate the child list finally. + Run := Node.FirstChild; + Run.SetPrevSibling(nil); + Index := 0; + repeat + Run.SetIndex(Index); + System.Inc(Index); + if Run.NextSibling = nil then + Break; + Run.NextSibling.SetPrevSibling(Run); + Run := Run.NextSibling; + until False; + Node.SetLastChild(Run); + + InvalidateCache; + end; + if FUpdateCount = 0 then + begin + ValidateCache; + Invalidate; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.SortTree(Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); + + //--------------- local function -------------------------------------------- + + procedure DoSort(Node: PVirtualNode); + + // Recursively sorts Node and its child nodes. + + var + Run: PVirtualNode; + + begin + Sort(Node, Column, Direction, DoInit); + // Recurse to next level + Run := Node.FirstChild; + while Assigned(Run) and not FOperationCanceled do + begin + if DoInit and not (vsInitialized in Run.States) then + InitNode(Run); + if (vsInitialized in Run.States) and (not (toAutoSort in TreeOptions.AutoOptions) or Expanded[Run]) then // There is no need to sort collapsed branches + DoSort(Run); + Run := Run.NextSibling; + end; + end; + + //--------------- end local function ---------------------------------------- + +begin + if RootNode.TotalCount <= 2 then + Exit;//Nothing to do if there are one or zero nodes. RootNode.TotalCount is 1 if there are no nodes in the treee as the root node counts too here. + + if not Assigned(FRoot.FirstChild) then + Exit; // Sorting should not initialize the root nodes + + // Instead of wrapping the sort using BeginUpdate/EndUpdate simply the update counter + // is modified. Otherwise the EndUpdate call will recurse here. + System.Inc(FUpdateCount); + try + if Column > InvalidColumn then + begin + StartOperation(okSortTree); + try + DoSort(FRoot); + finally + EndOperation(okSortTree); + end; + end; + InvalidateCache; + finally + if FUpdateCount > 0 then + System.Dec(FUpdateCount); + if FUpdateCount = 0 then + begin + ValidateCache; + Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); + +// Changes a node's expand state to the opposite state. + +var + Child, + FirstVisible: PVirtualNode; + HeightDelta, + StepsR1, + StepsR2: TDimension; + Steps: Integer; + TogglingTree, + ChildrenInView, + NeedFullInvalidate, + NeedUpdate, + NodeInView, + PosHoldable, + TotalFit: Boolean; + ToggleData: TToggleAnimationData; + + //--------------- local function -------------------------------------------- + + procedure PrepareAnimation; + + // Prepares ToggleData. + + var + R: TRect; + S: TDimension; + M: TToggleAnimationMode; + + begin + with ToggleData do + begin + Window := Handle; + DC := TControlCanvas.Create; + DC.Control := Self; + + if (toShowBackground in FOptions.PaintOptions) and Assigned(FBackground.Graphic) then + Self.Brush.Style := bsClear + else + begin + Self.Brush.Style := bsSolid; + Self.Brush.Color := FColors.BackGroundColor; + end; + + Brush := Self.Brush; + + if (Mode1 <> tamNoScroll) and (Mode2 <> tamNoScroll) then + begin + if StepsR1 < StepsR2 then + begin + // As the primary rectangle is always R1 we will get a much smoother + // animation if R1 is the one that will be scrolled more. + R := R2; + R2 := R1; + R1 := R; + + M := Mode2; + Mode2 := Mode1; + Mode1 := M; + + S := StepsR2; + StepsR2 := StepsR1; + StepsR1 := S; + end; + ScaleFactor := StepsR2 / StepsR1; + MissedSteps := 0; + end; + + if Mode1 <> tamNoScroll then + Steps := StepsR1 + else + Steps := StepsR2; + end; + end; + + //--------------- end local function ---------------------------------------- + +begin + Assert(Assigned(Node), 'Node must not be nil.'); + + TogglingTree := tsToggling in FStates; + ChildrenInView := False; + HeightDelta := 0; + NeedFullInvalidate := False; + NeedUpdate := False; + NodeInView := False; + PosHoldable := False; + TotalFit := False; + + // We don't need to switch the expand state if the node is being deleted otherwise some + // updates (e.g. visible node count) are done twice with disasterous results). + if [vsDeleting, vsToggling] * Node.States = [] then + begin + try + DoStateChange([tsToggling]); + Include(Node.States, vsToggling); + + if vsExpanded in Node.States then + begin + if DoCollapsing(Node) then + begin + NeedUpdate := True; + + // Calculate the height delta right now as we need it for toChildrenAbove anyway. + HeightDelta := -Node.TotalHeight + NodeHeight[Node]; + if (FUpdateCount = 0) and (toAnimatedToggle in FOptions.AnimationOptions) and not + (tsCollapsing in FStates) then + begin + if tsHint in Self.FStates then + Application.CancelHint; + UpdateWindow(); + + // animated collapsing + with ToggleData do + begin + // Determine the animation behaviour and rectangle. If toChildrenAbove is set, the behaviour is depending + // on the position of the node to be collapsed. + R1 := GetDisplayRect(Node, NoColumn, False); + Mode2 := tamNoScroll; + if toChildrenAbove in FOptions.PaintOptions then + begin + PosHoldable := (FOffsetY + (Node.TotalHeight - NodeHeight[Node])) <= 0; + NodeInView := R1.Top < ClientHeight; + + StepsR1 := 0; + if NodeInView then + begin + if PosHoldable or not (toAdvancedAnimatedToggle in FOptions.AnimationOptions) then + begin + // Scroll the child nodes down. + Mode1 := tamScrollDown; + R1.Bottom := R1.Top; + R1.Top := 0; + StepsR1 := Min(R1.Bottom - R1.Top + 1, Node.TotalHeight - NodeHeight[Node]); + end + else + begin + // The position cannot be kept. So scroll the node up to its future position. + Mode1 := tamScrollUp; + R1.Top := Max(0, R1.Top + HeightDelta); + R1.Bottom := ClientHeight; + StepsR1 := FOffsetY - HeightDelta; + end; + end; + end + else + begin + if (FRangeY + FOffsetY - R1.Bottom + HeightDelta >= ClientHeight - R1.Bottom) or + (FRangeY <= ClientHeight) or (FOffsetY = 0) or not + (toAdvancedAnimatedToggle in FOptions.AnimationOptions) then + begin + // Do a simple scroll up over the child nodes. + Mode1 := tamScrollUp; + Inc(R1.Top, NodeHeight[Node]); + R1.Bottom := ClientHeight; + StepsR1 := Min(R1.Bottom - R1.Top + 1, -HeightDelta); + end + else + begin + // Scroll the node down to its future position. As FOffsetY will change we need to invalidate the + // whole tree. + Mode1 := tamScrollDown; + StepsR1 := Min(-FOffsetY, ClientHeight - FRangeY -FOffsetY - HeightDelta); + R1.Top := 0; + R1.Bottom := Min(ClientHeight, R1.Bottom + Steps); + NeedFullInvalidate := True; + end; + end; + + // No animation necessary if the node is below the current client height. + if R1.Top < ClientHeight then + begin + PrepareAnimation; + try + Animate(Steps, FAnimationDuration, ToggleCallback, @ToggleData); + finally + DC.Free; + end; + end; + end; + end; + + // collapse the node + AdjustTotalHeight(Node, IfThen(IsEffectivelyFiltered[Node], 0, NodeHeight[Node])); + if FullyVisible[Node] then + System.Dec(FVisibleCount, CountVisibleChildren(Node)); + Exclude(Node.States, vsExpanded); + DoCollapsed(Node); + + // Remove child nodes now, if enabled. + if (toAutoFreeOnCollapse in FOptions.AutoOptions) and (Node.ChildCount > 0) then + begin + DeleteChildren(Node); + Include(Node.States, vsHasChildren); + end; + end; + end + else + if DoExpanding(Node) then + begin + NeedUpdate := True; + // expand the node, need to adjust the height + if not (vsInitialized in Node.States) then + InitNode(Node); + if (vsHasChildren in Node.States) and (Node.ChildCount = 0) then + InitChildren(Node); + + // Avoid setting the vsExpanded style if there are no child nodes. + if Node.ChildCount > 0 then + begin + // Iterate through the child nodes without initializing them. We have to determine the entire height. + Child := Node.FirstChild; + repeat + if vsVisible in Child.States then + begin + // Ensure the item height is measured + MeasureItemHeight(Canvas, Child); + + Inc(HeightDelta, Child.TotalHeight); + end; + Child := Child.NextSibling; + until Child = nil; + + // Getting the display rectangle is already done here as it is needed for toChildrenAbove in any case. + if (toChildrenAbove in FOptions.PaintOptions) or (FUpdateCount = 0) then + begin + with ToggleData do + begin + R1 := GetDisplayRect(Node, NoColumn, False); + Mode2 := tamNoScroll; + TotalFit := HeightDelta + NodeHeight[Node] <= ClientHeight; + + if toChildrenAbove in FOptions.PaintOptions then + begin + // The main goal with toChildrenAbove being set is to keep the nodes visual position so the user does + // not get confused. Therefore we need to scroll the view when the expanding is done. + PosHoldable := TotalFit and (FRangeY - ClientHeight >= 0) ; + ChildrenInView := (R1.Top - HeightDelta) >= 0; + NodeInView := R1.Bottom <= ClientHeight; + end + else + begin + PosHoldable := TotalFit; + ChildrenInView := R1.Bottom + HeightDelta <= ClientHeight; + end; + + R1.Bottom := ClientHeight; + end; + end; + + if FUpdateCount = 0 then + begin + // Do animated expanding if enabled. + if (ToggleData.R1.Top < ClientHeight) and ([tsPainting, tsExpanding] * FStates = []) and + (toAnimatedToggle in FOptions.AnimationOptions)then + begin + if tsHint in Self.FStates then + Application.CancelHint; + UpdateWindow(); + + // animated expanding + with ToggleData do + begin + if toChildrenAbove in FOptions.PaintOptions then + begin + // At first check if we hold the position, which is the most common case. + if not (toAdvancedAnimatedToggle in FOptions.AnimationOptions) or + (PosHoldable and ( (NodeInView and ChildrenInView) or not + (toAutoScrollOnExpand in FOptions.AutoOptions) )) then + begin + Mode1 := tamScrollUp; + R1 := Rect(R1.Left, 0, R1.Right, R1.Top); + StepsR1 := Min(HeightDelta, R1.Bottom); + end + else + begin + // If we will not hold the node's visual position we mostly scroll in both directions. + Mode1 := tamScrollDown; + Mode2 := tamScrollUp; + R2 := Rect(R1.Left, 0, R1.Right, R1.Top); + if not (toAutoScrollOnExpand in FOptions.AutoOptions) then + begin + // If we shall not or cannot scroll to the desired extent we calculate the new position (with + // max FOffsetY applied) and animate it that way. + StepsR1 := -FOffsetY - Max(FRangeY + HeightDelta - ClientHeight, 0) + HeightDelta; + if (FRangeY + HeightDelta - ClientHeight) <= 0 then + Mode2 := tamNoScroll + else + StepsR2 := Min(FRangeY + HeightDelta - ClientHeight, R2.Bottom); + end + else + begin + if TotalFit and NodeInView and (FRangeY + HeightDelta > ClientHeight) then + begin + // If the whole subtree will fit into the client area and the node is currently fully visible, + // the first child will be made the top node if possible. + if HeightDelta >= R1.Top then + StepsR1 := Abs(R1.Top - HeightDelta) + else + StepsR1 := ClientHeight - FRangeY; + end + else + if FRangeY + HeightDelta <= ClientHeight then + begin + // We cannot make the first child the top node as we cannot scroll to that extent, + // so we do a simple scroll down. + Mode2 := tamNoScroll; + StepsR1 := HeightDelta; + end + else + // If the subtree does not fit into the client area at once, the expanded node will + // be made the bottom node. + StepsR1 := ClientHeight - R1.Top - NodeHeight[Node]; + + if Mode2 <> tamNoScroll then + begin + if StepsR1 > 0 then + StepsR2 := Min(R1.Top, HeightDelta - StepsR1) + else + begin + // If the node is already at the bottom scrolling is needed. + Mode1 := tamNoScroll; + StepsR2 := Min(HeightDelta, R1.Bottom); + end; + end; + end; + end; + end + else + begin + // toChildrenAbove is not set. + if (PosHoldable and ChildrenInView) or not (toAutoScrollOnExpand in FOptions.AutoOptions) or not + (toAdvancedAnimatedToggle in FOptions.AnimationOptions) or (R1.Top <= 0) then + begin + // If the node will stay at its visual position, do a simple down-scroll. + Mode1 := tamScrollDown; + Inc(R1.Top, NodeHeight[Node]); + StepsR1 := Min(R1.Bottom - R1.Top, HeightDelta); + end + else + begin + // We will not hold the nodes visual position so perform a double scroll. + Mode1 := tamScrollUp; + Mode2 := tamScrollDown; + + R1.Bottom := R1.Top + NodeHeight[Node] + 1; + R1.Top := 0; + R2 := Rect(R1.Left, R1.Bottom, R1.Right, ClientHeight); + + StepsR1 := Min(HeightDelta - (ClientHeight - R2.Top), R1.Bottom - NodeHeight[Node]); + StepsR2 := ClientHeight - R2.Top; + end; + end; + + if ClientHeight >= R1.Top then + begin + PrepareAnimation; + try + Animate(Steps, FAnimationDuration, ToggleCallback, @ToggleData); + finally + DC.Free; + end; + end; + end; + end; + if toAutoSort in FOptions.AutoOptions then + Sort(Node, FHeader.SortColumn, FHeader.SortDirection, False); + end;// if UpdateCount = 0 + + Include(Node.States, vsExpanded); + AdjustTotalHeight(Node, HeightDelta, True); + if FullyVisible[Node] then + System.Inc(FVisibleCount, CountVisibleChildren(Node)); + + DoExpanded(Node); + end; + end; + + if NeedUpdate then + begin + InvalidateCache; + if FUpdateCount = 0 then + begin + ValidateCache; + if Node.ChildCount > 0 then + begin + UpdateRanges; + UpdateScrollBars(True); + if [tsPainting, tsExpanding] * FStates = [] then + begin + if (vsExpanded in Node.States) and ((toAutoScrollOnExpand in FOptions.AutoOptions) or + (toChildrenAbove in FOptions.PaintOptions)) then + begin + if toChildrenAbove in FOptions.PaintOptions then + begin + NeedFullInvalidate := True; + if (PosHoldable and ChildrenInView and NodeInView) or not + (toAutoScrollOnExpand in FOptions.AutoOptions) then + SetOffsetY(FOffsetY - HeightDelta) + else + if TotalFit and NodeInView then + begin + FirstVisible := GetFirstVisible(Node, True); + if Assigned(FirstVisible) then // otherwise there is no visible child at all + SetOffsetY(FOffsetY - GetDisplayRect(FirstVisible, NoColumn, False).Top); + end + else + BottomNode := Node; + end + else + begin + // Scroll as much child nodes into view as possible if the node has been expanded. + if PosHoldable then + NeedFullInvalidate := ScrollIntoView(GetLastVisible(Node, True), False) + else + begin + TopNode := Node; + NeedFullInvalidate := True; + end; + end; + end + else + begin + // If we have collapsed the node or toAutoScrollOnExpand is not set, we try to keep the nodes + // visual position. + if toChildrenAbove in FOptions.PaintOptions then + SetOffsetY(FOffsetY - HeightDelta); + NeedFullInvalidate := True; + end; + end; + + //UpdateScrollBars(True); Moved up + + // Check for automatically scrolled tree. + if NeedFullInvalidate then + Invalidate + else + InvalidateToBottom(Node); + end + else + InvalidateNode(Node); + end + else + begin + UpdateRanges; + UpdateScrollBars(True); + end; + end; + + finally + Exclude(Node.States, vsToggling); + if not TogglingTree then + DoStateChange([], [tsToggling]); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateHorizontalRange; + +begin + if FHeader.UseColumns then + SetRangeX(FHeader.Columns.TotalWidth) + else + SetRangeX(GetMaxRightExtend); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateHorizontalScrollBar(DoRepaint: Boolean); + +var + ScrollInfo: TScrollInfo; + +begin + UpdateHorizontalRange; + + if IsUpdating or not HandleAllocated then + Exit; + + // Adjust effect scroll offset depending on bidi mode. + if UseRightToLeftAlignment then + FEffectiveOffsetX := FRangeX - ClientWidth + FOffsetX + else + FEffectiveOffsetX := -FOffsetX; + + if FScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssHorizontal, System.UITypes.TScrollStyle.ssBoth] then + begin + ZeroMemory (@ScrollInfo, SizeOf(ScrollInfo)); + ScrollInfo.cbSize := SizeOf(ScrollInfo); + ScrollInfo.fMask := SIF_ALL; + GetScrollInfo(SB_HORZ, ScrollInfo); + + if (FRangeX > ClientWidth) or FScrollBarOptions.AlwaysVisible then + begin + DoShowScrollBar(SB_HORZ, True); + + ScrollInfo.nMin := 0; + ScrollInfo.nMax := FRangeX; + ScrollInfo.nPos := FEffectiveOffsetX; + ScrollInfo.nPage := Max(0, ClientWidth + 1); + + ScrollInfo.fMask := SIF_ALL or ScrollMasks[FScrollBarOptions.AlwaysVisible]; + SetScrollInfo(SB_HORZ, ScrollInfo, DoRepaint); // 1 app freeze seen here in TreeSize 8.1.0 after ScaleForPpi() + if DoRepaint then + RedrawWindow(nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698 + end + else + begin + ScrollInfo.nMin := 0; + ScrollInfo.nMax := 0; + ScrollInfo.nPos := 0; + ScrollInfo.nPage := 0; + DoShowScrollBar(SB_HORZ, False); + SetScrollInfo(SB_HORZ, ScrollInfo, False); + end; + + // Since the position is automatically changed if it doesn't meet the range + // we better read the current position back to stay synchronized. + FEffectiveOffsetX := GetScrollPos(SB_HORZ); + if UseRightToLeftAlignment then + SetOffsetX(-FRangeX + ClientWidth + FEffectiveOffsetX) + else + SetOffsetX(-FEffectiveOffsetX); + end + else + begin + DoShowScrollBar(SB_HORZ, False); + + // Reset the current horizontal offset to account for window resize etc. + SetOffsetX(FOffsetX); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateRanges; + +begin + UpdateVerticalRange; + UpdateHorizontalRange; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateScrollBars(DoRepaint: Boolean); + +// adjusts scrollbars to reflect current size and paint offset of the tree + +begin + if HandleAllocated then + begin + UpdateVerticalScrollBar(DoRepaint); + UpdateHorizontalScrollBar(DoRepaint); + Perform(CM_UPDATE_VCLSTYLE_SCROLLBARS,0,0); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateStyleElements; +begin + inherited; + UpdateHeaderRect; + FHeader.Columns.PaintHeader(Canvas, FHeaderRect, Point(0,0)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.UpdateVerticalRange; + +begin + // Total node height includes the height of the invisible root node. + FRangeY := FRoot.TotalHeight - FRoot.NodeHeight + FBottomSpace; +end; + +//---------------------------------------------------------------------------------------------------------------------- + + procedure TBaseVirtualTree.UpdateVerticalScrollBar(DoRepaint: Boolean); + +var + ScrollInfo: TScrollInfo; + +begin + UpdateVerticalRange; + + if (IsUpdating) then + Exit; + Assert(GetCurrentThreadId = MainThreadId, 'UI controls like ' + Classname + ' and its scrollbars should only be manipulated through the main thread.'); + + if FScrollBarOptions.ScrollBars in [TScrollStyle.ssVertical, TScrollStyle.ssBoth] then + begin + ScrollInfo.cbSize := SizeOf(ScrollInfo); + ScrollInfo.fMask := SIF_ALL; + GetScrollInfo(SB_VERT, ScrollInfo); + + if (FRangeY > ClientHeight) or FScrollBarOptions.AlwaysVisible then + begin + DoShowScrollBar(SB_VERT, True); + + ScrollInfo.nMin := 0; + ScrollInfo.nMax := IfThen(FRangeY < MaxInt, FRangeY, MaxInt); // TScrollInfo values are signed 32bit only + ScrollInfo.nPos := -FOffsetY; + ScrollInfo.nPage := Max(0, ClientHeight + 1); + + ScrollInfo.fMask := SIF_ALL or ScrollMasks[FScrollBarOptions.AlwaysVisible]; + SetScrollInfo(SB_VERT, ScrollInfo, DoRepaint); + end + else + begin + ScrollInfo.nMin := 0; + ScrollInfo.nMax := 0; + ScrollInfo.nPos := 0; + ScrollInfo.nPage := 0; + DoShowScrollBar(SB_VERT, False); + SetScrollInfo(SB_VERT, ScrollInfo, False); + end; + + // Since the position is automatically changed if it doesn't meet the range + // we better read the current position back to stay synchronized. + SetOffsetY(-GetScrollPos(SB_VERT)); + end + else + begin + DoShowScrollBar(SB_VERT, False); + + // Reset the current vertical offset to account for window resize etc. + SetOffsetY(FOffsetY); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.UseRightToLeftReading: Boolean; + +// The tree can handle right-to-left reading also on non-middle-east systems, so we cannot use the same function as +// it is implemented in TControl. + +begin + Result := BiDiMode <> bdLeftToRight; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ValidateChildren(Node: PVirtualNode; Recursive: Boolean); + +// Ensures that the children of the given node (and all their children, if Recursive is True) are initialized. +// Node must already be initialized + +var + Child: PVirtualNode; + +begin + if Node = nil then + Node := FRoot; + + if (vsHasChildren in Node.States) and (Node.ChildCount = 0) then + InitChildren(Node); + Child := Node.FirstChild; + while Assigned(Child) do + begin + ValidateNode(Child, Recursive); + Child := Child.NextSibling; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseVirtualTree.ValidateNode(Node: PVirtualNode; Recursive: Boolean); + +// Ensures that the given node (and all its children, if Recursive is True) are initialized. + +var + Child: PVirtualNode; + +begin + if Node = nil then + Node := FRoot + else + if not (vsInitialized in Node.States) then + InitNode(Node); + + if Recursive then + begin + if (vsHasChildren in Node.States) and (Node.ChildCount = 0) then + InitChildren(Node); + Child := Node.FirstChild; + while Assigned(Child) do + begin + ValidateNode(Child, Recursive); + Child := Child.NextSibling; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +initialization + +finalization + FinalizeGlobalStructures(); + +end. diff --git a/Source/VirtualTrees.Classes.pas b/Source/VirtualTrees.Classes.pas index c8284e980..856f28c4f 100644 --- a/Source/VirtualTrees.Classes.pas +++ b/Source/VirtualTrees.Classes.pas @@ -1,213 +1,213 @@ -unit VirtualTrees.Classes; - -// The contents of this file are subject to the Mozilla Public License -// Version 1.1 (the "License"); you may not use this file except in compliance -// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ -// -// Alternatively, you may redistribute this library, use and/or modify it under the terms of the -// GNU Lesser General Public License as published by the Free Software Foundation; -// either version 2.1 of the License, or (at your option) any later version. -// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/. -// -// Software distributed under the License is distributed on an "AS IS" basis, -// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the -// specific language governing rights and limitations under the License. -// -// The original code is VirtualTrees.pas, released September 30, 2000. -// -// The initial developer of the original code is digital publishing AG (Munich, Germany, www.digitalpublishing.de), -// written by Mike Lischke (public@soft-gems.net, www.soft-gems.net). -// -// Portions created by digital publishing AG are Copyright -// (C) 1999-2001 digital publishing AG. All Rights Reserved. -//---------------------------------------------------------------------------------------------------------------------- - -interface - -{$WARN UNSAFE_TYPE OFF} -{$WARN UNSAFE_CAST OFF} -{$WARN UNSAFE_CODE OFF} - -uses - Winapi.Windows; - -type - // Helper classes to speed up rendering text formats for clipboard and drag'n drop transfers. - TBufferedRawByteString = class - private - FStart, - FPosition, - FEnd: PAnsiChar; - function GetAsString: RawByteString; - public - destructor Destroy; override; - - procedure Add(const S: RawByteString); - procedure AddNewLine; - - property AsString: RawByteString read GetAsString; - end; - - TBufferedString = class - private - FStart, - FPosition, - FEnd: PWideChar; - function GetAsString: string; - public - destructor Destroy; override; - - procedure Add(const S: string); - procedure AddNewLine; - - property AsString: string read GetAsString; - end; - - -implementation - -//----------------- TBufferedRawByteString ------------------------------------------------------------------------------------ - -const - AllocIncrement = 2 shl 11; // Must be a power of 2. - -destructor TBufferedRawByteString.Destroy; - -begin - FreeMem(FStart); - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBufferedRawByteString.GetAsString: RawByteString; - -begin - SetString(Result, FStart, FPosition - FStart); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBufferedRawByteString.Add(const S: RawByteString); - -var - NewLen, - LastOffset, - Len: NativeInt; - -begin - Len := Length(S); - // Make room for the new string. - if FEnd - FPosition <= Len then - begin - // Round up NewLen so it is always a multiple of AllocIncrement. - NewLen := FEnd - FStart + (Len + AllocIncrement - 1) and not (AllocIncrement - 1); - // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. - LastOffset := FPosition - FStart; - ReallocMem(FStart, NewLen); - FPosition := FStart + LastOffset; - FEnd := FStart + NewLen; - end; - Move(PAnsiChar(S)^, FPosition^, Len); - Inc(FPosition, Len); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBufferedRawByteString.AddNewLine; - -var - NewLen, - LastOffset: NativeInt; - -begin - // Make room for the CR/LF characters. - if FEnd - FPosition <= 2 then - begin - // Round up NewLen so it is always a multiple of AllocIncrement. - NewLen := FEnd - FStart + (2 + AllocIncrement - 1) and not (AllocIncrement - 1); - // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. - LastOffset := FPosition - FStart; - ReallocMem(FStart, NewLen); - FPosition := FStart + LastOffset; - FEnd := FStart + NewLen; - end; - FPosition^ := #13; - Inc(FPosition); - FPosition^ := #10; - Inc(FPosition); -end; - -//----------------- TBufferedString -------------------------------------------------------------------------------- - -destructor TBufferedString.Destroy; - -begin - FreeMem(FStart); - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBufferedString.GetAsString: string; - -begin - SetString(Result, FStart, FPosition - FStart); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBufferedString.Add(const S: string); - -var - NewLen, - LastOffset, - Len: Integer; - -begin - Len := Length(S); - if Len = 0 then - exit;//Nothing to do - // Make room for the new string. - if FEnd - FPosition <= Len then - begin - // Round up NewLen so it is always a multiple of AllocIncrement. - NewLen := FEnd - FStart + (Len + AllocIncrement - 1) and not (AllocIncrement - 1); - // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. - LastOffset := FPosition - FStart; - ReallocMem(FStart, 2 * NewLen); - FPosition := FStart + LastOffset; - FEnd := FStart + NewLen; - end; - Move(PWideChar(S)^, FPosition^, 2 * Len); - Inc(FPosition, Len); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBufferedString.AddNewLine; - -var - NewLen, - LastOffset: Integer; - -begin - // Make room for the CR/LF characters. - if FEnd - FPosition <= 4 then - begin - // Round up NewLen so it is always a multiple of AllocIncrement. - NewLen := FEnd - FStart + (2 + AllocIncrement - 1) and not (AllocIncrement - 1); - // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. - LastOffset := FPosition - FStart; - ReallocMem(FStart, 2 * NewLen); - FPosition := FStart + LastOffset; - FEnd := FStart + NewLen; - end; - FPosition^ := #13; - Inc(FPosition); - FPosition^ := #10; - Inc(FPosition); -end; - - -end. +unit VirtualTrees.Classes; + +// The contents of this file are subject to the Mozilla Public License +// Version 1.1 (the "License"); you may not use this file except in compliance +// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ +// +// Alternatively, you may redistribute this library, use and/or modify it under the terms of the +// GNU Lesser General Public License as published by the Free Software Foundation; +// either version 2.1 of the License, or (at your option) any later version. +// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/. +// +// Software distributed under the License is distributed on an "AS IS" basis, +// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the +// specific language governing rights and limitations under the License. +// +// The original code is VirtualTrees.pas, released September 30, 2000. +// +// The initial developer of the original code is digital publishing AG (Munich, Germany, www.digitalpublishing.de), +// written by Mike Lischke (public@soft-gems.net, www.soft-gems.net). +// +// Portions created by digital publishing AG are Copyright +// (C) 1999-2001 digital publishing AG. All Rights Reserved. +//---------------------------------------------------------------------------------------------------------------------- + +interface + +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CAST OFF} +{$WARN UNSAFE_CODE OFF} + +uses + Winapi.Windows; + +type + // Helper classes to speed up rendering text formats for clipboard and drag'n drop transfers. + TBufferedRawByteString = class + private + FStart, + FPosition, + FEnd: PAnsiChar; + function GetAsString: RawByteString; + public + destructor Destroy; override; + + procedure Add(const S: RawByteString); + procedure AddNewLine; + + property AsString: RawByteString read GetAsString; + end; + + TBufferedString = class + private + FStart, + FPosition, + FEnd: PWideChar; + function GetAsString: string; + public + destructor Destroy; override; + + procedure Add(const S: string); + procedure AddNewLine; + + property AsString: string read GetAsString; + end; + + +implementation + +//----------------- TBufferedRawByteString ------------------------------------------------------------------------------------ + +const + AllocIncrement = 2 shl 11; // Must be a power of 2. + +destructor TBufferedRawByteString.Destroy; + +begin + FreeMem(FStart); + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBufferedRawByteString.GetAsString: RawByteString; + +begin + SetString(Result, FStart, FPosition - FStart); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBufferedRawByteString.Add(const S: RawByteString); + +var + NewLen, + LastOffset, + Len: NativeInt; + +begin + Len := Length(S); + // Make room for the new string. + if FEnd - FPosition <= Len then + begin + // Round up NewLen so it is always a multiple of AllocIncrement. + NewLen := FEnd - FStart + (Len + AllocIncrement - 1) and not (AllocIncrement - 1); + // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. + LastOffset := FPosition - FStart; + ReallocMem(FStart, NewLen); + FPosition := FStart + LastOffset; + FEnd := FStart + NewLen; + end; + System.Move(PAnsiChar(S)^, FPosition^, Len); + System.Inc(FPosition, Len); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBufferedRawByteString.AddNewLine; + +var + NewLen, + LastOffset: NativeInt; + +begin + // Make room for the CR/LF characters. + if FEnd - FPosition <= 2 then + begin + // Round up NewLen so it is always a multiple of AllocIncrement. + NewLen := FEnd - FStart + (2 + AllocIncrement - 1) and not (AllocIncrement - 1); + // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. + LastOffset := FPosition - FStart; + ReallocMem(FStart, NewLen); + FPosition := FStart + LastOffset; + FEnd := FStart + NewLen; + end; + FPosition^ := #13; + System.Inc(FPosition); + FPosition^ := #10; + System.Inc(FPosition); +end; + +//----------------- TBufferedString -------------------------------------------------------------------------------- + +destructor TBufferedString.Destroy; + +begin + FreeMem(FStart); + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBufferedString.GetAsString: string; + +begin + SetString(Result, FStart, FPosition - FStart); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBufferedString.Add(const S: string); + +var + NewLen, + LastOffset, + Len: Integer; + +begin + Len := Length(S); + if Len = 0 then + exit;//Nothing to do + // Make room for the new string. + if FEnd - FPosition <= Len then + begin + // Round up NewLen so it is always a multiple of AllocIncrement. + NewLen := FEnd - FStart + (Len + AllocIncrement - 1) and not (AllocIncrement - 1); + // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. + LastOffset := FPosition - FStart; + ReallocMem(FStart, 2 * NewLen); + FPosition := FStart + LastOffset; + FEnd := FStart + NewLen; + end; + System.Move(PWideChar(S)^, FPosition^, 2 * Len); + System.Inc(FPosition, Len); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBufferedString.AddNewLine; + +var + NewLen, + LastOffset: Integer; + +begin + // Make room for the CR/LF characters. + if FEnd - FPosition <= 4 then + begin + // Round up NewLen so it is always a multiple of AllocIncrement. + NewLen := FEnd - FStart + (2 + AllocIncrement - 1) and not (AllocIncrement - 1); + // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. + LastOffset := FPosition - FStart; + ReallocMem(FStart, 2 * NewLen); + FPosition := FStart + LastOffset; + FEnd := FStart + NewLen; + end; + FPosition^ := #13; + System.Inc(FPosition); + FPosition^ := #10; + System.Inc(FPosition); +end; + + +end. diff --git a/Source/VirtualTrees.ClipBoard.pas b/Source/VirtualTrees.ClipBoard.pas index 197eed237..017a73625 100644 --- a/Source/VirtualTrees.ClipBoard.pas +++ b/Source/VirtualTrees.ClipBoard.pas @@ -1,407 +1,419 @@ -unit VirtualTrees.ClipBoard; - -// The contents of this file are subject to the Mozilla Public License -// Version 1.1 (the "License"); you may not use this file except in compliance -// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ -// -// Alternatively, you may redistribute this library, use and/or modify it under the terms of the -// GNU Lesser General Public License as published by the Free Software Foundation; -// either version 2.1 of the License, or (at your option) any later version. -// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/. -// -// Software distributed under the License is distributed on an "AS IS" basis, -// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the -// specific language governing rights and limitations under the License. -// -// The original code is VirtualTrees.pas, released September 30, 2000. -// -// The initial developer of the original code is digital publishing AG (Munich, Germany, www.digitalpublishing.de), -// written by Mike Lischke (public@soft-gems.net, www.soft-gems.net). -// -// Portions created by digital publishing AG are Copyright -// (C) 1999-2001 digital publishing AG. All Rights Reserved. -//---------------------------------------------------------------------------------------------------------------------- - - -interface - -{$WARN UNSAFE_TYPE OFF} +unit VirtualTrees.ClipBoard; + +// The contents of this file are subject to the Mozilla Public License +// Version 1.1 (the "License"); you may not use this file except in compliance +// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ +// +// Alternatively, you may redistribute this library, use and/or modify it under the terms of the +// GNU Lesser General Public License as published by the Free Software Foundation; +// either version 2.1 of the License, or (at your option) any later version. +// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/. +// +// Software distributed under the License is distributed on an "AS IS" basis, +// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the +// specific language governing rights and limitations under the License. +// +// The original code is VirtualTrees.pas, released September 30, 2000. +// +// The initial developer of the original code is digital publishing AG (Munich, Germany, www.digitalpublishing.de), +// written by Mike Lischke (public@soft-gems.net, www.soft-gems.net). +// +// Portions created by digital publishing AG are Copyright +// (C) 1999-2001 digital publishing AG. All Rights Reserved. +//---------------------------------------------------------------------------------------------------------------------- + + +interface + +{$WARN UNSAFE_TYPE OFF} {$WARN UNSAFE_CAST OFF} - -uses - Winapi.Windows, - Winapi.ActiveX, - System.Classes, - VirtualTrees; - -type - TClipboardFormatEntry = record - ID: Word; - Description: string; - end; - -var - ClipboardDescriptions: array [1..CF_MAX - 1] of TClipboardFormatEntry = ( - (ID: CF_TEXT; Description: 'Plain text'), // Do not localize - (ID: CF_BITMAP; Description: 'Windows bitmap'), // Do not localize - (ID: CF_METAFILEPICT; Description: 'Windows metafile'), // Do not localize - (ID: CF_SYLK; Description: 'Symbolic link'), // Do not localize - (ID: CF_DIF; Description: 'Data interchange format'), // Do not localize - (ID: CF_TIFF; Description: 'Tiff image'), // Do not localize - (ID: CF_OEMTEXT; Description: 'OEM text'), // Do not localize - (ID: CF_DIB; Description: 'DIB image'), // Do not localize - (ID: CF_PALETTE; Description: 'Palette data'), // Do not localize - (ID: CF_PENDATA; Description: 'Pen data'), // Do not localize - (ID: CF_RIFF; Description: 'Riff audio data'), // Do not localize - (ID: CF_WAVE; Description: 'Wav audio data'), // Do not localize - (ID: CF_UNICODETEXT; Description: 'Unicode text'), // Do not localize - (ID: CF_ENHMETAFILE; Description: 'Enhanced metafile image'), // Do not localize - (ID: CF_HDROP; Description: 'File name(s)'), // Do not localize - (ID: CF_LOCALE; Description: 'Locale descriptor'), // Do not localize - (ID: CF_DIBV5; Description: 'DIB image V5') // Do not localize - ); - - -// OLE Clipboard and drag'n drop helper -procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; const List: TStrings); overload; -procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; var Formats: TFormatEtcArray); overload; -function GetVTClipboardFormatDescription(AFormat: Word): string; -procedure RegisterVTClipboardFormat(AFormat: Word; TreeClass: TVirtualTreeClass; Priority: Cardinal); overload; -function RegisterVTClipboardFormat(const Description: string; TreeClass: TVirtualTreeClass; Priority: Cardinal; - tymed: Integer = TYMED_HGLOBAL; ptd: PDVTargetDevice = nil; - dwAspect: Integer = DVASPECT_CONTENT; lindex: Integer = -1): Word; overload; - -//----------------- TClipboardFormats ---------------------------------------------------------------------------------- - -type - TClipboardFormatListEntry = class - public - Description: string; // The string used to register the format with Winapi.Windows. - TreeClass: TVirtualTreeClass; // The tree class which supports rendering this format. - Priority: Cardinal; // Number which determines the order of formats used in IDataObject. - FormatEtc: TFormatEtc; // The definition of the format in the IDataObject. - end; - - TClipboardFormatList = class - strict private - class function GetList(): TList; static; - class property List: TList read GetList; - protected - class procedure Sort; - public - class procedure Add(const FormatString: string; AClass: TVirtualTreeClass; Priority: Cardinal; AFormatEtc: TFormatEtc); - class procedure Clear; - class procedure EnumerateFormats(TreeClass: TVirtualTreeClass; var Formats: TFormatEtcArray; const AllowedFormats: TClipboardFormats = nil); overload; - class procedure EnumerateFormats(TreeClass: TVirtualTreeClass; const Formats: TStrings); overload; - class function FindFormat(const FormatString: string): TClipboardFormatListEntry; overload; - class function FindFormat(const FormatString: string; var Fmt: Word): TVirtualTreeClass; overload; - class function FindFormat(Fmt: Word; var Description: string): TVirtualTreeClass; overload; - end; - - -implementation - -uses - System.SysUtils; - -var - _List: TList = nil; //Note - not using class constructors as they are not supported on C++ Builder. See also issue # - -procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; const List: TStrings); - -begin - TClipboardFormatList.EnumerateFormats(TreeClass, List); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; var Formats: TFormatEtcArray); - -begin - TClipboardFormatList.EnumerateFormats(TreeClass, Formats); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function GetVTClipboardFormatDescription(AFormat: Word): string; - -begin - if TClipboardFormatList.FindFormat(AFormat, Result) = nil then - Result := ''; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure RegisterVTClipboardFormat(AFormat: Word; TreeClass: TVirtualTreeClass; Priority: Cardinal); - -// Registers the given clipboard format for the given TreeClass. - -var - I: Integer; - Buffer: array[0..2048] of Char; - FormatEtc: TFormatEtc; - -begin - - // Assumes a HGlobal format. - FormatEtc.cfFormat := AFormat; - FormatEtc.ptd := nil; - FormatEtc.dwAspect := DVASPECT_CONTENT; - FormatEtc.lindex := -1; - FormatEtc.tymed := TYMED_HGLOBAL; - - // Determine description string of the given format. For predefined formats we need the lookup table because they - // don't have a description string. For registered formats the description string is the string which was used - // to register them. - if AFormat < CF_MAX then - begin - for I := 1 to High(ClipboardDescriptions) do - if ClipboardDescriptions[I].ID = AFormat then - begin - TClipboardFormatList.Add(ClipboardDescriptions[I].Description, TreeClass, Priority, FormatEtc); - Break; - end; - end - else - begin - GetClipboardFormatName(AFormat, Buffer, Length(Buffer)); - TClipboardFormatList.Add(Buffer, TreeClass, Priority, FormatEtc); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function RegisterVTClipboardFormat(const Description: string; TreeClass: TVirtualTreeClass; Priority: Cardinal; - tymed: Integer = TYMED_HGLOBAL; ptd: PDVTargetDevice = nil; dwAspect: Integer = DVASPECT_CONTENT; - lindex: Integer = -1): Word; - -// Alternative method to register a certain clipboard format for a given tree class. Registration with the -// clipboard is done here too and the assigned ID returned by the function. -// tymed may contain or'ed TYMED constants which allows to register several storage formats for one clipboard format. - -var - FormatEtc: TFormatEtc; - -begin - Result := RegisterClipboardFormat(PChar(Description)); - FormatEtc.cfFormat := Result; - FormatEtc.ptd := ptd; - FormatEtc.dwAspect := dwAspect; - FormatEtc.lindex := lindex; - FormatEtc.tymed := tymed; - TClipboardFormatList.Add(Description, TreeClass, Priority, FormatEtc); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -class procedure TClipboardFormatList.Sort; - -// Sorts all entry for priority (increasing priority value). - - //--------------- local function -------------------------------------------- - procedure QuickSort(L, R: Integer); - - var - I, J: Integer; - P, T: TClipboardFormatListEntry; - - begin - repeat - I := L; - J := R; - P := _List[(L + R) shr 1]; - repeat - while TClipboardFormatListEntry(_List[I]).Priority < P.Priority do - Inc(I); - while TClipboardFormatListEntry(_List[J]).Priority > P.Priority do - Dec(J); - if I <= J then - begin - T := List[I]; - _List[I] := _List[J]; - _List[J] := T; - Inc(I); - Dec(J); - end; - until I > J; - if L < J then - QuickSort(L, J); - L := I; - until I >= R; - end; - //--------------- end local function ---------------------------------------- - -begin - if List.Count > 1 then - QuickSort(0, List.Count - 1); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -class procedure TClipboardFormatList.Add(const FormatString: string; AClass: TVirtualTreeClass; Priority: Cardinal; AFormatEtc: TFormatEtc); - -// Adds the given data to the internal list. The priority value is used to sort formats for importance. Larger priority -// values mean less priority. - -var - Entry: TClipboardFormatListEntry; - -begin - Entry := TClipboardFormatListEntry.Create; - Entry.Description := FormatString; - Entry.TreeClass := AClass; - Entry.Priority := Priority; - Entry.FormatEtc := AFormatEtc; - List.Add(Entry); - - Sort; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -class procedure TClipboardFormatList.Clear; - -var - I: Integer; - -begin - if Assigned(_List) then begin - for I := 0 to _List.Count - 1 do - TClipboardFormatListEntry(List[I]).Free; - _List.Clear; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -class procedure TClipboardFormatList.EnumerateFormats(TreeClass: TVirtualTreeClass; var Formats: TFormatEtcArray; const AllowedFormats: TClipboardFormats = nil); - -// Returns a list of format records for the given class. If assigned the AllowedFormats is used to limit the -// enumerated formats to those described in the list. - -var - I, Count: Integer; - Entry: TClipboardFormatListEntry; - -begin - SetLength(Formats, List.Count); - Count := 0; - for I := 0 to List.Count - 1 do - begin - Entry := List[I]; - // Does the tree class support this clipboard format? - if TreeClass.InheritsFrom(Entry.TreeClass) then - begin - // Is this format allowed to be included? - if (AllowedFormats = nil) or (AllowedFormats.IndexOf(Entry.Description) > -1) then - begin - // The list could change before we use the FormatEtc so it is best not to pass a pointer to the true FormatEtc - // structure. Instead make a copy and send that. - Formats[Count] := Entry.FormatEtc; - Inc(Count); - end; - end; - end; - SetLength(Formats, Count); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -class procedure TClipboardFormatList.EnumerateFormats(TreeClass: TVirtualTreeClass; const Formats: TStrings); - -// Returns a list of format descriptions for the given class. - -var - I: Integer; - Entry: TClipboardFormatListEntry; - -begin - for I := 0 to List.Count - 1 do - begin - Entry := List[I]; - if TreeClass.InheritsFrom(Entry.TreeClass) then - Formats.Add(Entry.Description); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -class function TClipboardFormatList.FindFormat(const FormatString: string): TClipboardFormatListEntry; - -var - I: Integer; - Entry: TClipboardFormatListEntry; - -begin - Result := nil; - for I := List.Count - 1 downto 0 do - begin - Entry := List[I]; - if CompareText(Entry.Description, FormatString) = 0 then - begin - Result := Entry; - Break; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -class function TClipboardFormatList.FindFormat(const FormatString: string; var Fmt: Word): TVirtualTreeClass; - -var - I: Integer; - Entry: TClipboardFormatListEntry; - -begin - Result := nil; - for I := List.Count - 1 downto 0 do - begin - Entry := List[I]; - if CompareText(Entry.Description, FormatString) = 0 then - begin - Result := Entry.TreeClass; - Fmt := Entry.FormatEtc.cfFormat; - Break; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -class function TClipboardFormatList.FindFormat(Fmt: Word; var Description: string): TVirtualTreeClass; - -var - I: Integer; - Entry: TClipboardFormatListEntry; - -begin - Result := nil; - for I := List.Count - 1 downto 0 do - begin - Entry := List[I]; - if Entry.FormatEtc.cfFormat = Fmt then - begin - Result := Entry.TreeClass; - Description := Entry.Description; - Break; - end; - end; -end; - - -class function TClipboardFormatList.GetList: TList; -begin - if not Assigned(_List) then - _List := TList.Create; - Exit(_List); -end; - -initialization - -finalization - - TClipboardFormatList.Clear; - FreeAndNil(_List); - -end. + +uses + Winapi.Windows, + Winapi.ActiveX, + System.Classes, + VirtualTrees.BaseTree; + +type + TClipboardFormatEntry = record + ID: Word; + Description: string; + end; + +var + ClipboardDescriptions: array [1..CF_MAX - 1] of TClipboardFormatEntry = ( + (ID: CF_TEXT; Description: 'Plain text'), // Do not localize + (ID: CF_BITMAP; Description: 'Windows bitmap'), // Do not localize + (ID: CF_METAFILEPICT; Description: 'Windows metafile'), // Do not localize + (ID: CF_SYLK; Description: 'Symbolic link'), // Do not localize + (ID: CF_DIF; Description: 'Data interchange format'), // Do not localize + (ID: CF_TIFF; Description: 'Tiff image'), // Do not localize + (ID: CF_OEMTEXT; Description: 'OEM text'), // Do not localize + (ID: CF_DIB; Description: 'DIB image'), // Do not localize + (ID: CF_PALETTE; Description: 'Palette data'), // Do not localize + (ID: CF_PENDATA; Description: 'Pen data'), // Do not localize + (ID: CF_RIFF; Description: 'Riff audio data'), // Do not localize + (ID: CF_WAVE; Description: 'Wav audio data'), // Do not localize + (ID: CF_UNICODETEXT; Description: 'Unicode text'), // Do not localize + (ID: CF_ENHMETAFILE; Description: 'Enhanced metafile image'), // Do not localize + (ID: CF_HDROP; Description: 'File name(s)'), // Do not localize + (ID: CF_LOCALE; Description: 'Locale descriptor'), // Do not localize + (ID: CF_DIBV5; Description: 'DIB image V5') // Do not localize + ); + + +// OLE Clipboard and drag'n drop helper +procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; const List: TStrings); overload; +procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; var Formats: TFormatEtcArray); overload; +function GetVTClipboardFormatDescription(AFormat: Word): string; +procedure RegisterVTClipboardFormat(AFormat: Word; TreeClass: TVirtualTreeClass; Priority: Cardinal); overload; +function RegisterVTClipboardFormat(const Description: string; TreeClass: TVirtualTreeClass; Priority: Cardinal; + tymed: Integer = TYMED_HGLOBAL; ptd: PDVTargetDevice = nil; + dwAspect: Integer = DVASPECT_CONTENT; lindex: Integer = -1): Word; overload; + +//----------------- TClipboardFormats ---------------------------------------------------------------------------------- + +type + TClipboardFormatListEntry = class + public + Description: string; // The string used to register the format with Winapi.Windows. + TreeClass: TVirtualTreeClass; // The tree class which supports rendering this format. + Priority: Cardinal; // Number which determines the order of formats used in IDataObject. + FormatEtc: TFormatEtc; // The definition of the format in the IDataObject. + end; + + TClipboardFormatList = class + strict private + class function GetList(): TList; static; + class property List: TList read GetList; + protected + class procedure Sort; + public + class procedure Add(const FormatString: string; AClass: TVirtualTreeClass; Priority: Cardinal; AFormatEtc: TFormatEtc); + class procedure Clear; + class procedure EnumerateFormats(TreeClass: TVirtualTreeClass; var Formats: TFormatEtcArray; const AllowedFormats: TClipboardFormats = nil); overload; + class procedure EnumerateFormats(TreeClass: TVirtualTreeClass; const Formats: TStrings); overload; + class function FindFormat(const FormatString: string): TClipboardFormatListEntry; overload; + class function FindFormat(const FormatString: string; var Fmt: Word): TVirtualTreeClass; overload; + class function FindFormat(Fmt: Word; var Description: string): TVirtualTreeClass; overload; + end; + +var + // Clipboard format IDs used in OLE drag'n drop and clipboard transfers. + CF_VIRTUALTREE, + 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. + CF_HTML, + CF_CSV: Word; + + +implementation + +uses + System.SysUtils; + +var + _List: TList = nil; //Note - not using class constructors as they are not supported on C++ Builder. See also issue # + +procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; const List: TStrings); + +begin + TClipboardFormatList.EnumerateFormats(TreeClass, List); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure EnumerateVTClipboardFormats(TreeClass: TVirtualTreeClass; var Formats: TFormatEtcArray); + +begin + TClipboardFormatList.EnumerateFormats(TreeClass, Formats); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function GetVTClipboardFormatDescription(AFormat: Word): string; + +begin + if TClipboardFormatList.FindFormat(AFormat, Result) = nil then + Result := ''; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure RegisterVTClipboardFormat(AFormat: Word; TreeClass: TVirtualTreeClass; Priority: Cardinal); + +// Registers the given clipboard format for the given TreeClass. + +var + I: Integer; + Buffer: array[0..2048] of Char; + FormatEtc: TFormatEtc; + +begin + + // Assumes a HGlobal format. + FormatEtc.cfFormat := AFormat; + FormatEtc.ptd := nil; + FormatEtc.dwAspect := DVASPECT_CONTENT; + FormatEtc.lindex := -1; + FormatEtc.tymed := TYMED_HGLOBAL; + + // Determine description string of the given format. For predefined formats we need the lookup table because they + // don't have a description string. For registered formats the description string is the string which was used + // to register them. + if AFormat < CF_MAX then + begin + for I := 1 to High(ClipboardDescriptions) do + if ClipboardDescriptions[I].ID = AFormat then + begin + TClipboardFormatList.Add(ClipboardDescriptions[I].Description, TreeClass, Priority, FormatEtc); + Break; + end; + end + else + begin + GetClipboardFormatName(AFormat, Buffer, Length(Buffer)); + TClipboardFormatList.Add(Buffer, TreeClass, Priority, FormatEtc); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function RegisterVTClipboardFormat(const Description: string; TreeClass: TVirtualTreeClass; Priority: Cardinal; + tymed: Integer = TYMED_HGLOBAL; ptd: PDVTargetDevice = nil; dwAspect: Integer = DVASPECT_CONTENT; + lindex: Integer = -1): Word; + +// Alternative method to register a certain clipboard format for a given tree class. Registration with the +// clipboard is done here too and the assigned ID returned by the function. +// tymed may contain or'ed TYMED constants which allows to register several storage formats for one clipboard format. + +var + FormatEtc: TFormatEtc; + +begin + Result := RegisterClipboardFormat(PChar(Description)); + FormatEtc.cfFormat := Result; + FormatEtc.ptd := ptd; + FormatEtc.dwAspect := dwAspect; + FormatEtc.lindex := lindex; + FormatEtc.tymed := tymed; + TClipboardFormatList.Add(Description, TreeClass, Priority, FormatEtc); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +class procedure TClipboardFormatList.Sort; + +// Sorts all entry for priority (increasing priority value). + + //--------------- local function -------------------------------------------- + procedure QuickSort(L, R: Integer); + + var + I, J: Integer; + P, T: TClipboardFormatListEntry; + + begin + repeat + I := L; + J := R; + P := _List[(L + R) shr 1]; + repeat + while TClipboardFormatListEntry(_List[I]).Priority < P.Priority do + Inc(I); + while TClipboardFormatListEntry(_List[J]).Priority > P.Priority do + Dec(J); + if I <= J then + begin + T := List[I]; + _List[I] := _List[J]; + _List[J] := T; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(L, J); + L := I; + until I >= R; + end; + //--------------- end local function ---------------------------------------- + +begin + if List.Count > 1 then + QuickSort(0, List.Count - 1); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +class procedure TClipboardFormatList.Add(const FormatString: string; AClass: TVirtualTreeClass; Priority: Cardinal; AFormatEtc: TFormatEtc); + +// Adds the given data to the internal list. The priority value is used to sort formats for importance. Larger priority +// values mean less priority. + +var + Entry: TClipboardFormatListEntry; + +begin + Entry := TClipboardFormatListEntry.Create; + Entry.Description := FormatString; + Entry.TreeClass := AClass; + Entry.Priority := Priority; + Entry.FormatEtc := AFormatEtc; + List.Add(Entry); + + Sort; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +class procedure TClipboardFormatList.Clear; + +var + I: Integer; + +begin + if Assigned(_List) then begin + for I := 0 to _List.Count - 1 do + TClipboardFormatListEntry(List[I]).Free; + _List.Clear; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +class procedure TClipboardFormatList.EnumerateFormats(TreeClass: TVirtualTreeClass; var Formats: TFormatEtcArray; const AllowedFormats: TClipboardFormats = nil); + +// Returns a list of format records for the given class. If assigned the AllowedFormats is used to limit the +// enumerated formats to those described in the list. + +var + I, Count: Integer; + Entry: TClipboardFormatListEntry; + +begin + SetLength(Formats, List.Count); + Count := 0; + for I := 0 to List.Count - 1 do + begin + Entry := List[I]; + // Does the tree class support this clipboard format? + if TreeClass.InheritsFrom(Entry.TreeClass) then + begin + // Is this format allowed to be included? + if (AllowedFormats = nil) or (AllowedFormats.IndexOf(Entry.Description) > -1) then + begin + // The list could change before we use the FormatEtc so it is best not to pass a pointer to the true FormatEtc + // structure. Instead make a copy and send that. + Formats[Count] := Entry.FormatEtc; + Inc(Count); + end; + end; + end; + SetLength(Formats, Count); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +class procedure TClipboardFormatList.EnumerateFormats(TreeClass: TVirtualTreeClass; const Formats: TStrings); + +// Returns a list of format descriptions for the given class. + +var + I: Integer; + Entry: TClipboardFormatListEntry; + +begin + for I := 0 to List.Count - 1 do + begin + Entry := List[I]; + if TreeClass.InheritsFrom(Entry.TreeClass) then + Formats.Add(Entry.Description); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +class function TClipboardFormatList.FindFormat(const FormatString: string): TClipboardFormatListEntry; + +var + I: Integer; + Entry: TClipboardFormatListEntry; + +begin + Result := nil; + for I := List.Count - 1 downto 0 do + begin + Entry := List[I]; + if CompareText(Entry.Description, FormatString) = 0 then + begin + Result := Entry; + Break; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +class function TClipboardFormatList.FindFormat(const FormatString: string; var Fmt: Word): TVirtualTreeClass; + +var + I: Integer; + Entry: TClipboardFormatListEntry; + +begin + Result := nil; + for I := List.Count - 1 downto 0 do + begin + Entry := List[I]; + if CompareText(Entry.Description, FormatString) = 0 then + begin + Result := Entry.TreeClass; + Fmt := Entry.FormatEtc.cfFormat; + Break; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +class function TClipboardFormatList.FindFormat(Fmt: Word; var Description: string): TVirtualTreeClass; + +var + I: Integer; + Entry: TClipboardFormatListEntry; + +begin + Result := nil; + for I := List.Count - 1 downto 0 do + begin + Entry := List[I]; + if Entry.FormatEtc.cfFormat = Fmt then + begin + Result := Entry.TreeClass; + Description := Entry.Description; + Break; + end; + end; +end; + + +class function TClipboardFormatList.GetList: TList; +begin + if not Assigned(_List) then + _List := TList.Create; + Exit(_List); +end; + +initialization + +finalization + + TClipboardFormatList.Clear; + FreeAndNil(_List); + +end. + diff --git a/Source/VirtualTrees.Colors.pas b/Source/VirtualTrees.Colors.pas new file mode 100644 index 000000000..78c1c079e --- /dev/null +++ b/Source/VirtualTrees.Colors.pas @@ -0,0 +1,274 @@ +unit VirtualTrees.Colors; + +interface + +uses + System.Classes, + Vcl.Graphics, + Vcl.Themes, + Vcl.Controls; + +type + //class to collect all switchable colors into one place + TVTColors = class(TPersistent) + private type + TVTColorEnum = ( + cDisabledColor + , cDropMarkColor + , cDropTargetColor + , cFocusedSelectionColor + , cGridLineColor + , cTreeLineColor + , cUnfocusedSelectionColor + , cBorderColor + , cHotColor + , cFocusedSelectionBorderColor + , cUnfocusedSelectionBorderColor + , cDropTargetBorderColor + , cSelectionRectangleBlendColor + , cSelectionRectangleBorderColor + , cHeaderHotColor + , cSelectionTextColor + , cUnfocusedColor + ); + + //Please make sure that the published Color properties at the corresponding index + //have the same color if you change anything here! + const + cDefaultColors : array [TVTColorEnum] of TColor = ( + clBtnShadow, //DisabledColor + clHighlight, //DropMarkColor + clHighlight, //DropTargetColor + clHighlight, //FocusedSelectionColor + clBtnFace, //GridLineColor + clBtnShadow, //TreeLineColor + clInactiveCaption, //UnfocusedSelectionColor + clBtnFace, //BorderColor + clWindowText, //HotColor + clHighlight, //FocusedSelectionBorderColor + clInactiveCaption, //UnfocusedSelectionBorderColor + clHighlight, //DropTargetBorderColor + clHighlight, //SelectionRectangleBlendColor + clHighlight, //SelectionRectangleBorderColor + clBtnShadow, //HeaderHotColor + clHighlightText, //SelectionTextColor + clInactiveCaptionText //UnfocusedColor [IPK] + ); + private + FOwner : TCustomControl; + FColors : array [TVTColorEnum] of TColor; //[IPK] 15 -> 16 + function GetColor(const Index : TVTColorEnum) : TColor; + procedure SetColor(const Index : TVTColorEnum; const Value : TColor); + function GetBackgroundColor : TColor; + function GetHeaderFontColor : TColor; + function GetNodeFontColor : TColor; + public + constructor Create(AOwner : TCustomControl); + + procedure Assign(Source : TPersistent); override; + function GetSelectedNodeFontColor(Focused : boolean) : TColor; + property BackGroundColor : TColor read GetBackgroundColor; + property HeaderFontColor : TColor read GetHeaderFontColor; + property NodeFontColor : TColor read GetNodeFontColor; + //Mitigator function to use the correct style service for this context (either the style assigned to the control for Delphi > 10.4 or the application style) + function StyleServices(AControl : TControl = nil) : TCustomStyleServices; + published + property BorderColor : TColor index cBorderColor read GetColor write SetColor default clBtnFace; + property DisabledColor : TColor index cDisabledColor read GetColor write SetColor default clBtnShadow; + property DropMarkColor : TColor index cDropMarkColor read GetColor write SetColor default clHighlight; + property DropTargetColor : TColor index cDropTargetColor read GetColor write SetColor default clHighlight; + property DropTargetBorderColor : TColor index cDropTargetBorderColor read GetColor write SetColor default clHighlight; + ///The background color of selected nodes in case the tree has the focus, or the toPopupMode flag is set. + property FocusedSelectionColor : TColor index cFocusedSelectionColor read GetColor write SetColor default clHighlight; + ///The border color of selected nodes when the tree has the focus. + property FocusedSelectionBorderColor : TColor index cFocusedSelectionBorderColor read GetColor write SetColor default clHighlight; + ///The color of the grid lines + property GridLineColor : TColor index cGridLineColor read GetColor write SetColor default clBtnFace; + property HeaderHotColor : TColor index cHeaderHotColor read GetColor write SetColor default clBtnShadow; + property HotColor : TColor index cHotColor read GetColor write SetColor default clWindowText; + property SelectionRectangleBlendColor : TColor index cSelectionRectangleBlendColor read GetColor write SetColor default clHighlight; + property SelectionRectangleBorderColor : TColor index cSelectionRectangleBorderColor read GetColor write SetColor default clHighlight; + ///The text color of selected nodes + property SelectionTextColor : TColor index cSelectionTextColor read GetColor write SetColor default clHighlightText; + property TreeLineColor : TColor index cTreeLineColor read GetColor write SetColor default clBtnShadow; + property UnfocusedColor : TColor index cUnfocusedColor read GetColor write SetColor default clInactiveCaptionText; //[IPK] Added + ///The background color of selected nodes in case the tree does not have the focus and the toPopupMode flag is not set. + property UnfocusedSelectionColor : TColor index cUnfocusedSelectionColor read GetColor write SetColor default clInactiveCaption; + ///The border color of selected nodes in case the tree does not have the focus and the toPopupMode flag is not set. + property UnfocusedSelectionBorderColor : TColor index cUnfocusedSelectionBorderColor read GetColor write SetColor default clInactiveCaption; + end; + +implementation + +uses + WinApi.Windows, + VirtualTrees.Types, + VirtualTrees.Utils, + VirtualTrees.StyleHooks, + VirtualTrees.BaseTree; + +type + TBaseVirtualTreeCracker = class(TBaseVirtualTree); + + TVTColorsHelper = class helper for TVTColors + function TreeView : TBaseVirtualTreeCracker; + end; + + //----------------- TVTColors ------------------------------------------------------------------------------------------ + +constructor TVTColors.Create(AOwner : TCustomControl); +var + CE : TVTColorEnum; +begin + FOwner := AOwner; + for CE := Low(TVTColorEnum) to High(TVTColorEnum) do + FColors[CE] := cDefaultColors[CE]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTColors.GetBackgroundColor : TColor; +begin + //XE2 VCL Style + if TreeView.VclStyleEnabled and (seClient in FOwner.StyleElements) then + Result := StyleServices.GetStyleColor(scTreeView) + else + Result := TreeView.Color; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTColors.GetColor(const Index : TVTColorEnum) : TColor; +begin + //Only try to fetch the color via StyleServices if theses are enabled + //Return default/user defined color otherwise + if not (csDesigning in TreeView.ComponentState) { see issue #1185 } and TreeView.VclStyleEnabled then + begin + //If the ElementDetails are not defined, fall back to the SystemColor + case Index of + cDisabledColor : + if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemDisabled), ecTextColor, Result) then + Result := StyleServices.GetSystemColor(FColors[Index]); + cTreeLineColor : + if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttBranch), ecBorderColor, Result) then + Result := StyleServices.GetSystemColor(FColors[Index]); + cBorderColor : + if (seBorder in FOwner.StyleElements) then + Result := StyleServices.GetSystemColor(FColors[Index]) + else + Result := FColors[Index]; + cHotColor : + if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemHot), ecTextColor, Result) then + Result := StyleServices.GetSystemColor(FColors[Index]); + cHeaderHotColor : + if not StyleServices.GetElementColor(StyleServices.GetElementDetails(thHeaderItemHot), ecTextColor, Result) then + Result := StyleServices.GetSystemColor(FColors[Index]); + cSelectionTextColor : + if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemSelected), ecTextColor, Result) then + Result := StyleServices.GetSystemColor(clHighlightText); + cUnfocusedColor : + if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemSelectedNotFocus), ecTextColor, Result) then + Result := StyleServices.GetSystemColor(FColors[Index]); + else + Result := StyleServices.GetSystemColor(FColors[Index]); + end; + end + else + Result := FColors[Index]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTColors.GetHeaderFontColor : TColor; +begin + //XE2+ VCL Style + if TreeView.VclStyleEnabled and (seFont in FOwner.StyleElements) then + StyleServices.GetElementColor(StyleServices.GetElementDetails(thHeaderItemNormal), ecTextColor, Result) + else + Result := TreeView.Header.Font.Color; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTColors.GetNodeFontColor : TColor; +begin + if TreeView.VclStyleEnabled and (seFont in FOwner.StyleElements) then + StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemNormal), ecTextColor, Result) + else + Result := TreeView.Font.Color; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTColors.GetSelectedNodeFontColor(Focused : boolean) : TColor; +begin + if Focused then + begin + if (tsUseExplorerTheme in TreeView.TreeStates) and not IsHighContrastEnabled then + begin + Result := NodeFontColor + end + else + Result := SelectionTextColor + end//if Focused + else + Result := UnfocusedColor; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTColors.SetColor(const Index : TVTColorEnum; const Value : TColor); +begin + if FColors[Index] <> Value then + begin + FColors[Index] := Value; + if not (csLoading in FOwner.ComponentState) and FOwner.HandleAllocated then + begin + //Cause helper bitmap rebuild if the button color changed. + case Index of + cTreeLineColor : + begin + TreeView.PrepareBitmaps(True, False); + FOwner.Invalidate; + end; + cBorderColor : + RedrawWindow(FOwner.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_NOERASE or RDW_NOCHILDREN) + else + if not (tsPainting in TreeView.TreeStates) then // See issue #1186 + FOwner.Invalidate; + end;//case + end;// if + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTColors.StyleServices(AControl : TControl) : TCustomStyleServices; +begin + if AControl = nil then + AControl := FOwner; + Result := VTStyleServices(AControl); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTColors.Assign(Source : TPersistent); +begin + if Source is TVTColors then + begin + FColors := TVTColors(Source).FColors; + if TreeView.UpdateCount = 0 then + TreeView.Invalidate; + end + else + inherited; +end; + +{ TVTColorsHelper } + +function TVTColorsHelper.TreeView : TBaseVirtualTreeCracker; +begin + Result := TBaseVirtualTreeCracker(FOwner); +end; + +end. diff --git a/Source/VirtualTrees.DataObject.pas b/Source/VirtualTrees.DataObject.pas new file mode 100644 index 000000000..771b149d0 --- /dev/null +++ b/Source/VirtualTrees.DataObject.pas @@ -0,0 +1,508 @@ +unit VirtualTrees.DataObject; + +interface + +uses + WinApi.ActiveX, + WinApi.Windows, + System.Classes, + Vcl.Controls, + VirtualTrees.Types; + +type + IDataObject = WinApi.ActiveX.IDataObject; + + // IDataObject.SetData support + TInternalStgMedium = packed record + Format : TClipFormat; + Medium : TStgMedium; + end; + + TInternalStgMediumArray = array of TInternalStgMedium; + + // This data object is used in two different places. One is for clipboard operations and the other while dragging. + 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 + FAdviseHolder : IDataAdviseHolder; // Reference to an OLE supplied implementation for advising. + protected + function CanonicalIUnknown(const TestUnknown : IUnknown) : IUnknown; + function EqualFormatEtc(FormatEtc1, FormatEtc2 : TFormatEtc) : Boolean; + function FindFormatEtc(TestFormatEtc : TFormatEtc; const FormatEtcArray : TFormatEtcArray) : Integer; + function FindInternalStgMedium(Format : TClipFormat) : PStgMedium; + function HGlobalClone(HGlobal : THandle) : THandle; + function RenderInternalOLEData(const FormatEtcIn : TFormatEtc; var Medium : TStgMedium; var OLEResult : HResult) : Boolean; + function StgMediumIncRef(const InStgMedium : TStgMedium; var OutStgMedium : TStgMedium; CopyInMedium : Boolean; const DataObject : IDataObject) : HResult; + + property ForClipboard : Boolean read FForClipboard; + property FormatEtcArray : TFormatEtcArray read FFormatEtcArray write FFormatEtcArray; + property InternalStgMediumArray : TInternalStgMediumArray read FInternalStgMediumArray write FInternalStgMediumArray; + property Owner : TCustomControl read FOwner; + public + 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; + function DUnadvise(dwConnection : Integer) : HResult; virtual; stdcall; + function EnumDAdvise(out enumAdvise : IEnumStatData) : HResult; virtual; stdcall; + function EnumFormatEtc(Direction : Integer; out EnumFormatEtc : IEnumFormatEtc) : HResult; virtual; stdcall; + function GetCanonicalFormatEtc(const FormatEtc : TFormatEtc; out FormatEtcOut : TFormatEtc) : HResult; virtual; stdcall; + function GetData(const FormatEtcIn : TFormatEtc; out Medium : TStgMedium) : HResult; virtual; stdcall; + function GetDataHere(const FormatEtc : TFormatEtc; out Medium : TStgMedium) : HResult; virtual; stdcall; + function QueryGetData(const FormatEtc : TFormatEtc) : HResult; virtual; stdcall; + function SetData(const FormatEtc : TFormatEtc; var Medium : TStgMedium; DoRelease : BOOL) : HResult; virtual; stdcall; + end; + +implementation + +uses + VirtualTrees.ClipBoard, + VirtualTrees.DragnDrop, + VirtualTrees.BaseTree; + +type + TVTCracker = class(TBaseVirtualTree); + + //----------------- TVTDataObject -------------------------------------------------------------------------------------- + +constructor TVTDataObject.Create(AOwner : TCustomControl; ForClipboard : Boolean); +begin + inherited Create; + + FOwner := AOwner; + FForClipboard := ForClipboard; + if Assigned(FOWner) then + TVTCracker(FOwner).GetNativeClipboardFormats(FFormatEtcArray); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +constructor TVTDataObject.Create(AHeader: TPersistent; AOwner : TCustomControl); +begin + Create(AOwner, False); + FHeader := AHeader; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +destructor TVTDataObject.Destroy; +var + I : Integer; + StgMedium : PStgMedium; +begin + // Cancel a pending clipboard operation if this data object was created for the clipboard and + // is freed because something else is placed there. + if FForClipboard and not (tsClipboardFlushing in TBaseVirtualTree(FOwner).TreeStates) then + TBaseVirtualTree(FOwner).CancelCutOrCopy; + + // Release any internal clipboard formats + for I := 0 to High(FormatEtcArray) do + begin + StgMedium := FindInternalStgMedium(FormatEtcArray[I].cfFormat); + if Assigned(StgMedium) then + ReleaseStgMedium(StgMedium^); + end; + + FormatEtcArray := nil; + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.CanonicalIUnknown(const TestUnknown : IUnknown) : IUnknown; +// Uses COM object identity: An explicit call to the IUnknown::QueryInterface method, requesting the IUnknown +// interface, will always return the same pointer. +begin + if Assigned(TestUnknown) then + begin + if TestUnknown.QueryInterface(IUnknown, Result) = 0 then + Result._Release // Don't actually need it just need the pointer value + else + Result := TestUnknown; + end + else + Result := TestUnknown; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.EqualFormatEtc(FormatEtc1, FormatEtc2 : TFormatEtc) : Boolean; +begin + Result := (FormatEtc1.cfFormat = FormatEtc2.cfFormat) and (FormatEtc1.ptd = FormatEtc2.ptd) and (FormatEtc1.dwAspect = FormatEtc2.dwAspect) and + (FormatEtc1.lindex = FormatEtc2.lindex) and (FormatEtc1.tymed and FormatEtc2.tymed <> 0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.FindFormatEtc(TestFormatEtc : TFormatEtc; const FormatEtcArray : TFormatEtcArray) : Integer; +var + I : Integer; +begin + Result := - 1; + for I := 0 to High(FormatEtcArray) do + begin + if EqualFormatEtc(TestFormatEtc, FormatEtcArray[I]) then + begin + Result := I; + Break; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.FindInternalStgMedium(Format : TClipFormat) : PStgMedium; +var + I : Integer; +begin + Result := nil; + for I := 0 to High(InternalStgMediumArray) do + begin + if Format = InternalStgMediumArray[I].Format then + begin + Result := @InternalStgMediumArray[I].Medium; + Break; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.HGlobalClone(HGlobal : THandle) : THandle; +// Returns a global memory block that is a copy of the passed memory block. +var + Size : Cardinal; + Data, NewData : PByte; +begin + Size := GlobalSize(HGlobal); + Result := GlobalAlloc(GPTR, Size); + Data := GlobalLock(HGlobal); + try + NewData := GlobalLock(Result); + try + Move(Data^, NewData^, Size); + finally + GlobalUnLock(Result); + end; + finally + GlobalUnLock(HGlobal); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.RenderInternalOLEData(const FormatEtcIn : TFormatEtc; var Medium : TStgMedium; var OLEResult : HResult) : Boolean; +// Tries to render one of the formats which have been stored via the SetData method. +// Since this data is already there it is just copied or its reference count is increased (depending on storage medium). +var + InternalMedium : PStgMedium; +begin + Result := True; + InternalMedium := FindInternalStgMedium(FormatEtcIn.cfFormat); + if Assigned(InternalMedium) then + OLEResult := StgMediumIncRef(InternalMedium^, Medium, False, Self as IDataObject) + else + Result := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.StgMediumIncRef(const InStgMedium : TStgMedium; var OutStgMedium : TStgMedium; CopyInMedium : Boolean; const DataObject : IDataObject) : HResult; +// InStgMedium is the data that is requested, OutStgMedium is the data that we are to return either a copy of or +// increase the IDataObject's reference and send ourselves back as the data (unkForRelease). The InStgMedium is usually +// the result of a call to find a particular FormatEtc that has been stored locally through a call to SetData. +// If CopyInMedium is not true we already have a local copy of the data when the SetData function was called (during +// that call the CopyInMedium must be true). Then as the caller asks for the data through GetData we do not have to make +// copy of the data for the caller only to have them destroy it then need us to copy it again if necessary. +// This way we increase the reference count to ourselves and pass the STGMEDIUM structure initially stored in SetData. +// This way when the caller frees the structure it sees the unkForRelease is not nil and calls Release on the object +// instead of destroying the actual data. +var + Len : Integer; +begin + Result := S_OK; + + // Simply copy all fields to start with. + OutStgMedium := InStgMedium; + // The data handled here always results from a call of SetData we got. This ensures only one storage format + // is indicated and hence the case statement below is safe (IDataObject.GetData can optionally use several + // storage formats). + case InStgMedium.tymed of + TYMED_HGLOBAL : + begin + if CopyInMedium then + begin + // Generate a unique copy of the data passed + OutStgMedium.HGlobal := HGlobalClone(InStgMedium.HGlobal); + if OutStgMedium.HGlobal = 0 then + Result := E_OUTOFMEMORY; + end + else + // Don't generate a copy just use ourselves and the copy previously saved. + OutStgMedium.unkForRelease := Pointer(DataObject); // Does not increase RefCount. + end; + TYMED_FILE : + begin + Len := lstrLenW(InStgMedium.lpszFileName) + 1; // Don't forget the terminating null character. + OutStgMedium.lpszFileName := CoTaskMemAlloc(2 * Len); + Move(InStgMedium.lpszFileName^, OutStgMedium.lpszFileName^, 2 * Len); + end; + TYMED_ISTREAM : + IUnknown(OutStgMedium.stm)._AddRef; + TYMED_ISTORAGE : + IUnknown(OutStgMedium.stg)._AddRef; + TYMED_GDI : + if not CopyInMedium then + // Don't generate a copy just use ourselves and the previously saved data. + OutStgMedium.unkForRelease := Pointer(DataObject) // Does not increase RefCount. + else + Result := DV_E_TYMED; // Don't know how to copy GDI objects right now. + TYMED_MFPICT : + if not CopyInMedium then + // Don't generate a copy just use ourselves and the previously saved data. + OutStgMedium.unkForRelease := Pointer(DataObject) // Does not increase RefCount. + else + Result := DV_E_TYMED; // Don't know how to copy MetaFile objects right now. + TYMED_ENHMF : + if not CopyInMedium then + // Don't generate a copy just use ourselves and the previously saved data. + OutStgMedium.unkForRelease := Pointer(DataObject) // Does not increase RefCount. + else + Result := DV_E_TYMED; // Don't know how to copy enhanced metafiles objects right now. + else + Result := DV_E_TYMED; + end; + + if (Result = S_OK) and Assigned(OutStgMedium.unkForRelease) then + IUnknown(OutStgMedium.unkForRelease)._AddRef; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.DAdvise(const FormatEtc : TFormatEtc; advf : Integer; const advSink : IAdviseSink; out dwConnection : Integer) : HResult; +// Advise sink management is greatly simplified by the IDataAdviseHolder interface. +// We use this interface and forward all concerning calls to it. +begin + Result := S_OK; + if FAdviseHolder = nil then + Result := CreateDataAdviseHolder(FAdviseHolder); + if Result = S_OK then + Result := FAdviseHolder.Advise(Self as IDataObject, FormatEtc, advf, advSink, dwConnection); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.DUnadvise(dwConnection : Integer) : HResult; +begin + if FAdviseHolder = nil then + Result := E_NOTIMPL + else + Result := FAdviseHolder.Unadvise(dwConnection); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.EnumDAdvise(out enumAdvise : IEnumStatData) : HResult; +begin + if FAdviseHolder = nil then + Result := OLE_E_ADVISENOTSUPPORTED + else + Result := FAdviseHolder.enumAdvise(enumAdvise); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.EnumFormatEtc(Direction : Integer; out EnumFormatEtc : IEnumFormatEtc) : HResult; +var + NewList : TEnumFormatEtc; +begin + Result := E_FAIL; + if Direction = DATADIR_GET then + begin + NewList := TEnumFormatEtc.Create(FormatEtcArray); + EnumFormatEtc := NewList as IEnumFormatEtc; + Result := S_OK; + end + else + EnumFormatEtc := nil; + if EnumFormatEtc = nil then + Result := OLE_S_USEREG; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.GetCanonicalFormatEtc(const FormatEtc : TFormatEtc; out FormatEtcOut : TFormatEtc) : HResult; +begin + Result := DATA_S_SAMEFORMATETC; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.GetData(const FormatEtcIn : TFormatEtc; out Medium : TStgMedium) : HResult; +// Data is requested by clipboard or drop target. This method dispatchs the call +// depending on the data being requested. +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) 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. + if tsClipboardFlushing in TBaseVirtualTree(FOwner).TreeStates then + Result := E_FAIL + else + 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; + 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 + if EqualFormatEtc(FormatEtcIn, FormatEtcArray[I]) then + begin + if not RenderInternalOLEData(FormatEtcIn, Medium, Result) then + Result := TVTCracker(FOwner).RenderOLEData(FormatEtcIn, Medium, FForClipboard); + Break; + end; + end; + end; + except + ZeroMemory(@Medium, SizeOf(Medium)); + Result := E_FAIL; + end; // try..except +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.GetDataHere(const FormatEtc : TFormatEtc; out Medium : TStgMedium) : HResult; +begin + Result := E_NOTIMPL; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.QueryGetData(const FormatEtc : TFormatEtc) : HResult; +var + I : Integer; +begin + Result := DV_E_CLIPFORMAT; + for I := 0 to High(FFormatEtcArray) do + begin + if FormatEtc.cfFormat = FFormatEtcArray[I].cfFormat then + begin + if (FormatEtc.tymed and FFormatEtcArray[I].tymed) <> 0 then + begin + if FormatEtc.dwAspect = FFormatEtcArray[I].dwAspect then + begin + if FormatEtc.lindex = FFormatEtcArray[I].lindex then + begin + Result := S_OK; + Break; + end + else + Result := DV_E_LINDEX; + end + else + Result := DV_E_DVASPECT; + end + else + Result := DV_E_TYMED; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDataObject.SetData(const FormatEtc : TFormatEtc; var Medium : TStgMedium; DoRelease : BOOL) : HResult; +// Allows dynamic adding to the IDataObject during its existance. Most noteably it is used to implement +// IDropSourceHelper and allows to set a special format for optimized moves during a shell transfer. +var + Index : Integer; + LocalStgMedium : PStgMedium; +begin + // See if we already have a format of that type available. + Index := FindFormatEtc(FormatEtc, FormatEtcArray); + if Index > - 1 then + begin + // Just use the TFormatEct in the array after releasing the data. + LocalStgMedium := FindInternalStgMedium(FormatEtcArray[Index].cfFormat); + if Assigned(LocalStgMedium) then + begin + ReleaseStgMedium(LocalStgMedium^); + ZeroMemory(LocalStgMedium, SizeOf(LocalStgMedium^)); + end; + end + else + begin + // It is a new format so create a new TFormatCollectionItem, copy the + // FormatEtc parameter into the new object and and put it in the list. + SetLength(FFormatEtcArray, Length(FormatEtcArray) + 1); + FormatEtcArray[High(FormatEtcArray)] := FormatEtc; + + // Create a new InternalStgMedium and initialize it and associate it with the format. + SetLength(FInternalStgMediumArray, Length(InternalStgMediumArray) + 1); + InternalStgMediumArray[High(InternalStgMediumArray)].Format := FormatEtc.cfFormat; + LocalStgMedium := @InternalStgMediumArray[High(InternalStgMediumArray)].Medium; + ZeroMemory(LocalStgMedium, SizeOf(LocalStgMedium^)); + end; + + if DoRelease then + begin + // We are simply being given the data and we take control of it. + LocalStgMedium^ := Medium; + Result := S_OK; + end + else + begin + // We need to reference count or copy the data and keep our own references to it. + Result := StgMediumIncRef(Medium, LocalStgMedium^, True, Self as IDataObject); + + // Can get a circular reference if the client calls GetData then calls SetData with the same StgMedium. + // Because the unkForRelease for the IDataObject can be marshalled it is necessary to get pointers that + // can be correctly compared. See the IDragSourceHelper article by Raymond Chen at MSDN. + if Assigned(LocalStgMedium.unkForRelease) then + begin + if CanonicalIUnknown(Self) = CanonicalIUnknown(IUnknown(LocalStgMedium.unkForRelease)) then + IUnknown(LocalStgMedium.unkForRelease) := nil; // release the interface + end; + end; + + // Tell all registered advice sinks about the data change. + if Assigned(FAdviseHolder) then + FAdviseHolder.SendOnDataChange(Self as IDataObject, 0, 0); +end; + +end. diff --git a/Source/VirtualTrees.DragImage.pas b/Source/VirtualTrees.DragImage.pas new file mode 100644 index 000000000..1aa3b8789 --- /dev/null +++ b/Source/VirtualTrees.DragImage.pas @@ -0,0 +1,139 @@ +unit VirtualTrees.DragImage; + +interface + +uses + WinApi.Windows, + WinApi.ActiveX, + System.Types, + Vcl.Controls, + Vcl.Graphics; + +{$MINENUMSIZE 1, make enumerations as small as possible} + + +type + // Drag image support for the tree. + TVTTransparency = 0 .. 255; + + // Simple move limitation for the drag image. + TVTDragMoveRestriction = ( + dmrNone, + dmrHorizontalOnly, + dmrVerticalOnly + ); + + 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. + ); + + // Class to manage header and tree drag image during a drag'n drop operation. + TVTDragImage = class + private + FOwner : TCustomControl; + FBackImage, // backup of overwritten screen area + FAlphaImage, // target for alpha blending + FDragImage : TBitmap; // the actual drag image to blend to screen + 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. + public + constructor Create(AOwner : TCustomControl); + destructor Destroy; override; + + procedure EndDrag; + procedure PrepareDrag(DragImage : TBitmap; HotSpot : TPoint; const DataObject: IDataObject; pColorKey: TColor = clWindow); + property MoveRestriction : TVTDragMoveRestriction read FRestriction write FRestriction default dmrNone; + end; + +implementation + +uses + WinApi.ShlObj, + WinApi.Messages, + System.SysUtils, + System.Math, + VirtualTrees.DragnDrop, + VirtualTrees.Types, + VirtualTrees.Utils, + VirtualTrees.BaseTree; + +//----------------- TVTDragImage --------------------------------------------------------------------------------------- + +constructor TVTDragImage.Create(AOwner : TCustomControl); +begin + FOwner := AOwner; + FRestriction := dmrNone; + FColorKey := clNone; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +destructor TVTDragImage.Destroy; +begin + EndDrag; + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTDragImage.EndDrag; +begin + FStates := FStates - [disInDrag, disPrepared]; + FBackImage.Free; + FBackImage := nil; + FDragImage.Free; + FDragImage := nil; + FAlphaImage.Free; + FAlphaImage := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +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. +// This method also determines whether the system supports drag images natively. If so then only minimal structures +// are created. + +var + Width, Height : Integer; + DragSourceHelper : IDragSourceHelper; + DragInfo : TSHDragImage; + lDragSourceHelper2 : IDragSourceHelper2; // Needed to get Windows Vista+ style drag hints. + lNullPoint : TPoint; +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 + lNullPoint := Point(0, 0); + if Supports(DragSourceHelper, IDragSourceHelper2, lDragSourceHelper2) then + lDragSourceHelper2.SetFlags(DSH_ALLOWDROPDESCRIPTIONTEXT); // Show description texts + // First let the system try to initialze the DragSourceHelper, this works fine for file system objects (CF_HDROP) + StandardOLEFormat.cfFormat := CF_HDROP; + if not Succeeded(DataObject.QueryGetData(StandardOLEFormat)) or not Succeeded(DragSourceHelper.InitializeFromWindow(0, lNullPoint, DataObject)) then + begin + // Supply the drag source helper with our drag image. + DragInfo.sizeDragImage.cx := Width; + DragInfo.sizeDragImage.cy := Height; + 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); + end; + end; + end; +end; + + +end. diff --git a/Source/VirtualTrees.DragnDrop.pas b/Source/VirtualTrees.DragnDrop.pas new file mode 100644 index 000000000..4eb54873e --- /dev/null +++ b/Source/VirtualTrees.DragnDrop.pas @@ -0,0 +1,377 @@ +unit VirtualTrees.DragnDrop; + +interface + +uses + WinApi.Windows, + WinApi.ActiveX, + WinApi.ShlObj, + System.Types, + Vcl.Graphics, + Vcl.Controls, + VirtualTrees.Types, + VirtualTrees.BaseTree, + VirtualTrees.Header; + +type + TEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc) + private + FFormatEtcArray : TFormatEtcArray; + FCurrentIndex : Integer; + public + constructor Create(const AFormatEtcArray : TFormatEtcArray); + + function Clone(out Enum : IEnumFormatEtc) : HResult; stdcall; + function Next(celt : Integer; out elt; pceltFetched : PLongint) : HResult; stdcall; + function Reset : HResult; stdcall; + function Skip(celt : Integer) : HResult; stdcall; + end; + + // TVTDragManager is a class to manage drag and drop in a Virtual Treeview. + TVTDragManager = class(TInterfacedObject, IVTDragManager, IDropSource, IDropTarget) + 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 + FFullDragging : BOOL; // True, if full dragging is currently enabled in the system. + + function GetDataObject : IDataObject; stdcall; + function GetDragSource : TBaseVirtualTree; stdcall; + function GetIsDropTarget : Boolean; stdcall; + public + constructor Create(AOwner : TBaseVirtualTree); virtual; + destructor Destroy; override; + + function DragEnter(const DataObject : IDataObject; KeyState : Integer; Pt : TPoint; var Effect : Longint) : HResult; stdcall; + function DragLeave : HResult; stdcall; + function DragOver(KeyState : Integer; Pt : TPoint; var Effect : Longint) : HResult; stdcall; + function Drop(const DataObject : IDataObject; KeyState : Integer; Pt : TPoint; var Effect : Integer) : HResult; stdcall; + 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 + StandardOLEFormat : TFormatEtc = ( + // Format must later be set. + cfFormat : 0; + // No specific target device to render on. + ptd : nil; + // Normal content to render. + dwAspect : DVASPECT_CONTENT; + // No specific page of multipage data (we don't use multipage data by default). + lindex : - 1; + // Acceptable storage formats are IStream and global memory. The first is preferred. + tymed : TYMED_ISTREAM or TYMED_HGLOBAL; + ); + +implementation + +uses + VirtualTrees.Clipboard, + VirtualTrees.DataObject; + +type + TBaseVirtualTreeCracker = class(TBaseVirtualTree); + + TVTDragManagerHelper = class helper for TVTDragManager + function TreeView : TBaseVirtualTreeCracker; + end; + + + //----------------- TEnumFormatEtc ------------------------------------------------------------------------------------- + +constructor TEnumFormatEtc.Create(const AFormatEtcArray : TFormatEtcArray); +var + I : Integer; +begin + inherited Create; + // Make a local copy of the format data. + SetLength(FFormatEtcArray, Length(AFormatEtcArray)); + for I := 0 to High(AFormatEtcArray) do + FFormatEtcArray[I] := AFormatEtcArray[I]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TEnumFormatEtc.Clone(out Enum : IEnumFormatEtc) : HResult; +var + AClone : TEnumFormatEtc; +begin + Result := S_OK; + try + AClone := TEnumFormatEtc.Create(FFormatEtcArray); + AClone.FCurrentIndex := FCurrentIndex; + Enum := AClone as IEnumFormatEtc; + except + Result := E_FAIL; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TEnumFormatEtc.Next(celt : Integer; out elt; pceltFetched : PLongint) : HResult; +var + CopyCount : Integer; +begin + Result := S_FALSE; + CopyCount := Length(FFormatEtcArray) - FCurrentIndex; + if celt < CopyCount then + CopyCount := celt; + if CopyCount > 0 then + begin + Move(FFormatEtcArray[FCurrentIndex], elt, CopyCount * SizeOf(TFormatEtc)); + Inc(FCurrentIndex, CopyCount); + Result := S_OK; + end; + if Assigned(pceltFetched) then + pceltFetched^ := CopyCount; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TEnumFormatEtc.Reset : HResult; +begin + FCurrentIndex := 0; + Result := S_OK; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TEnumFormatEtc.Skip(celt : Integer) : HResult; +begin + if FCurrentIndex + celt < High(FFormatEtcArray) then + begin + Inc(FCurrentIndex, celt); + Result := S_OK; + end + else + Result := S_FALSE; +end; + + +//---------------------------------------------------------------------------------------------------------------------- + +// OLE drag and drop support classes +// This is quite heavy stuff (compared with the VCL implementation) but is much better suited to fit the needs +// of DD'ing various kinds of virtual data and works also between applications. + + +//----------------- TVTDragManager ------------------------------------------------------------------------------------- + +constructor TVTDragManager.Create(AOwner : TBaseVirtualTree); +begin + inherited Create; + FOwner := AOwner; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +destructor TVTDragManager.Destroy; +begin + // Set the owner's reference to us to nil otherwise it will access an invalid pointer + // after our desctruction is complete. + TreeView.ClearDragManager; + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDragManager.GetDataObject : IDataObject; +begin + // When the owner tree starts a drag operation then it gets a data object here to pass it to the OLE subsystem. + // In this case there is no local reference to a data object and one is created (but not stored). + // If there is a local reference then the owner tree is currently the drop target and the stored interface is + // that of the drag initiator. + if Assigned(FDataObject) then + Result := FDataObject + else + begin + Result := TreeView.DoCreateDataObject; + if (Result = nil) and not Assigned(TreeView.OnCreateDataObject) then + // Do not create a TVTDataObject if the event handler explicitely decided not to supply one, issue #736. + Result := TVTDataObject.Create(FOwner, False) as IDataObject; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDragManager.GetDragSource : TBaseVirtualTree; +begin + Result := FDragSource; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDragManager.GetIsDropTarget : Boolean; +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; + + SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @FFullDragging, 0); + // If full dragging of window contents is disabled in the system then our tree windows will be locked + // and cannot be updated during a drag operation. With the following call painting is again enabled. + if not FFullDragging then + LockWindowUpdate(0); + if Assigned(FDropTargetHelper) and FFullDragging then + begin + 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 := 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; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDragManager.DragLeave : HResult; +begin + if Assigned(FDropTargetHelper) and FFullDragging then + FDropTargetHelper.DragLeave; + + if (toAcceptOLEDrop in TreeView.TreeOptions.MiscOptions) then + TreeView.DragLeave; + FIsDropTarget := False; + FDragSource := nil; + FDataObject := nil; + fHeader := nil; + Result := NOERROR; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDragManager.DragOver(KeyState : Integer; Pt : TPoint; var Effect : Integer) : HResult; +begin + if Assigned(FDropTargetHelper) and FFullDragging then + FDropTargetHelper.DragOver(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; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDragManager.Drop(const DataObject : IDataObject; KeyState : Integer; Pt : TPoint; var Effect : Integer) : HResult; +begin + if Assigned(FDropTargetHelper) and FFullDragging then + FDropTargetHelper.Drop(DataObject, 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; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTDragManager.ForceDragLeave; +// Some drop targets, e.g. Internet Explorer leave a drag image on screen instead removing it when they receive +// a drop action. This method calls the drop target helper's DragLeave method to ensure it removes the drag image from +// screen. Unfortunately, sometimes not even this does help (e.g. when dragging text from VT to a text field in IE). +begin + if Assigned(FDropTargetHelper) and FFullDragging then + FDropTargetHelper.DragLeave; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDragManager.GiveFeedback(Effect : Integer) : HResult; +begin + Result := DRAGDROP_S_USEDEFAULTCURSORS; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTDragManager.QueryContinueDrag(EscapePressed : BOOL; KeyState : Integer) : HResult; +var + RButton, LButton : Boolean; +begin + LButton := (KeyState and MK_LBUTTON) <> 0; + RButton := (KeyState and MK_RBUTTON) <> 0; + + // Drag'n drop canceled by pressing both mouse buttons or Esc? + if (LButton and RButton) or EscapePressed then + Result := DRAGDROP_S_CANCEL + else + // Drag'n drop finished? + if not (LButton or RButton) then + Result := DRAGDROP_S_DROP + else + Result := S_OK; +end; + +{ TVTDragManagerHelper } + +function TVTDragManagerHelper.TreeView : TBaseVirtualTreeCracker; +begin + Result := TBaseVirtualTreeCracker(FOwner); +end; + +end. diff --git a/Source/VirtualTrees.DrawTree.pas b/Source/VirtualTrees.DrawTree.pas new file mode 100644 index 000000000..0fb1e38d4 --- /dev/null +++ b/Source/VirtualTrees.DrawTree.pas @@ -0,0 +1,354 @@ +unit VirtualTrees.DrawTree; + +interface + +uses + System.Types, + System.Classes, + Vcl.Themes, + VirtualTrees.Types, + VirtualTrees.BaseTree, +{$IFDEF VT_FMX} + VirtualTrees.AncestorFMX, +{$ELSE} + VirtualTrees.AncestorVCL +{$ENDIF} + ; + +type +{$IFDEF VT_FMX} + TVTAncestor = TVTAncestorFMX; +{$ELSE} + TVTAncestor = TVTAncestorVcl; +{$ENDIF} + + // Tree descendant to let an application draw its stuff itself. + TCustomVirtualDrawTree = class(TVTAncestor) + private + FOnDrawNode: TVTDrawNodeEvent; + FOnGetCellContentMargin: TVTGetCellContentMarginEvent; + FOnGetNodeWidth: TVTGetNodeWidthEvent; + protected + function DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; + CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; override; + function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; override; + procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override; + function GetDefaultHintKind: TVTHintKind; override; + + property OnDrawNode: TVTDrawNodeEvent read FOnDrawNode write FOnDrawNode; + property OnGetCellContentMargin: TVTGetCellContentMarginEvent read FOnGetCellContentMargin write FOnGetCellContentMargin; + property OnGetNodeWidth: TVTGetNodeWidthEvent read FOnGetNodeWidth write FOnGetNodeWidth; + end; + + {$if CompilerVersion >= 33} + [ComponentPlatformsAttribute(pfidWindows)] + {$ifend} + TVirtualDrawTree = class(TCustomVirtualDrawTree) + private + function GetOptions: TVirtualTreeOptions; + procedure SetOptions(const Value: TVirtualTreeOptions); + protected + function GetOptionsClass: TTreeOptionsClass; override; + public + property Canvas; + property LastDragEffect; + property CheckImageKind; // should no more be published to make #622 fix working + published + property Action; + property Align; + property Alignment; + property Anchors; + property AnimationDuration; + property AutoExpandDelay; + property AutoScrollDelay; + property AutoScrollInterval; + property Background; + property BackgroundOffsetX; + property BackgroundOffsetY; + property BiDiMode; + property BevelEdges; + property BevelInner; + property BevelOuter; + property BevelKind; + property BevelWidth; + property BorderStyle; + property BottomSpace; + property ButtonFillMode; + property ButtonStyle; + property BorderWidth; + property ChangeDelay; + property ClipboardFormats; + property Color; + property Colors; + property Constraints; + property Ctl3D; + property CustomCheckImages; + property DefaultNodeHeight; + property DefaultPasteMode; + property DragCursor; + property DragHeight; + property DragKind; + property DragImageKind; + property DragMode; + property DragOperations; + property DragType; + property DragWidth; + property DrawSelectionMode; + property EditDelay; + property Enabled; + property Font; + property Header; + property HintMode; + property HotCursor; + property Images; + property IncrementalSearch; + property IncrementalSearchDirection; + property IncrementalSearchStart; + property IncrementalSearchTimeout; + property Indent; + property LineMode; + property LineStyle; + property Margin; + property NodeAlignment; + property NodeDataSize; + property OperationCanceled; + property ParentBiDiMode; + property ParentColor default False; + property ParentCtl3D; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property RootNodeCount; + property ScrollBarOptions; + property SelectionBlendFactor; + property SelectionCurveRadius; + property ShowHint; + property StateImages; + property TabOrder; + property TabStop default True; + property TextMargin; + property TreeOptions: TVirtualTreeOptions read GetOptions write SetOptions; + property Visible; + property WantTabs; + + property OnAddToSelection; + property OnAdvancedHeaderDraw; + property OnAfterAutoFitColumn; + property OnAfterAutoFitColumns; + property OnAfterCellPaint; + property OnAfterColumnExport; + property OnAfterColumnWidthTracking; + property OnAfterGetMaxColumnWidth; + property OnAfterHeaderExport; + property OnAfterHeaderHeightTracking; + property OnAfterItemErase; + property OnAfterItemPaint; + property OnAfterNodeExport; + property OnAfterPaint; + property OnAfterTreeExport; + property OnBeforeAutoFitColumn; + property OnBeforeAutoFitColumns; + property OnBeforeCellPaint; + property OnBeforeColumnExport; + property OnBeforeColumnWidthTracking; + property OnBeforeDrawTreeLine; + property OnBeforeGetMaxColumnWidth; + property OnBeforeHeaderExport; + property OnBeforeHeaderHeightTracking; + property OnBeforeItemErase; + property OnBeforeItemPaint; + property OnBeforeNodeExport; + property OnBeforePaint; + property OnBeforeTreeExport; + property OnCanSplitterResizeColumn; + property OnCanSplitterResizeHeader; + property OnCanSplitterResizeNode; + property OnChange; + property OnChecked; + property OnChecking; + property OnClick; + property OnCollapsed; + property OnCollapsing; + property OnColumnChecked; + property OnColumnChecking; + property OnColumnClick; + property OnColumnDblClick; + property OnColumnExport; + property OnColumnResize; + property OnColumnVisibilityChanged; + property OnColumnWidthDblClickResize; + property OnColumnWidthTracking; + property OnCompareNodes; + property OnContextPopup; + property OnCreateDataObject; + property OnCreateDragManager; + property OnCreateEditor; + property OnDblClick; + property OnDragAllowed; + property OnDragOver; + property OnDragDrop; + property OnDrawHint; + property OnDrawNode; + property OnEdited; + property OnEditing; + property OnEndDock; + property OnEndDrag; + property OnEndOperation; + property OnEnter; + property OnExit; + property OnExpanded; + property OnExpanding; + property OnFocusChanged; + property OnFocusChanging; + property OnFreeNode; + property OnGetCellIsEmpty; + property OnGetCursor; + property OnGetHeaderCursor; + property OnGetHelpContext; + property OnGetHintKind; + property OnGetHintSize; + property OnGetImageIndex; + property OnGetImageIndexEx; + property OnGetLineStyle; + property OnGetNodeDataSize; + property OnGetNodeWidth; + property OnGetPopupMenu; + property OnGetUserClipboardFormats; + property OnHeaderAddPopupItem; + property OnHeaderClick; + property OnHeaderDblClick; + property OnHeaderDragged; + property OnHeaderDraggedOut; + property OnHeaderDragging; + property OnHeaderDraw; + property OnHeaderDrawQueryElements; + property OnHeaderHeightTracking; + property OnHeaderHeightDblClickResize; + property OnHeaderMouseDown; + property OnHeaderMouseMove; + property OnHeaderMouseUp; + property OnHotChange; + property OnIncrementalSearch; + property OnInitChildren; + property OnInitNode; + property OnKeyAction; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnLoadNode; + property OnLoadTree; + property OnMeasureItem; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnNodeClick; + property OnNodeCopied; + property OnNodeCopying; + property OnNodeDblClick; + property OnNodeExport; + property OnNodeHeightTracking; + property OnNodeHeightDblClickResize; + property OnNodeMoved; + property OnNodeMoving; + property OnPaintBackground; + property OnPrepareButtonBitmaps; + property OnRemoveFromSelection; + property OnRenderOLEData; + property OnResetNode; + property OnResize; + property OnSaveNode; + property OnSaveTree; + property OnScroll; + property OnShowScrollBar; + property OnStartDock; + property OnStartDrag; + property OnStartOperation; + property OnStateChange; + property OnStructureChange; + property OnUpdating; + property OnCanResize; + property OnGesture; + property Touch; + property StyleElements; + end; + + +implementation + +uses + VirtualTrees.StyleHooks; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCustomVirtualDrawTree.DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; + CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; + +begin + Result := Point(0, 0); + if Canvas = nil then + Canvas := Self.Canvas; + + if Assigned(FOnGetCellContentMargin) then + FOnGetCellContentMargin(Self, Canvas, Node, Column, CellContentMarginType, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCustomVirtualDrawTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; + +begin + Result := 2 * TextMargin; + if Canvas = nil then + Canvas := Self.Canvas; + + if Assigned(FOnGetNodeWidth) then + FOnGetNodeWidth(Self, Canvas, Node, Column, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCustomVirtualDrawTree.DoPaintNode(var PaintInfo: TVTPaintInfo); + +begin + if Assigned(FOnDrawNode) then + FOnDrawNode(Self, PaintInfo); +end; + +function TCustomVirtualDrawTree.GetDefaultHintKind: TVTHintKind; + +begin + Result := vhkOwnerDraw; +end; + +//----------------- TVirtualDrawTree ----------------------------------------------------------------------------------- + +function TVirtualDrawTree.GetOptions: TVirtualTreeOptions; + +begin + Result := inherited TreeOptions as TVirtualTreeOptions; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualDrawTree.SetOptions(const Value: TVirtualTreeOptions); + +begin + TreeOptions.Assign(Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualDrawTree.GetOptionsClass: TTreeOptionsClass; + +begin + Result := TVirtualTreeOptions; +end; + +initialization + TCustomStyleEngine.RegisterStyleHook(TVirtualDrawTree, TVclStyleScrollBarsHook); + +finalization + TCustomStyleEngine.UnRegisterStyleHook(TVirtualDrawTree, TVclStyleScrollBarsHook); + +end. diff --git a/Source/VirtualTrees.EditLink.pas b/Source/VirtualTrees.EditLink.pas new file mode 100644 index 000000000..6af02dd35 --- /dev/null +++ b/Source/VirtualTrees.EditLink.pas @@ -0,0 +1,905 @@ +unit VirtualTrees.EditLink; + +// Base class for inplace node editors implementing IVTEditLink interface +// and default node editor. + +interface + +uses + WinApi.Messages, + System.Types, + System.Classes, + Vcl.Controls, + Vcl.StdCtrls, + VirtualTrees, + VirtualTrees.Types, + VirtualTrees.BaseTree; + +type + //Edit support Classes. + TStringEditLink = class; + + TVTEdit = class(TCustomEdit) + private + procedure CMAutoAdjust(var Message : TMessage); message CM_AUTOADJUST; + procedure CMExit(var Message : TMessage); message CM_EXIT; + procedure CMRelease(var Message : TMessage); message CM_RELEASE; + procedure CNCommand(var Message : TWMCommand); message CN_COMMAND; + procedure WMChar(var Message : TWMChar); message WM_CHAR; + procedure WMDestroy(var Message : TWMDestroy); message WM_DESTROY; + procedure WMGetDlgCode(var Message : TWMGetDlgCode); message WM_GETDLGCODE; + procedure WMKeyDown(var Message : TWMKeyDown); message WM_KEYDOWN; + protected + FRefLink : IVTEditLink; + FLink : TStringEditLink; + procedure AutoAdjustSize; virtual; + function CalcMinHeight : Integer; virtual; + procedure CreateParams(var Params : TCreateParams); override; + function GetTextSize : TSize; virtual; + procedure KeyPress(var Key : Char); override; + public + constructor Create(Link : TStringEditLink); reintroduce; + procedure ClearLink; + procedure ClearRefLink; + procedure Release; virtual; + + property AutoSelect; + property AutoSize; + property BorderStyle; + property CharCase; + property HideSelection; + property MaxLength; + property OEMConvert; + property PasswordChar; + end; + + TBaseEditLink = class; + + TEditLinkEditEvent = procedure (Sender: TBaseEditLink; var Result: Boolean) of object; + TEditLinkPrepareEditEvent = procedure (Sender: TBaseEditLink; var Edit: TControl; var Result: Boolean) of object; + + // Most abstract base class for implementing IVTEditLink. + // Knows almost nothing about associated Edit control and doesn't perform any + // actions on it. Contains some properties that are not used directly but could + // be useful in descendant classes. Follows general extension approach - all + // IVTEditLink methods are virtual and most of them call DoXXX virtual methods + // which in turn call event handlers so these extension options possible: + // - overriding main API methods to run additional actions before, after or + // instead of basic class code. + // (+) Lesser modification of existing classes + // (-) Event handlers are already launched after calling parent method + // (-) It's critical to check Result of parent method and exit immediately + // on False - this value means no action is done. + // (-) Returning Result is necessary + // - overriding DoXXX methods to run additional actions inside basic class code + // (+) No need in returning - lesser boilerplate code + // (-) Should call inherited to launch event handlers (OK if not using them) + // - assign event handlers in end-user code + // (+) Access to external classes with data to copy to EditLink editor. + // (-) Lesser encapsulation + TBaseEditLink = class(TInterfacedObject, IVTEditLink) + strict protected + FEdit: TControl; // One of the property editor classes. + FTree : TCustomVirtualStringTree; //A back reference to the tree calling. + FNode : PVirtualNode; //The node to be edited. + FColumn : TColumnIndex; //The column of the node. + FStopping : Boolean; //Set to True when the edit link requests stopping the edit action. + FAlignment : TAlignment; + FBiDiMode: TBiDiMode; + + // custom event handlers + FOnPrepareEdit: TEditLinkPrepareEditEvent; + FOnBeginEdit, + FOnEndEdit, + FOnCancelEdit: TEditLinkEditEvent; + + procedure SetEdit(const Value : TControl); //Setter for the FEdit member; + public + // IVTEditLink API + function BeginEdit : Boolean; virtual; stdcall; + function CancelEdit : Boolean; virtual; stdcall; + function EndEdit : Boolean; virtual; stdcall; + function GetBounds : TRect; virtual; stdcall; abstract; + function PrepareEdit(Tree : TBaseVirtualTree; Node : PVirtualNode; Column : TColumnIndex) : Boolean; virtual; stdcall; + procedure ProcessMessage(var Message : TMessage); virtual; stdcall; abstract; + procedure SetBounds(R : TRect); virtual; stdcall; abstract; + + // Methods to plug custom actions into main ones. In base class only call event handlers. + // Descendants may modify Result to cancel further flow. + procedure DoBeginEdit(var Result: Boolean); virtual; + procedure DoCancelEdit(var Result: Boolean); virtual; + procedure DoEndEdit(var Result: Boolean); virtual; + procedure DoPrepareEdit(var Result: Boolean); virtual; + + property Alignment : TAlignment read FAlignment; + property BiDiMode: TBiDiMode read FBiDiMode; + property Column : TColumnIndex read FColumn; //[IPK] Make Column(Index) accessible + property Node : PVirtualNode read FNode; //[IPK] Make FNode accessible + property Tree : TCustomVirtualStringTree read FTree; + property Stopping : Boolean read FStopping; + + property OnBeginEdit: TEditLinkEditEvent read FOnBeginEdit write FOnBeginEdit; + property OnCancelEdit: TEditLinkEditEvent read FOnCancelEdit write FOnCancelEdit; + property OnEndEdit: TEditLinkEditEvent read FOnEndEdit write FOnEndEdit; + property OnPrepareEdit: TEditLinkPrepareEditEvent read FOnPrepareEdit write FOnPrepareEdit; + end; + + // Edit link that has TWinControl-based Edit. Performs visibility and focus actions, + // transfers window messages to Edit control. + TWinControlEditLink = class(TBaseEditLink) + protected + function GetEdit: TWinControl; //Getter for the FEdit member; + procedure SetEdit(const Value : TWinControl); //Setter for the FEdit member; + public + destructor Destroy; override; + + function BeginEdit : Boolean; override; stdcall; + function CancelEdit : Boolean; override; stdcall; + function EndEdit : Boolean; override; stdcall; + function GetBounds : TRect; override; stdcall; + procedure ProcessMessage(var Message : TMessage); override; stdcall; + + property Edit : TWinControl read GetEdit write SetEdit; + end; + + // Edit link that implements default node text editor. + TStringEditLink = class(TWinControlEditLink) + protected + FTextBounds : TRect; //Smallest rectangle around the text. + function GetEdit: TVTEdit; //Getter for the FEdit member; + procedure SetEdit(const Value : TVTEdit); //Setter for the FEdit member; + + procedure InitializeSelection; virtual; + public + constructor Create; + + function BeginEdit : Boolean; override; stdcall; + function CancelEdit : Boolean; override; stdcall; + function EndEdit : Boolean; override; stdcall; + function PrepareEdit(Tree : TBaseVirtualTree; Node : PVirtualNode; Column : TColumnIndex) : Boolean; override; stdcall; + procedure SetBounds(R : TRect); override; stdcall; + + property Edit : TVTEdit read GetEdit write SetEdit; + end; + +implementation + +uses + WinApi.Windows, + System.SysUtils, + System.Math, + Vcl.Graphics, + Vcl.Forms; + +type + TCustomVirtualStringTreeCracker = class(TCustomVirtualStringTree); + +//----------------- TVTEdit -------------------------------------------------------------------------------------------- + +//Implementation of a generic node caption editor. + +constructor TVTEdit.Create(Link : TStringEditLink); +begin + inherited Create(nil); + if not Assigned(Link) then + raise EArgumentException.Create('Parameter Link must not be nil.'); + ShowHint := False; + ParentShowHint := False; + //This assignment increases the reference count for the interface. + FRefLink := Link; + //This reference is used to access the link. + FLink := Link; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.ClearLink; +begin + FLink := nil +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.ClearRefLink; +begin + FRefLink := nil +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTEdit.CalcMinHeight : Integer; +var + textHeight : Integer; +begin + //Get the actual text height. + textHeight := GetTextSize.cy; + //The minimal height is the actual text height in pixels plus the the non client area. + Result := textHeight + (Height - ClientHeight); + //Also, proportionally to the text size, additional pixel(s) needs to be added for the caret. + Result := Result + Trunc(textHeight * 0.05); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.CMAutoAdjust(var Message : TMessage); +begin + AutoAdjustSize; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.CMExit(var Message : TMessage); +begin + if Assigned(FLink) and not FLink.Stopping then + with TCustomVirtualStringTreeCracker(FLink.Tree) do + begin + if (toAutoAcceptEditChange in TreeOptions.StringOptions) then + DoEndEdit + else + DoCancelEdit; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.CMRelease(var Message : TMessage); +begin + Free; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.CNCommand(var Message : TWMCommand); +begin + if Assigned(FLink) and Assigned(FLink.Tree) and (Message.NotifyCode = EN_UPDATE) and not (vsMultiline in FLink.Node.States) then + //Instead directly calling AutoAdjustSize it is necessary on Win9x/Me to decouple this notification message + //and eventual resizing. Hence we use a message to accomplish that. + AutoAdjustSize() + else + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.WMChar(var Message : TWMChar); +begin + if not (Message.CharCode in [VK_ESCAPE, VK_TAB]) then + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.WMDestroy(var Message : TWMDestroy); +begin + //If editing stopped by other means than accept or cancel then we have to do default processing for + //pending changes. + if Assigned(FLink) and not FLink.Stopping and not (csRecreating in Self.ControlState) then + begin + with TCustomVirtualStringTreeCracker(FLink.Tree) do + begin + if (toAutoAcceptEditChange in TreeOptions.StringOptions) and Modified then + Text[FLink.Node, FLink.Column] := FLink.Edit.Text; + end; + FLink := nil; + FRefLink := nil; + end; + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.WMGetDlgCode(var Message : TWMGetDlgCode); +begin + inherited; + + Message.Result := Message.Result or DLGC_WANTALLKEYS or DLGC_WANTTAB or DLGC_WANTARROWS; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.WMKeyDown(var Message : TWMKeyDown); +//Handles some control keys. + +var + Shift : TShiftState; + EndEdit : Boolean; + Tree : TBaseVirtualTree; + NextNode : PVirtualNode; + ColumnCandidate : Integer; + EditOptions : TVTEditOptions; + Column : TVirtualTreeColumn; +begin + Tree := FLink.Tree; + case Message.CharCode of + VK_ESCAPE : + begin + TCustomVirtualStringTreeCracker(Tree).DoCancelEdit; + end; + VK_RETURN : + begin + EndEdit := not (vsMultiline in FLink.Node.States); + if not EndEdit then + begin + //If a multiline node is being edited the finish editing only if Ctrl+Enter was pressed, + //otherwise allow to insert line breaks into the text. + Shift := KeyDataToShiftState(Message.KeyData); + EndEdit := ssCtrl in Shift; + end; + if EndEdit then + begin + Tree := FLink.Tree; + FLink.Tree.InvalidateNode(FLink.Node); + NextNode := Tree.GetNextVisible(FLink.Node, True); + TCustomVirtualStringTreeCracker(FLink.Tree).DoEndEdit; + + //get edit options for column as priority. If column has toDefaultEdit + //use global edit options for tree + EditOptions := TCustomVirtualStringTreeCracker(Tree).TreeOptions.EditOptions; //default + ColumnCandidate := - 1; + if Tree.Header.Columns.Count > 0 then //are there any columns? + begin + Column := Tree.Header.Columns[Tree.FocusedColumn]; + if Column.EditOptions <> toDefaultEdit then + EditOptions := Column.EditOptions; + + //next column candidate for toVerticalEdit and toHorizontalEdit + if Column.EditNextColumn <> - 1 then + ColumnCandidate := Column.EditNextColumn; + end; + + case EditOptions of + toDefaultEdit : + TCustomVirtualStringTreeCracker(Tree).TrySetFocus; + toVerticalEdit : + if NextNode <> nil then + begin + Tree.FocusedNode := NextNode; + + //for toVerticalEdit ColumnCandidate is also proper, + //select ColumnCandidate column in row below + if ColumnCandidate <> - 1 then + begin + Tree.FocusedColumn := ColumnCandidate; + TCustomVirtualStringTreeCracker(Tree).EditColumn := ColumnCandidate; + end; + + if Tree.CanEdit(Tree.FocusedNode, Tree.FocusedColumn) then + TCustomVirtualStringTreeCracker(Tree).DoEdit; + end; + toHorizontalEdit : + begin + if ColumnCandidate = - 1 then + begin + //for toHorizontalEdit if property EditNextColumn is not used + //try to use just next column + ColumnCandidate := Tree.FocusedColumn + 1; + while (ColumnCandidate < Tree.Header.Columns.Count) and not Tree.CanEdit(Tree.FocusedNode, ColumnCandidate) do + Inc(ColumnCandidate); + end + else if not Tree.CanEdit(Tree.FocusedNode, ColumnCandidate) then + ColumnCandidate := Tree.Header.Columns.Count; //omit "focus/edit column" (see below) + + if ColumnCandidate < Tree.Header.Columns.Count then + begin + Tree.FocusedColumn := ColumnCandidate; + TCustomVirtualStringTreeCracker(Tree).EditColumn := ColumnCandidate; + TCustomVirtualStringTreeCracker(Tree).DoEdit; + end; + end; + end; + end; + end; + VK_UP : + begin + if not (vsMultiline in FLink.Node.States) then + Message.CharCode := VK_LEFT; + inherited; + end; + VK_DOWN : + begin + if not (vsMultiline in FLink.Node.States) then + Message.CharCode := VK_RIGHT; + inherited; + end; + VK_TAB : + begin + if Tree.IsEditing then + begin + Tree.InvalidateNode(FLink.Node); + if ssShift in KeyDataToShiftState(Message.KeyData) then + NextNode := Tree.GetPreviousVisible(FLink.Node, True)//Shift+Tab goes to previous mode + else + NextNode := Tree.GetNextVisible(FLink.Node, True); + Tree.EndEditNode; + //check NextNode, otherwise we got AV + if NextNode <> nil then + begin + //Continue editing next node + Tree.ClearSelection(); + Tree.Selected[NextNode] := True; + if Tree.CanEdit(Tree.FocusedNode, Tree.FocusedColumn) then + TCustomVirtualStringTreeCracker(Tree).DoEdit; + end; + end; + end; + Ord('A') : + begin + if Tree.IsEditing and ([ssCtrl] = KeyboardStateToShiftState) then + begin + Self.SelectAll(); + Message.CharCode := 0; + end; + end; + else + inherited; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.AutoAdjustSize; +//Changes the size of the edit to accomodate as much as possible of its text within its container window. +//NewChar describes the next character which will be added to the edit's text. + +var + Size : TSize; +begin + if not (vsMultiline in FLink.Node.States) and not (toGridExtensions in TCustomVirtualStringTreeCracker(FLink.Tree).TreeOptions.MiscOptions { see issue #252 } ) then + begin + //avoid flicker + SendMessage(Handle, WM_SETREDRAW, 0, 0); + try + Size := GetTextSize; + Inc(Size.cx, 2 * TCustomVirtualStringTreeCracker(FLink.Tree).TextMargin); + //Repaint associated node if the edit becomes smaller. + if Size.cx < Width then + FLink.Tree.Invalidate(); + + if FLink.Alignment = taRightJustify then + FLink.SetBounds(Rect(Left + Width - Size.cx, Top, Left + Width, Top + Max(Size.cy, Height))) + else + FLink.SetBounds(Rect(Left, Top, Left + Size.cx, Top + Max(Size.cy, Height))); + finally + SendMessage(Handle, WM_SETREDRAW, 1, 0); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.CreateParams(var Params : TCreateParams); +begin + inherited; + if not Assigned(FLink.Node) then + exit; //Prevent AV exceptions occasionally seen in code below + + //Only with multiline style we can use the text formatting rectangle. + //This does not harm formatting as single line control, if we don't use word wrapping. + with Params do + begin + Style := Style or ES_MULTILINE; + if vsMultiline in FLink.Node.States then + Style := Style and not (ES_AUTOHSCROLL or WS_HSCROLL) or WS_VSCROLL or ES_AUTOVSCROLL; + if tsUseThemes in FLink.Tree.TreeStates then + begin + Style := Style and not WS_BORDER; + ExStyle := ExStyle or WS_EX_CLIENTEDGE; + end + else + begin + Style := Style or WS_BORDER; + ExStyle := ExStyle and not WS_EX_CLIENTEDGE; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTEdit.GetTextSize : TSize; +var + DC : HDC; + LastFont : THandle; +begin + DC := GetDC(Handle); + LastFont := SelectObject(DC, Font.Handle); + try + //Read needed space for the current text. + GetTextExtentPoint32(DC, PChar(Text + 'yG'), Length(Text) + 2, Result); + finally + SelectObject(DC, LastFont); + ReleaseDC(Handle, DC); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- +procedure TVTEdit.KeyPress(var Key : Char); +begin + if (Key = #13) and Assigned(FLink) and not (vsMultiline in FLink.Node.States) then + Key := #0; //Filter out return keys as they will be added to the text, avoids #895 + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTEdit.Release; +begin + if HandleAllocated then + PostMessage(Handle, CM_RELEASE, 0, 0); +end; + +//----------------- TBaseEditLink -------------------------------------------------------------------------------------- + +procedure TBaseEditLink.SetEdit(const Value : TControl); +begin + if Assigned(FEdit) then + FEdit.Free; + FEdit := Value; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseEditLink.BeginEdit : Boolean; +//Notifies the edit link that editing can start now. descendants may cancel node edit +//by returning False. + +begin + Result := not FStopping; + if Result then + DoBeginEdit(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseEditLink.CancelEdit : Boolean; + +// Performs edit cancelling. + +begin + Result := not FStopping; + if Result then + begin + // Let descendants cancel the cancel + DoCancelEdit(Result); + if not Result then + Exit; + FStopping := True; + FTree.CancelEditNode; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseEditLink.EndEdit : Boolean; + +// Performs edit ending. + +begin + Result := not FStopping; + if Result then + begin + // Let descendants cancel the end + DoEndEdit(Result); + if not Result then + Exit; + FStopping := True; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseEditLink.PrepareEdit(Tree : TBaseVirtualTree; Node : PVirtualNode; Column : TColumnIndex) : Boolean; + +// Performs general init: assign Tree, Node, Column, other properties; destroys previous +// edit instance. + +begin + Result := Tree is TCustomVirtualStringTree; + if not Result then Exit; // should not happen + + FTree := Tree as TCustomVirtualStringTree; + FNode := Node; + FColumn := Column; + if Column <= NoColumn then + begin + FBidiMode := FTree.BidiMode; + FAlignment := TCustomVirtualStringTreeCracker(FTree).Alignment; + end + else + begin + FBidiMode := FTree.Header.Columns[Column].BidiMode; + FAlignment := FTree.Header.Columns[Column].Alignment; + end; + SetEdit(nil); // always dispose edit + + DoPrepareEdit(Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseEditLink.DoBeginEdit(var Result: Boolean); +begin + if Assigned(OnBeginEdit) then + OnBeginEdit(Self, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseEditLink.DoCancelEdit(var Result: Boolean); +begin + if Assigned(OnCancelEdit) then + OnCancelEdit(Self, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseEditLink.DoEndEdit(var Result: Boolean); +begin + if Assigned(OnEndEdit) then + OnEndEdit(Self, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TBaseEditLink.DoPrepareEdit(var Result: Boolean); +begin + if Assigned(OnPrepareEdit) then + OnPrepareEdit(Self, FEdit, Result); +end; + +//----------------- TWinControlEditLink ------------------------------------------------------------------------------------ + +destructor TWinControlEditLink.Destroy; +begin + //FEdit.Free; casues issue #357. Fix: + if Assigned(FEdit) and Edit.HandleAllocated then + PostMessage(Edit.Handle, CM_RELEASE, 0, 0); + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TWinControlEditLink.GetEdit: TWinControl; +begin + Result := TWinControl(FEdit); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TWinControlEditLink.SetEdit(const Value: TWinControl); +begin + inherited SetEdit(Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TWinControlEditLink.BeginEdit: Boolean; +begin + Result := inherited; + if Result then + begin + Edit.Show; + Edit.SetFocus; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TWinControlEditLink.CancelEdit: Boolean; +begin + Result := inherited; + if Result then + begin + Edit.Hide; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TWinControlEditLink.GetBounds : TRect; +begin + Result := FEdit.BoundsRect; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TWinControlEditLink.ProcessMessage(var Message : TMessage); +begin + FEdit.WindowProc(Message); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TWinControlEditLink.EndEdit: Boolean; +begin + Result := inherited; + if Result then + begin + Edit.Hide; + end; +end; + +//----------------- TStringEditLink ------------------------------------------------------------------------------------ + +constructor TStringEditLink.Create; +begin + inherited; + FEdit := TVTEdit.Create(Self); + with Edit do + begin + Visible := False; + BorderStyle := bsSingle; + AutoSize := False; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TStringEditLink.GetEdit: TVTEdit; +begin + Result := TVTEdit(FEdit); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TStringEditLink.InitializeSelection; +begin + Edit.SelectAll; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TStringEditLink.SetEdit(const Value : TVTEdit); +begin + inherited SetEdit(Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TStringEditLink.BeginEdit : Boolean; +begin + Result := inherited; + if Result then + begin + InitializeSelection; + Edit.AutoAdjustSize; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TStringEditLink.CancelEdit : Boolean; +begin + Result := inherited; + if Result then + begin + Edit.ClearLink; + Edit.ClearRefLink; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TStringEditLink.EndEdit : Boolean; +begin + Result := inherited; + if Result then + try + if Edit.Modified then + FTree.Text[FNode, FColumn] := Edit.Text; + Edit.ClearLink; + Edit.ClearRefLink; + except + FStopping := False; + raise; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TStringEditLink.PrepareEdit(Tree : TBaseVirtualTree; Node : PVirtualNode; Column : TColumnIndex) : Boolean; +var + Text : string; +begin + Result := inherited; + if Result then + begin + Edit := TVTEdit.Create(Self); + Edit.Visible := False; + Edit.BorderStyle := bsSingle; + Edit.AutoSize := True; + Edit.Parent := Tree; + //Initial size, font and text of the node. + FTree.GetTextInfo(Node, Column, Edit.Font, FTextBounds, Text); + Edit.Font.Color := clWindowText; + Edit.RecreateWnd; + Edit.AutoSize := False; + Edit.Text := Text; + Edit.BidiMode := FBidiMode; + if Edit.BidiMode <> bdLeftToRight then + ChangeBidiModeAlignment(FAlignment); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TStringEditLink.SetBounds(R : TRect); +//Sets the outer bounds of the edit control and the actual edit area in the control. + +var + lOffset, tOffset, Height : TDimension; + offsets : TVTOffsets; +begin + if not FStopping then + begin + //Check if the provided rect height is smaller than the edit control height. + Height := R.Bottom - R.Top; + if Height < Edit.ClientHeight then + begin + //If the height is smaller than the minimal height we must correct it, otherwise the caret will be invisible. + tOffset := Edit.CalcMinHeight - Height; + if tOffset > 0 then + Inc(R.Bottom, tOffset); + end; + + //Set the edit's bounds but make sure there's a minimum width and the right border does not + //extend beyond the parent's left/right border. + if R.Left < 0 then + R.Left := 0; + if R.Right - R.Left < 30 then + begin + if FAlignment = taRightJustify then + R.Left := R.Right - 30 + else + R.Right := R.Left + 30; + end; + if R.Right > FTree.ClientWidth then + R.Right := FTree.ClientWidth; + Edit.BoundsRect := R; + + //The selected text shall exclude the text margins and be centered vertically. + //We have to take out the two pixel border of the edit control as well as a one pixel "edit border" the + //control leaves around the (selected) text. + R := Edit.ClientRect; + + //If toGridExtensions are turned on, we can fine tune the left margin (or the right margin if RTL is on) + //of the text to exactly match the text in the tree cell. + if (toGridExtensions in TCustomVirtualStringTreeCracker(FTree).TreeOptions.MiscOptions) and + ((FAlignment = taLeftJustify) and (Edit.BidiMode = bdLeftToRight) or (FAlignment = taRightJustify) and (Edit.BidiMode <> bdLeftToRight)) then + begin + //Calculate needed text area offset. + FTree.GetOffsets(FNode, offsets, ofsText, FColumn); + if FColumn = FTree.Header.MainColumn then + begin + if offsets[ofsToggleButton] < 0 then + lOffset := - (offsets[ofsToggleButton] + 2) + else + lOffset := 0; + end + else + lOffset := offsets[ofsText] - offsets[ofsMargin] + 1; + //Apply the offset. + if Edit.BidiMode = bdLeftToRight then + Inc(R.Left, lOffset) + else + Dec(R.Right, lOffset); + end; + + lOffset := IfThen(vsMultiline in FNode.States, 0, 2); + if tsUseThemes in FTree.TreeStates then + Inc(lOffset); + InflateRect(R, - TCustomVirtualStringTreeCracker(FTree).TextMargin + lOffset, lOffset); + if not (vsMultiline in FNode.States) then + begin + tOffset := FTextBounds.Top - Edit.Top; + //Do not apply a negative offset, the cursor will disappear. + if tOffset > 0 then + OffsetRect(R, 0, tOffset); + end; + R.Top := Max( - 1, R.Top); //A value smaller than -1 will prevent the edit cursor from being shown by Windows, see issue #159 + R.Left := Max( - 1, R.Left); + SendMessage(Edit.Handle, EM_SETRECTNP, 0, LPARAM(@R)); + end; +end; + +end. diff --git a/Source/VirtualTrees.Export.pas b/Source/VirtualTrees.Export.pas index 8ae32cd0f..1a68df64a 100644 --- a/Source/VirtualTrees.Export.pas +++ b/Source/VirtualTrees.Export.pas @@ -19,14 +19,18 @@ procedure ContentToCustom(Tree: TCustomVirtualStringTree; Source: TVSTTextSource implementation uses - Vcl.Graphics, - Vcl.Controls, - Vcl.Forms, System.Classes, System.SysUtils, System.StrUtils, System.Generics.Collections, - System.UITypes; + System.UITypes, + Vcl.Graphics, + Vcl.Controls, + Vcl.Forms, + VirtualTrees.Types, + VirtualTrees.ClipBoard, + VirtualTrees.Header, + VirtualTrees.BaseTree; type TCustomVirtualStringTreeCracker = class(TCustomVirtualStringTree) @@ -42,7 +46,7 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp // Renders the current tree content (depending on Source) as HTML text encoded in UTF-8. // If Caption is not empty then it is used to create and fill the header for the table built here. -// Based on ideas and code from Frank van den Bergh and Andreas H�rstemeier. +// Based on ideas and code from Frank van den Bergh and Andreas Hörstemeier. var Buffer: TBufferedString; @@ -67,15 +71,15 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp Value := 48 + (Component shr 4); if Value > $39 then - Inc(Value, 7); + System.Inc(Value, 7); Buffer.Add(AnsiChar(Value)); - Inc(I); + System.Inc(I); Value := 48 + (Component and $F); if Value > $39 then - Inc(Value, 7); + System.Inc(Value, 7); Buffer.Add(AnsiChar(Value)); - Inc(I); + System.Inc(I); WinColor := WinColor shr 8; end; @@ -104,9 +108,9 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp else Buffer.Add(Format('font-size: %dpt; ', [Font.Size])); - Buffer.Add(Format('font-style: %s; ', [IfThen(fsItalic in Font.Style, 'italic', 'normal')])); - Buffer.Add(Format('font-weight: %s; ', [IfThen(fsBold in Font.Style, 'bold', 'normal')])); - Buffer.Add(Format('text-decoration: %s; ', [IfThen(fsUnderline in Font.Style, 'underline', 'none')])); + Buffer.Add(Format('font-style: %s; ', [IfThen(TFontStyle.fsItalic in Font.Style, 'italic', 'normal')])); + Buffer.Add(Format('font-weight: %s; ', [IfThen(TFontStyle.fsBold in Font.Style, 'bold', 'normal')])); + Buffer.Add(Format('text-decoration: %s; ', [IfThen(TFontStyle.fsUnderline in Font.Style, 'underline', 'none')])); Buffer.Add('color: '); WriteColorAsHex(Font.Color); @@ -138,6 +142,7 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp CellPadding: String; CrackTree: TCustomVirtualStringTreeCracker; lGetCellTextEventArgs: TVSTGetCellTextEventArgs; + MulticellSelected: Boolean; // multicell support begin CrackTree := TCustomVirtualStringTreeCracker(Tree); @@ -155,7 +160,7 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp // Add title if adviced so by giving a caption. if Length(Caption) > 0 then AddHeader := AddHeader + 'caption="' + Caption + '"'; - if CrackTree.Borderstyle <> bsNone then + if CrackTree.Borderstyle <> TFormBorderStyle.bsNone then AddHeader := AddHeader + Format(' border="%d" frame=box', [CrackTree.BorderWidth + 1]); Buffer.Add(''); @@ -217,11 +222,16 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp Columns := nil; ColumnColors := nil; RenderColumns := CrackTree.Header.UseColumns; - if RenderColumns then + // begin multicell + MulticellSelected := CrackTree.Header.Columns.HasMulticellSelection; + if RenderColumns or MulticellSelected then begin Columns := CrackTree.Header.Columns.GetVisibleColumns; + if CrackTree.GetSelectedCellCount > 0 then + Columns := CrackTree.Header.Columns.GetSelectedCellColumns; SetLength(ColumnColors, Length(Columns)); end; + // end multicell support CrackTree.GetRenderStartValues(Source, Run, GetNextNode); Save := Run; @@ -434,7 +444,7 @@ function ContentToHTML(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceTyp if not RenderColumns then Break; - Inc(I); + System.Inc(I); end; if Assigned(CrackTree.OnAfterNodeExport) then CrackTree.OnAfterNodeExport(CrackTree, etHTML, Run); @@ -535,13 +545,13 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType begin if Length(Text) > 0 then begin - UseUnderline := fsUnderline in Font.Style; + UseUnderline := TFontStyle.fsUnderline in Font.Style; if UseUnderline then Buffer.Add('\ul'); - UseItalic := fsItalic in Font.Style; + UseItalic := TFontStyle.fsItalic in Font.Style; if UseItalic then Buffer.Add('\i'); - UseBold := fsBold in Font.Style; + UseBold := TFontStyle.fsBold in Font.Style; if UseBold then Buffer.Add('\b'); SelectFont(Font.Name); @@ -595,6 +605,7 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType LocaleBuffer: array [0..1] of Char; CrackTree: TCustomVirtualStringTreeCracker; lGetCellTextEventArgs: TVSTGetCellTextEventArgs; + MulticellSelected: Boolean; // multicell support begin CrackTree := TCustomVirtualStringTreeCracker(Tree); @@ -616,8 +627,15 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType LastLevel := 0; RenderColumns := CrackTree.Header.UseColumns; - if RenderColumns then + // begin multicell + MulticellSelected := CrackTree.Header.Columns.HasMulticellSelection; + if RenderColumns or MulticellSelected then + begin Columns := CrackTree.Header.Columns.GetVisibleColumns; + if CrackTree.GetSelectedCellCount > 0 then + Columns := CrackTree.Header.Columns.GetSelectedCellColumns; + end; + // end multicell support CrackTree.GetRenderStartValues(Source, Run, GetNextNode); Save := Run; @@ -630,7 +648,7 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType begin for I := 0 to High(Columns) do begin - Inc(J, Columns[I].Width); + System.Inc(J, Columns[I].Width); // This value must be expressed in twips (1 inch = 1440 twips). Twips := Round(1440 * J / Screen.PixelsPerInch); Buffer.Add('\cellx'); @@ -725,7 +743,7 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType end; // Call back the application to know about font customization. - CrackTree.Canvas.Font := CrackTree.Font; + CrackTree.Canvas.Font.Assign(CrackTree.Font); CrackTree.FFontChanged := False; CrackTree.DoPaintText(Run, CrackTree.Canvas, Index, ttNormal); @@ -764,7 +782,7 @@ function ContentToRTF(Tree: TCustomVirtualStringTree; Source: TVSTTextSourceType if not RenderColumns then Break; - Inc(I); + System.Inc(I); end; Buffer.Add('\row'); Buffer.AddNewLine; @@ -835,6 +853,7 @@ function ContentToUnicodeString(Tree: TCustomVirtualStringTree; Source: TVSTText I: Integer; CrackTree: TCustomVirtualStringTreeCracker; lGetCellTextEventArgs: TVSTGetCellTextEventArgs; + MulticellSelected: Boolean; begin CrackTree := TCustomVirtualStringTreeCracker(Tree); @@ -844,8 +863,19 @@ function ContentToUnicodeString(Tree: TCustomVirtualStringTree; Source: TVSTText try Columns := nil; RenderColumns := CrackTree.Header.UseColumns; - if RenderColumns then + MulticellSelected := CrackTree.Header.Columns.HasMulticellSelection; + + // begin multicell + if RenderColumns or MulticellSelected then + begin Columns := CrackTree.Header.Columns.GetVisibleColumns; + // multicell support + if CrackTree.GetSelectedCellCount > 0 then + begin + Columns := CrackTree.Header.Columns.GetSelectedCellColumns; + end; + end; + // end multicell support CrackTree.GetRenderStartValues(Source, Run, GetNextNode); Save := Run; diff --git a/Source/VirtualTrees.FMX.pas b/Source/VirtualTrees.FMX.pas new file mode 100644 index 000000000..fa2ad407a --- /dev/null +++ b/Source/VirtualTrees.FMX.pas @@ -0,0 +1,1781 @@ +unit VirtualTrees.FMX; + +{$SCOPEDENUMS ON} + +{***********************************************************} +{ Project : VirtualTrees } +{ } +{ author : Karol Bieniaszewski } +{ year : 2018 } +{ contibutors : } +{***********************************************************} + +interface +uses + System.Classes + , System.UITypes + , System.Types + , System.ImageList + , System.Math.Vectors + , FMX.ImgList + , FMX.Graphics + , FMX.Controls + , FMX.Types + , FMX.StdCtrls; + +//-------- type aliasing ------------------------------------------------------------------------------------------------------------------- + +type + TRect = System.Types.TRectF; + PRect = System.Types.PRectF; + TPoint = System.Types.TPointF; + PPoint = System.Types.PPointF; + PSize = System.Types.PSizeF; + TSize = System.Types.TSizeF; + TColor = System.UITypes.TAlphaColor; + PAnsiChar = System.MarshaledAString; + UINT = LongWord; + PUINT = ^UINT; + TCustomControl = TControl; //Alias for VCL compatibility as on FMX there is not TCustomControl + +//------- color aliasing ------------------------------------------------------------------------------------------------------------------- + +const + clBtnFace = TAlphaColor($FFF0F0F0); //TAlphaColorRec.Gray; + clBtnText = TAlphaColorRec.Black; + clBtnHighlight = TAlphaColorRec.DkGray; + clBtnShadow = TAlphaColorRec.Darkgray; + clHighlight = TAlphaColorRec.Lightblue; + clWindow = TAlphaColorRec.White; + clWindowText = TAlphaColorRec.Black; + clHighlightText = TAlphaColorRec.White; + clWhite = TAlphaColorRec.White; + clSilver = TAlphaColorRec.Silver; + clGray = TAlphaColorRec.Gray; + clBlack = TAlphaColorRec.Black; + clGreen = TAlphaColorRec.Green; + clBlue = TAlphaColorRec.Blue; + clGrayText = TAlphaColorRec.DkGray; + clInactiveCaption = TAlphaColorRec.Darkblue; //TODO: color + clInactiveCaptionText = TAlphaColorRec.Yellow; //TODO: color + clDkGray = TAlphaColorRec.DkGray; + + +//------- needed for migration ------------------------------------------------------------------------------------------------------------- + +const + { 3D border styles } + BDR_RAISEDOUTER = 1; + BDR_SUNKENOUTER = 2; + BDR_RAISEDINNER = 4; + BDR_SUNKENINNER = 8; + + BDR_OUTER = 3; + BDR_INNER = 12; + BDR_RAISED = 5; + BDR_SUNKEN = 10; + + EDGE_RAISED = (BDR_RAISEDOUTER or BDR_RAISEDINNER); + EDGE_SUNKEN = (BDR_SUNKENOUTER or BDR_SUNKENINNER); + EDGE_ETCHED = (BDR_SUNKENOUTER or BDR_RAISEDINNER); + EDGE_BUMP = (BDR_RAISEDOUTER or BDR_SUNKENINNER); + + ETO_OPAQUE = 2; + ETO_CLIPPED = 4; + ETO_RTLREADING = $80; + + RTLFlag: array[Boolean] of Integer = (0, ETO_RTLREADING); + + { Border flags } + BF_LEFT = 1; + BF_TOP = 2; + BF_RIGHT = 4; + BF_BOTTOM = 8; + + BF_TOPLEFT = (BF_TOP or BF_LEFT); + BF_TOPRIGHT = (BF_TOP or BF_RIGHT); + BF_BOTTOMLEFT = (BF_BOTTOM or BF_LEFT); + BF_BOTTOMRIGHT = (BF_BOTTOM or BF_RIGHT); + BF_RECT = (BF_LEFT or BF_TOP or BF_RIGHT or BF_BOTTOM); + + BF_MIDDLE = $800; { Fill in the middle } + BF_SOFT = $1000; { For softer buttons } + BF_ADJUST = $2000; { Calculate the space left over } + BF_FLAT = $4000; { For flat rather than 3D borders } + BF_MONO = $8000; { For monochrome borders } + + { DrawText() Format Flags } + DT_TOP = 0; + DT_LEFT = 0; + DT_CENTER = 1; + DT_RIGHT = 2; + DT_VCENTER = 4; + DT_BOTTOM = 8; + DT_WORDBREAK = $10; + DT_SINGLELINE = $20; + DT_EXPANDTABS = $40; + DT_TABSTOP = $80; + DT_NOCLIP = $100; + DT_EXTERNALLEADING = $200; + DT_CALCRECT = $400; + DT_NOPREFIX = $800; + DT_INTERNAL = $1000; + + + DT_EDITCONTROL = $2000; + DT_PATH_ELLIPSIS = $4000; + DT_END_ELLIPSIS = $8000; + DT_MODIFYSTRING = $10000; + DT_RTLREADING = $20000; + DT_WORD_ELLIPSIS = $40000; + DT_NOFULLWIDTHCHARBREAK = $0080000; + DT_HIDEPREFIX = $00100000; + DT_PREFIXONLY = $00200000; + + MAXDWORD = DWORD($FFFFFFFF); + WHEEL_DELTA = 120; { Value for rolling one detent } + WHEEL_PAGESCROLL = MAXDWORD; { Scroll one page } + + { WM_SIZE message wParam values } + SIZE_RESTORED = 0; + SIZE_MINIMIZED = 1; + SIZE_MAXIMIZED = 2; + SIZE_MAXSHOW = 3; + SIZE_MAXHIDE = 4; + + { Scroll Bar Constants } + SB_HORZ = 0; + SB_VERT = 1; + SB_CTL = 2; + SB_BOTH = 3; + + SIF_RANGE = 1; + SIF_PAGE = 2; + SIF_POS = 4; + SIF_DISABLENOSCROLL = 8; + SIF_TRACKPOS = $10; + SIF_ALL = (SIF_RANGE or SIF_PAGE or SIF_POS or SIF_TRACKPOS); + + { Scroll Bar Commands } + SB_LINEUP = 0; + SB_LINELEFT = 0; + SB_LINEDOWN = 1; + SB_LINERIGHT = 1; + SB_PAGEUP = 2; + SB_PAGELEFT = 2; + SB_PAGEDOWN = 3; + SB_PAGERIGHT = 3; + SB_THUMBPOSITION = 4; + SB_THUMBTRACK = 5; + SB_TOP = 6; + SB_LEFT = 6; + SB_BOTTOM = 7; + SB_RIGHT = 7; + SB_ENDSCROLL = 8; + + { RedrawWindow() flags } + RDW_INVALIDATE = 1; + RDW_INTERNALPAINT = 2; + RDW_ERASE = 4; + RDW_VALIDATE = 8; + RDW_NOINTERNALPAINT = $10; + RDW_NOERASE = $20; + RDW_NOCHILDREN = $40; + RDW_ALLCHILDREN = $80; + RDW_UPDATENOW = $100; + RDW_ERASENOW = $200; + RDW_FRAME = $400; + RDW_NOFRAME = $800; + + { GetSystemMetrics() codes } + SM_CXVSCROLL = 2; + SM_CYHSCROLL = 3; +var + // 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 + tagSCROLLINFO = record + cbSize: UINT; + fMask: UINT; + nMin: Single; + nMax: Single; + nPage: Single; + nPos: Single; + nTrackPos: Single; + end; + PScrollInfo = ^TScrollInfo; + TScrollInfo = tagSCROLLINFO; + SCROLLINFO = tagSCROLLINFO; + + TBorderWidth = Single; + TBevelCut = (bvNone, bvLowered, bvRaised, bvSpace); + TBevelEdge = (beLeft, beTop, beRight, beBottom); + TBevelEdges = set of TBevelEdge; + TBevelKind = (bkNone, bkTile, bkSoft, bkFlat); + TBevelWidth = 1..MaxInt; + + TFormBorderStyle = (bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow, bsSizeToolWin); + TBorderStyle = TFormBorderStyle.bsNone..TFormBorderStyle.bsSingle; + + + + TChangeLink = class(TImageLink) + private + function GetSender: TCustomImageList; inline; + procedure SetSender(const Value: TCustomImageList); inline; + public + constructor Create; override; + property Sender: TCustomImageList read GetSender write SetSender; + end; + + INT_PTR = Integer; //do not change on Int64 //System.IntPtr; // NativeInt; + {$EXTERNALSYM INT_PTR} + UINT_PTR = Cardinal; //do not change on Int64 //System.UIntPtr; // NativeUInt; + + WPARAM = UINT_PTR; + LPARAM = INT_PTR; + LRESULT = INT_PTR; + + TDWordFiller = record + {$IFDEF CPUX64} + Filler: array[1..4] of Byte; // Pad DWORD to make it 8 bytes (4+4) [x64 only] + {$ENDIF} + end; + +//--------- Windows messages simulations --------------------------------------------------------------------------------------------------- + +const + WM_APP = $8000; + WM_MOUSEFIRST = $0200; + WM_MOUSEMOVE = $0200; + WM_LBUTTONDOWN = $0201; + WM_LBUTTONUP = $0202; + WM_LBUTTONDBLCLK = $0203; + WM_RBUTTONDOWN = $0204; + WM_RBUTTONUP = $0205; + WM_RBUTTONDBLCLK = $0206; + WM_MBUTTONDOWN = $0207; + WM_MBUTTONUP = $0208; + WM_MBUTTONDBLCLK = $0209; + WM_MOUSEWHEEL = $020A; + WM_SIZE = $0005; + WM_NCMBUTTONDOWN = $00A7; + WM_NCMBUTTONUP = $00A8; + WM_NCMBUTTONDBLCLK = $00A9; + WM_NCLBUTTONDBLCLK = $00A3; + WM_NCRBUTTONDOWN = $00A4; + WM_NCRBUTTONUP = $00A5; + WM_NCRBUTTONDBLCLK = $00A6; + WM_NCLBUTTONDOWN = $00A1; + WM_NCLBUTTONUP = $00A2; + WM_NCMOUSEMOVE = $00A0; + WM_KEYDOWN = $0100; + WM_KEYUP = $0101; + WM_SETFOCUS = $0007; + WM_KILLFOCUS = $0008; + WM_SETCURSOR = $0020; + WM_HSCROLL = $0114; + WM_VSCROLL = $0115; + WM_CHANGESTATE = WM_APP + 32; + + CM_BASE = $B000; +{$IF DEFINED(CLR)} + CM_CLROFFSET = $100; +{$ELSE} + CM_CLROFFSET = $0; // Only applicable in CLR +{$ENDIF} + CM_ACTIVATE = CM_BASE + 0; + CM_DEACTIVATE = CM_BASE + 1; + CM_GOTFOCUS = CM_BASE + 2; + CM_LOSTFOCUS = CM_BASE + 3; + CM_CANCELMODE = CM_BASE + CM_CLROFFSET + 4; + CM_DIALOGKEY = CM_BASE + 5; + CM_DIALOGCHAR = CM_BASE + 6; +{$IF NOT DEFINED(CLR)} + CM_FOCUSCHANGED = CM_BASE + 7; +{$ENDIF} + CM_PARENTFONTCHANGED = CM_BASE + CM_CLROFFSET + 8; + CM_PARENTCOLORCHANGED = CM_BASE + 9; + CM_BIDIMODECHANGED = CM_BASE + 60; + CM_PARENTBIDIMODECHANGED = CM_BASE + 61; + CM_MOUSEWHEEL = CM_BASE + 67; + + VK_ESCAPE = 27; + +type + PMessage = ^TMessage; + TMessage = record + Msg: Cardinal; //4 + tmp: Integer; //4 + case Integer of + 0: ( + WParam: WPARAM; //4 + LParam: LPARAM; //4 + Result: LRESULT //4 + ); //= 12 + 4 = 16 + 1: ( + WParamLo: Word; //2 + WParamHi: Word; //2 + //WParamFiller: TDWordFiller; + LParamLo: Word; //2 + LParamHi: Word; //2 + //LParamFiller: TDWordFiller; + ResultLo: Word; //2 + ResultHi: Word; //2 + //=12 + 8 = 20 + ); + end; + + TWMMouse = record + Msg: Cardinal; //4 + Keys: Longint; //TShiftState; //4 + //KeysFiller: TDWordFiller; + case Integer of + 0: ( + XPos: Single; //4 + YPos: Single; //4 + Result: LRESULT; //4 + ); + 1: ( + Pos: TPoint; //8 + ResultLo: Word; //2 + ResultHi: Word; //2 + ); //=12 + 8=20 + end; + + TWMMouseMove = TWMMouse; + + TWMNCHitTest = record + Msg: Cardinal; + //MsgFiller: TDWordFiller; + Unused: WPARAM; + case Integer of + 0: ( + XPos: Single; + YPos: Single; + //XYPosFiller: TDWordFiller + ); + 1: ( + Pos: TPoint; + //PosFiller: TDWordFiller; + Result: LRESULT); + end; + + TWMNCHitMessage = record + Msg: Cardinal; //4 + //MsgFiller: TDWordFiller; + HitTest: Longint; //4 + //HitTestFiller: TDWordFiller; + XCursor: Single; //4 + YCursor: Single; //4 + //XYCursorFiller: TDWordFiller; + Result: LRESULT; //4 + end; //=20 + + TWMNCLButtonDblClk = TWMNCHitMessage; + TWMNCLButtonDown = TWMNCHitMessage; + TWMNCLButtonUp = TWMNCHitMessage; + TWMNCMButtonDblClk = TWMNCHitMessage; + TWMNCMButtonDown = TWMNCHitMessage; + TWMNCMButtonUp = TWMNCHitMessage; + TWMNCMouseMove = TWMNCHitMessage; + TWMNCRButtonDblClk = TWMNCHitMessage; + TWMNCRButtonDown = TWMNCHitMessage; + TWMNCRButtonUp = TWMNCHitMessage; + + TWMLButtonDblClk = TWMMouse; + TWMLButtonDown = TWMMouse; + TWMLButtonUp = TWMMouse; + TWMMButtonDblClk = TWMMouse; + TWMMButtonDown = TWMMouse; + TWMMButtonUp = TWMMouse; + + + TWMKey = record + Msg: Cardinal; //4 + tmp: Integer; //4 + CharCode: Word; //4 + //Unused: Word; //2 + KeyData: Longint; //4 + Result: LRESULT; //4 + end; //=20 + + TWMKeyDown = TWMKey; + TWMKeyUp = TWMKey; + + TWMSize = record + Msg: Cardinal; //4 + //MsgFiller: TDWordFiller; + SizeType: WPARAM; { SIZE_MAXIMIZED, SIZE_MINIMIZED, SIZE_RESTORED, //4 + SIZE_MAXHIDE, SIZE_MAXSHOW } + Width: Single; //4 + Height: Single; //4 + //WidthHeightFiller: TDWordFiller; + Result: LRESULT; //4 + end; //=20 + + TWMScroll = record + Msg: Cardinal; //4 + //MsgFiller: TDWordFiller; + ScrollCode: {Smallint}Integer; { SB_xxxx } //4 + Pos: Single; //4 + //ScrollCodePosFiller: TDWordFiller; + ScrollBar: Integer; //4 nBar + Result: LRESULT; //4 + end; //=20 + + TWMHScroll = TWMScroll; + TWMVScroll = TWMScroll; + + TCMMouseWheel = record + Msg: Cardinal; //4 + //MsgFiller: TDWordFiller; + ShiftState: TShiftState; //2 + WheelDelta: SmallInt; //2 + //ShiftStateWheel: TDWordFiller; + case Integer of + 0: ( + XPos: Single; //4 + YPos: Single; //4 + //XYPos: TDWordFiller + ); //=24! + 1: ( + Pos: TPoint; //8 + //PosFiller: TDWordFiller; + Result: LRESULT //4 + ); //=28! + end; + + +procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean; IsUp: Boolean); + +//--------- Text metrics ------------------------------------------------------------------------------------------------------------------- +type + TTextMetric = record + tmHeight: Single; //The height (ascent + descent) of characters. + tmAscent: Single; //The ascent (units above the base line) of characters. + tmDescent: Single; //The descent (units below the base line) of characters. + tmInternalLeading: Single; //The amount of leading (space) inside the bounds set by the tmHeight member. Accent marks and other diacritical characters may occur in this area. The designer may set this member to zero + tmExternalLeading: Single; //The amount of extra leading (space) that the application adds between rows. Since this area is outside the font, it contains no marks and is not altered by text output calls in either OPAQUE or TRANSPARENT mode. The designer may set this member to zero. + tmAveCharWidth: Single; //The average width of characters in the font (generally defined as the width of the letter x ). This value does not include the overhang required for bold or italic characters. + tmMaxCharWidth: Single; //The width of the widest character in the font. + tmWeight: Single; //The weight of the font. + tmOverhang: Single; + tmDigitizedAspectX: Single; //The horizontal aspect of the device for which the font was designed. + tmDigitizedAspectY: Single; //The vertical aspect of the device for which the font was designed. The ratio of the tmDigitizedAspectX and tmDigitizedAspectY members is the aspect ratio of the device for which the font was designed. + tmFirstChar: WideChar; //The value of the first character defined in the font. + tmLastChar: WideChar; //The value of the last character defined in the font. + tmDefaultChar: WideChar; //The value of the character to be substituted for characters not in the font. + tmBreakChar: WideChar; //The value of the character that will be used to define word breaks for text justification. + tmItalic: Byte; //Specifies an italic font if it is nonzero. + tmUnderlined: Byte; //Specifies an underlined font if it is nonzero. + tmStruckOut: Byte; //A strikeout font if it is nonzero. + tmPitchAndFamily: Byte; //Specifies information about the pitch, the technology, and the family of a physical font. TMPF_FIXED_PITCH, TMPF_VECTOR, TMPF_TRUETYPE, TMPF_DEVICE + tmCharSet: Byte; //The character set of the font. The character set can be one of the following values. ANSI_CHARSET, GREEK_CHARSET.... + end; + procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); + +//-------- function aliassing -------------------------------------------------------------------------------------------------------------- + +function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; overload; inline; +function Rect(const ATopLeft, ABottomRight: TPoint): TRect; overload; inline; +function Point(AX, AY: Single): TPoint; overload; inline; + +procedure Inc(Var V: Single; OIle: Single=1.0); overload; +procedure Dec(Var V: Single; OIle: Single=1.0); overload; +function MulDiv(const A, B, C: Single): Single; overload; +procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); +procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); +procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); +procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); + +procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Bounds: TRect; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSize); +procedure DrawEdge(Canvas: TCanvas; R: TRect; edge, grfFlags: Cardinal); + +type + THighQualityBitmap = class(TBitmap) + public + constructor Create; override; + end; + +//fill system images +procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); + +type + TCanvasHelper = class helper for TCanvas + private + function GetBrush: TBrush; inline; + function GetPen: TStrokeBrush; inline; + public + property Brush: TBrush read GetBrush; + property Pen: TStrokeBrush read GetPen; + procedure FillRect(const ARect: TRectF); overload; inline; + procedure DrawRect(const ARect: TRectF); overload; inline; + procedure DrawFocusRect(const AFocusRect: TRect); + procedure FrameRect(const AFocusRect: TRect); + procedure RoundRect(X1, Y1, X2, Y2: Single; const XRadius, YRadius: Single); overload; + procedure RoundRect(const Rect: TRect; const XRadius, YRadius: Single); overload; + procedure Polygon(const Points: TPolygon); + procedure Draw(const X, Y: Single; const Bitmap: TBitmap); + end; + + TFontHelper = class helper for TFont + private + function GetOnChange: TNotifyEvent; + procedure SetOnChange(const Value: TNotifyEvent); + public + property OnChange: TNotifyEvent read GetOnChange write SetOnChange; + end; + +{ Draws a solid triangular arrow that can point in any TScrollDirection } + +type + TScrollDirection = (sdLeft, sdRight, sdUp, sdDown); + TArrowType = (atSolid, atArrows); + +procedure DrawArrow(ACanvas: TCanvas; Direction: TScrollDirection; Location: TPoint; Size: Single); + +procedure ChangeBiDiModeAlignment(var Alignment: TAlignment); + +procedure OleUninitialize(); + +function timeGetTime: Int64; + +implementation +uses + System.SysUtils + , FMX.TextLayout + , FMX.MultiResBitmap + , FMX.Objects + , FMX.Effects + , VirtualTrees.Utils + ; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure DrawArrow(ACanvas: TCanvas; Direction: TScrollDirection; Location: TPoint; Size: Single); +begin + //TODO: DrawArrow implementation +end; + +//---------------------------------------------------------------------------------------------------------------------- + +{ TCanvasHelper } + +procedure TCanvasHelper.Draw(const X, Y: Single; const Bitmap: TBitmap); +begin + DrawBitmap(Bitmap + , Rect(0, 0, Bitmap.Width, Bitmap.Height) + , Rect(X, Y, X+Bitmap.Width, Y+ Bitmap.Height) + , 1.0 + ); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCanvasHelper.DrawFocusRect(const AFocusRect: TRect); +begin + DrawDashRect(AFocusRect, 0, 0, AllCorners, 1.0{?}, $A0909090); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCanvasHelper.DrawRect(const ARect: TRectF); +begin + DrawRect(ARect, 0, 0, [], 1.0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCanvasHelper.FillRect(const ARect: TRectF); +begin + FillRect(ARect, 0, 0, [], 1.0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCanvasHelper.FrameRect(const AFocusRect: TRect); +begin + DrawRect(AFocusRect); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCanvasHelper.GetBrush: TBrush; +begin + Result:= Fill; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCanvasHelper.GetPen: TStrokeBrush; +begin + Result:= Stroke; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCanvasHelper.Polygon(const Points: TPolygon); +begin + DrawPolygon(Points, 1.0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCanvasHelper.RoundRect(const Rect: TRect; const XRadius, YRadius: Single); +begin + DrawRect(Rect, XRadius, YRadius, allCorners, 1.0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCanvasHelper.RoundRect(X1, Y1, X2, Y2: Single; const XRadius, YRadius: Single); +begin + RoundRect(Rect(X1, Y1, X2, Y2), XRadius, YRadius); +end; + + +//---------------------------------------------------------------------------------------------------------------------- + +type + TImageListHelper = class helper for TImageList + function Add(aBitmap: TBitmap): integer; + end; + +function TImageListHelper.Add(aBitmap: TBitmap): integer; +const + SCALE = 1; +var + vSource: TCustomSourceItem; + vBitmapItem: TCustomBitmapItem; + vDest: TCustomDestinationItem; + vLayer: TLayer; +begin + Result := -1; + if (aBitmap.Width = 0) or (aBitmap.Height = 0) then exit; + + // add source bitmap + vSource := Source.Add; + vSource.MultiResBitmap.TransparentColor := TColorRec.Fuchsia; + vSource.MultiResBitmap.SizeKind := TSizeKind.Source; + vSource.MultiResBitmap.Width := Round(aBitmap.Width / SCALE); + vSource.MultiResBitmap.Height := Round(aBitmap.Height / SCALE); + vBitmapItem := vSource.MultiResBitmap.ItemByScale(SCALE, True, True); + if vBitmapItem = nil then + begin + vBitmapItem := vSource.MultiResBitmap.Add; + vBitmapItem.Scale := Scale; + end; + vBitmapItem.Bitmap.Assign(aBitmap); + + vDest := Destination.Add; + vLayer := vDest.Layers.Add; + vLayer.SourceRect.Rect := TRectF.Create(TPoint.Zero, vSource.MultiResBitmap.Width, + vSource.MultiResBitmap.Height); + vLayer.Name := vSource.Name; + Result := vDest.Index; +end; + +//---------------------------------------------------------------------------------------------------------------------- +//https://stackoverflow.com/questions/22813461/is-there-an-equivalent-to-floodfill-in-fmx-for-a-tbitmap +procedure Bitmap_FloodFill(fBitmap: TBitmap; StartX,StartY : Integer; FillColor: TAlphaColor); +var + fBitmapData : TBitmapData; + X, Y : Integer; + ReplaceColor : TAlphaColor; + Stack : Array of System.Types.TPoint; + fHeight : Integer; + fWidth : Integer; + + procedure PutInStack(X, Y: Integer); + begin + SetLength(Stack, Length(Stack)+1); + Stack[Length(Stack)-1] := Point(X, Y); + end; + + procedure GetFromStack(var X, Y: Integer); + begin + X := Stack[Length(Stack)-1].X; + Y := Stack[Length(Stack)-1].Y; + SetLength(Stack, Length(Stack)-1); + end; + +begin + X := StartX; + Y := StartY; + fHeight := fBitmap.Height; + fWidth := fBitmap.Width; + if (X >= fWidth) or (Y >= fHeight) then Exit; + + if fBitmap.Map(TMapAccess.ReadWrite,fBitmapData) then + try + ReplaceColor := fBitmapData.GetPixel(X,Y); + if ReplaceColor <> FillColor then + begin + PutInStack(X,Y); + while Length(Stack) > 0 do + begin + GetFromStack(X,Y); + while (X > 0) and (fBitmapData.GetPixel(X-1, Y) = ReplaceColor) do System.Dec(X); + while (X < fWidth) and (fBitmapData.GetPixel(X , Y) = ReplaceColor) do + begin + if Y > 0 then If fBitmapData.GetPixel(X, Y-1) = ReplaceColor then PutInStack(X, Y-1); + if Y+1 < fHeight then If fBitmapData.GetPixel(X, Y+1) = ReplaceColor then PutInStack(X, Y+1); + fBitmapData.SetPixel(X,Y,FillColor); + System.Inc(X); + end; + end; + end; + finally + fBitmap.Canvas.Bitmap.Unmap(fBitmapData); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +{ + ckEmpty = 0; // an empty image used as place holder + // radio buttons + ckRadioUncheckedNormal = 1; + ckRadioUncheckedHot = 2; + ckRadioUncheckedPressed = 3; + ckRadioUncheckedDisabled = 4; + ckRadioCheckedNormal = 5; + ckRadioCheckedHot = 6; + ckRadioCheckedPressed = 7; + ckRadioCheckedDisabled = 8; + // check boxes + ckCheckUncheckedNormal = 9; + ckCheckUncheckedHot = 10; + ckCheckUncheckedPressed = 11; + ckCheckUncheckedDisabled = 12; + ckCheckCheckedNormal = 13; + ckCheckCheckedHot = 14; + ckCheckCheckedPressed = 15; + ckCheckCheckedDisabled = 16; + ckCheckMixedNormal = 17; + ckCheckMixedHot = 18; + ckCheckMixedPressed = 19; + ckCheckMixedDisabled = 20; + // simple button + ckButtonNormal = 21; //??? + ckButtonHot = 22; //??? + ckButtonPressed = 23; //??? + ckButtonDisabled = 24; //??? +} +procedure FillSystemCheckImages(Parent: TFmxObject; List: TImageList); +Var cb: TCheckBox; + rb: TRadioButton; + BMP: TBitmap; + eff: TInnerGlowEffect; + procedure AddCtrlBmp(c: TControl); + Var tmpBMP: TBitmap; + begin + tmpBMP:= c.MakeScreenshot; + try + BMP.SetSize(tmpBMP.Height, tmpBMP.Height); + BMP.Clear(TAlphaColorRec.Null); //this somehow can sometimes clear BeginSceneCount and must be before BeginScene + if BMP.Canvas.BeginScene() then + begin + try + BMP.Canvas.DrawBitmap( + tmpBMP + , Rect(2, 2, BMP.Width, BMP.Height) + , Rect(0, 0, BMP.Width-2, BMP.Height-2) + , 1.0 + , false + ); + finally + BMP.Canvas.EndScene; + end; + end; + finally + FreeAndNil(tmpBMP); + end; + end; +begin + BMP:= TBitmap.Create; + try + BMP.SetSize(16, 16); + BMP.Clear(TAlphaColorRec.Null); + List.Add(BMP); //ckEmpty + + + rb:= TRadioButton.Create(Parent); + try + rb.Parent:= Parent; + rb.Text:= ' '; + + eff:= TInnerGlowEffect.Create(rb); //auto free + eff.Parent:= rb; + eff.GlowColor:= TAlphaColorRec.Teal; + eff.Softness:= 8; + eff.Opacity:= 0.7; + eff.Enabled:= false; + + //------------------IsUnChecked-------------------------- + + rb.IsChecked:= false; + eff.Enabled:= false; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioUncheckedNormal + eff.Enabled:= false; + + + AddCtrlBmp(rb); + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightyellow; + List.Add(BMP); //ckRadioUncheckedHot + eff.Enabled:= false; + + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightblue; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioUncheckedPressed + eff.Enabled:= false; + + + rb.Enabled:= false; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Gray; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioUncheckedDisabled + eff.Enabled:= false; + + //------------------IsChecked--------------------------- + + rb.IsChecked:= true; + + //rb.IsPressed:= false; + rb.Enabled:= true; + eff.Enabled:= false; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioCheckedNormal + eff.Enabled:= false; + + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightyellow; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioCheckedHot + eff.Enabled:= false; + + + rb.Enabled:= true; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightblue; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioCheckedPressed + eff.Enabled:= false; + + + rb.Enabled:= false; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Gray; + AddCtrlBmp(rb); + List.Add(BMP); //ckRadioCheckedDisabled + eff.Enabled:= false; + finally + FreeAndNil(rb); + end; + + cb:= TCheckBox.Create(Parent); + try + cb.Parent:= Parent; + cb.Text:= ' '; + + eff:= TInnerGlowEffect.Create(cb); //auto free + eff.Parent:= cb; + eff.GlowColor:= TAlphaColorRec.Teal; + eff.Softness:= 8; + eff.Opacity:= 0.7; + eff.Enabled:= false; + + //------------------IsUnChecked-------------------------- + + cb.IsChecked:= false; + eff.Enabled:= false; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckUncheckedNormal + eff.Enabled:= false; + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightyellow; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckUncheckedHot + eff.Enabled:= false; + + + //cb.IsPressed:= true; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightblue; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckUncheckedPressed + eff.Enabled:= false; + + + //cb.IsPressed:= false; + cb.Enabled:= false; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Gray; + AddCtrlBmp(cb); + eff.Enabled:= false; + List.Add(BMP); //ckCheckUncheckedDisabled + + //------------------IsChecked--------------------------- + + cb.IsChecked:= true; + + cb.Enabled:= true; + eff.Enabled:= false; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckCheckedNormal + eff.Enabled:= false; + + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightyellow; + eff.Opacity:= 0.3; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckCheckedHot + eff.Opacity:= 0.7; + eff.Enabled:= false; + eff.Enabled:= false; + + + cb.Enabled:= true; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightblue; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckCheckedPressed + eff.Enabled:= false; + + + cb.Enabled:= false; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Gray; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckCheckedDisabled + eff.Enabled:= false; + //------------------Mixed--------------------------- + + //how to support mixed style? + //maybe draw unchecked and fill in the center of bitmap??? + //i use ~teal for fill + //changed to InnerGlowEffect + + cb.IsChecked:= true; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Green; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckMixedNormal + eff.Enabled:= false; + + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightyellow; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckMixedHot + eff.Enabled:= false; + + + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Lightblue; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckMixedPressed + eff.Enabled:= false; + + + cb.Enabled:= false; + eff.Enabled:= true; + eff.GlowColor:= TAlphaColorRec.Gray; + AddCtrlBmp(cb); + List.Add(BMP); //ckCheckMixedDisabled + eff.Enabled:= false; + + finally + FreeAndNil(cb); + end; + eff.Enabled:= false; + eff.Parent:= nil; + + finally + FreeAndNil(BMP); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure FillTWMMouse(Var MM: TWMMouse; Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single; IsNC: Boolean; IsUp: Boolean); +begin + MM.Msg:= 0; + if ssDouble in Shift then + begin + if ssLeft in Shift then + begin + if IsNC then + MM.Msg:= WM_NCLBUTTONDBLCLK else + MM.Msg:= WM_LBUTTONDBLCLK; + end else + if ssRight in Shift then + begin + if IsNC then + MM.Msg:= WM_NCRBUTTONDBLCLK else + MM.Msg:= WM_RBUTTONDBLCLK; + end else + if ssMiddle in Shift then + begin + if IsNC then + MM.Msg:= WM_NCMBUTTONDBLCLK else + MM.Msg:= WM_MBUTTONDBLCLK; + end; + end else + begin + if (ssLeft in Shift) or (Button=TMouseButton.mbLeft) then + begin + if IsUp then + begin + if IsNC then + MM.Msg:= WM_NCLBUTTONUP else + MM.Msg:= WM_LBUTTONUP; + end else + begin + if IsNC then + MM.Msg:= WM_NCLBUTTONDOWN else + MM.Msg:= WM_LBUTTONDOWN; + end; + end else + if (ssRight in Shift) or (Button=TMouseButton.mbRight) then + begin + if IsUp then + begin + if IsNC then + MM.Msg:= WM_NCRBUTTONUP else + MM.Msg:= WM_RBUTTONUP; + end else + begin + if IsNC then + MM.Msg:= WM_NCRBUTTONDOWN else + MM.Msg:= WM_RBUTTONDOWN; + end; + + end else + if (ssMiddle in Shift) or (Button=TMouseButton.mbMiddle) then + begin + if IsUp then + begin + if IsNC then + MM.Msg:= WM_NCMBUTTONUP else + MM.Msg:= WM_MBUTTONUP; + end else + begin + if IsNC then + MM.Msg:= WM_NCMBUTTONDOWN else + MM.Msg:= WM_MBUTTONDOWN; + end; + end; + end; + + MM.XPos:= X; + MM.YPos:= Y; + MM.Keys:= LongInt(Word(Shift)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure DrawTextW(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Bounds: TRect; DrawFormat: Cardinal{this is windows format - must be converted to FMX}); +Var + hAlign: TTextAlign; + vAlign: TTextAlign; + Flags: TFillTextFlags; +begin + //TTextLayout. render + //TODO: DrawFormat: Cardinal{this is windows format - must be converted to FMX} + + hAlign:= TTextAlign.Leading; + if DrawFormat and DT_CENTER<>0 then + hAlign:= TTextAlign.Center; + if DrawFormat and DT_RIGHT<>0 then + hAlign:= TTextAlign.Trailing; + + + vAlign:= TTextAlign.Center; + if DrawFormat and DT_VCENTER<>0 then + vAlign:= TTextAlign.Center; + if DrawFormat and DT_BOTTOM<>0 then + vAlign:= TTextAlign.Trailing; + + Flags:= []; + + if DrawFormat and DT_RTLREADING<>0 then + Flags:= Flags + [TFillTextFlag.RightToLeft]; + + ACanvas.FillText(Bounds, CaptionText, false, 1.0, Flags, hAlign, vAlign); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure DrawEdge(Canvas: TCanvas; R: TRect; edge, grfFlags: Cardinal); +Var tmpR: TRect; + IsSoft, IsFlat, IsMono: Boolean; +begin + + if grfFlags and BF_SOFT<>0 then + IsSoft:= true else + IsSoft:= false; + + if grfFlags and BF_FLAT<>0 then + IsFlat:= true else + IsFlat:= false; + + if grfFlags and BF_MONO<>0 then + IsMono:= true else + IsMono:= false; + + if grfFlags and BF_MIDDLE<>0 then + begin + Canvas.Fill.Color:= clBtnFace; + Canvas.FillRect(R, 0, 0, [], 1.0); + end; + tmpR:= R; + if grfFlags and BF_LEFT<>0 then + begin + tmpR:= R; + + if edge and BDR_RAISEDOUTER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= TColors.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) + end; + + if edge and BDR_SUNKENOUTER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) + end; + + if edge and BDR_RAISEDINNER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end; + end; + + if edge and BDR_SUNKENINNER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Left, tmpR.Bottom), 1.0); + end; + end; + end; + + if grfFlags and BF_TOP<>0 then + begin + tmpR:= R; + + if edge and BDR_RAISEDOUTER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end; + InflateRect(tmpR, -1, -1) + end; + + if edge and BDR_SUNKENOUTER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end; + InflateRect(tmpR, -1, -1) + end; + + if edge and BDR_RAISEDINNER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end; + end; + + if edge and BDR_SUNKENINNER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end else + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Top), Point(tmpR.Right, tmpR.Top), 1.0); + end; + end; + + + end; + + if grfFlags and BF_RIGHT<>0 then + begin + tmpR:= R; + if edge and BDR_RAISEDOUTER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) + end; + + if edge and BDR_SUNKENOUTER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Right-1, tmpR.Top), Point(tmpR.Right-1, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) + end; + + Dec(tmpR.Right); + + if edge and BDR_RAISEDINNER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + end; + + if edge and BDR_SUNKENINNER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Right, tmpR.Top), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + end; + end; + + if grfFlags and BF_BOTTOM<>0 then + begin + tmpR:= R; + Dec(tmpR.Bottom); + if edge and BDR_RAISEDOUTER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FF696969; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) + end; + + if edge and BDR_SUNKENOUTER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FF646464; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + InflateRect(tmpR, -1, -1) + end; + + if edge and BDR_RAISEDINNER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFF0F0F0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= TAlphaColorRec.White; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFA0A0A0; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + end; + + if edge and BDR_SUNKENINNER<>0 then + begin + if isSoft then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if IsFlat then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + if isMono then + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end else + begin + Canvas.Stroke.Color:= $FFE3E3E3; + Canvas.DrawLine(Point(tmpR.Left, tmpR.Bottom), Point(tmpR.Right, tmpR.Bottom), 1.0); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure GetTextExtentPoint32W(ACanvas: TCanvas; CaptionText: String; Len: Integer; Var Size: TSize); +begin + Size.cx:= ACanvas.TextWidth(Copy(CaptionText, 1, Len)); + Size.cy:= ACanvas.TextHeight(Copy(CaptionText, 1, Len)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure GetTextMetrics(ACanvas: TCanvas; var TM: TTextMetric); +Var P: TPathData; + tx: TTextLayout; + R: TRectF; +begin +{ + tmHeight: Single; //The height (ascent + descent) of characters. + tmAscent: Single; //The ascent (units above the base line) of characters. + tmDescent: Single; //The descent (units below the base line) of characters. + tmInternalLeading: Single; //The amount of leading (space) inside the bounds set by the tmHeight member. Accent marks and other diacritical characters may occur in this area. The designer may set this member to zero + tmExternalLeading: Single; //The amount of extra leading (space) that the application adds between rows. Since this area is outside the font, it contains no marks and is not altered by text output calls in either OPAQUE or TRANSPARENT mode. The designer may set this member to zero. + tmAveCharWidth: Single; //The average width of characters in the font (generally defined as the width of the letter x ). This value does not include the overhang required for bold or italic characters. + tmMaxCharWidth: Single; //The width of the widest character in the font. + tmWeight: Single; //The weight of the font. + tmOverhang: Single; + tmDigitizedAspectX: Single; //The horizontal aspect of the device for which the font was designed. + tmDigitizedAspectY: Single; //The vertical aspect of the device for which the font was designed. The ratio of the tmDigitizedAspectX and tmDigitizedAspectY members is the aspect ratio of the device for which the font was designed. + tmFirstChar: WideChar; //The value of the first character defined in the font. + tmLastChar: WideChar; //The value of the last character defined in the font. + tmDefaultChar: WideChar; //The value of the character to be substituted for characters not in the font. + tmBreakChar: WideChar; //The value of the character that will be used to define word breaks for text justification. + tmItalic: Byte; //Specifies an italic font if it is nonzero. + tmUnderlined: Byte; //Specifies an underlined font if it is nonzero. + tmStruckOut: Byte; //A strikeout font if it is nonzero. + tmPitchAndFamily: Byte; //Specifies information about the pitch, the technology, and the family of a physical font. TMPF_FIXED_PITCH, TMPF_VECTOR, TMPF_TRUETYPE, TMPF_DEVICE + tmCharSet: Byte; //The character set of the font. The character set can be one of the following values. ANSI_CHARSET, GREEK_CHARSET.... +} + TM.tmExternalLeading:= 0; + TM.tmWeight:= 0; //boldness??? + TM.tmOverhang:= 0; + TM.tmDigitizedAspectX:= 0; + TM.tmDigitizedAspectY:= 0; + TM.tmFirstChar:= 'a'; //??? + TM.tmLastChar:= 'z'; //??? + TM.tmDefaultChar:= ' '; + TM.tmBreakChar:= ' '; + TM.tmItalic:= 0; + TM.tmUnderlined:= 0; + TM.tmStruckOut:= 0; + TM.tmPitchAndFamily:= 0; + TM.tmCharSet:= 0; + + tx:= TTextLayoutManager.DefaultTextLayout.Create(ACanvas); + P:= TPathData.Create; + try + tx.Text:= 'W'; + tx.ConvertToPath(p); + R:= P.GetBounds(); + + TM.tmHeight:= R.Height; + TM.tmMaxCharWidth:= R.Width; + + //------------------------------------ + tx.Text:= 'Ó'; + p.Clear; + tx.ConvertToPath(p); + R:= P.GetBounds(); + TM.tmInternalLeading:= R.Height - TM.tmHeight; + + //------------------------------------ + tx.Text:= 'x'; + p.Clear; + tx.ConvertToPath(p); + R:= P.GetBounds(); + TM.tmAscent:= R.Height - TM.tmHeight; + TM.tmAveCharWidth:= R.Width; + + //------------------------------------ + tx.Text:= 'y'; + p.Clear; + tx.ConvertToPath(p); + TM.tmDescent:= P.GetBounds().Height - R.Height; + TM.tmHeight:= TM.tmHeight + TM.tmDescent; + finally + FreeAndNil(P); + FreeAndNil(tx); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Rect(ALeft, ATop, ARight, ABottom: Single): TRect; +begin + Result:= RectF(ALeft, ATop, ARight, ABottom); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Rect(const ATopLeft, ABottomRight: TPoint): TRect; +begin + Result:= RectF(ATopLeft.X, ATopLeft.Y, ABottomRight.X, ABottomRight.Y); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Point(AX, AY: Single): TPoint; +begin + Result.X:= AX; + Result.Y:= AY; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure Inc(Var V: Single; OIle: Single=1.0); +begin + V:= V + OIle; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure Dec(Var V: Single; OIle: Single=1.0); +begin + V:= V - OIle; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function MulDiv(const A, B, C: Single): Single; +begin + Result:= (A * B) / C; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure FillMemory(Destination: Pointer; Length: NativeUInt; Fill: Byte); +begin + FillChar(Destination^, Length, Fill); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); +begin + FillChar(Destination^, Length, 0); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure MoveMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); +begin + Move(Source^, Destination^, Length); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: NativeUInt); +begin + Move(Source^, Destination^, Length); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure ChangeBiDiModeAlignment(var Alignment: TAlignment); +begin + case Alignment of + taLeftJustify: Alignment := taRightJustify; + taRightJustify: Alignment := taLeftJustify; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure OleUninitialize(); +begin + //nothing +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function timeGetTime: Int64; +begin + Result:= TThread.GetTickCount; +end; + +{ TChangeLink } + +//---------------------------------------------------------------------------------------------------------------------- + +constructor TChangeLink.Create; +begin + inherited; + IgnoreIndex := True; + IgnoreImages := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TChangeLink.GetSender: TCustomImageList; +begin + Result := TCustomImageList(Images); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TChangeLink.SetSender(const Value: TCustomImageList); +begin + Images := TBaseImageList(Value); +end; + +{ THighQualityBitmap } + +constructor THighQualityBitmap.Create; +begin + + inherited; + +end; + +{ TFontHelper } + +function TFontHelper.GetOnChange: TNotifyEvent; +begin + Result:= OnChanged; +end; + +procedure TFontHelper.SetOnChange(const Value: TNotifyEvent); +begin + OnChanged:= Value; +end; + +end. diff --git a/Source/VirtualTrees.Header.pas b/Source/VirtualTrees.Header.pas new file mode 100644 index 000000000..019b677a3 --- /dev/null +++ b/Source/VirtualTrees.Header.pas @@ -0,0 +1,6003 @@ +unit VirtualTrees.Header; + +interface + +uses + WinApi.Windows, + WinApi.Messages, + System.Classes, + System.Types, + System.Generics.Collections, + Vcl.Graphics, + Vcl.Menus, + Vcl.ImgList, + Vcl.Controls, + Vcl.Themes, + Vcl.GraphUtil, + System.UITypes, // some types moved from Vcl.* to System.UITypes + VirtualTrees.StyleHooks, + VirtualTrees.Utils, + VirtualTrees.Types, + VirtualTrees.DragImage; + + +{$MINENUMSIZE 1, make enumerations as small as possible} + + +const + DefaultColumnOptions = [coAllowClick, coDraggable, coEnabled, coParentColor, coParentBidiMode, coResizable, + coShowDropMark, coVisible, coAllowFocus, coEditable, coStyleColor]; + +type + TVTHeader = class; + TVirtualTreeColumn = class; + + // This structure carries all important information about header painting and is used in the advanced header painting. + THeaderPaintInfo = record + TargetCanvas : TCanvas; + Column : TVirtualTreeColumn; + PaintRectangle : TRect; + TextRectangle : TRect; + IsHoverIndex, + IsDownIndex, + IsEnabled, + ShowHeaderGlyph, + ShowSortGlyph, + ShowRightBorder : Boolean; + DropMark : TVTDropMarkMode; + GlyphPos, + SortGlyphPos : TPoint; + SortGlyphSize : TSize; + procedure DrawSortArrow(pDirection : TSortDirection); + procedure DrawDropMark(); + end; + + TVirtualTreeColumns = class; + + TVirtualTreeColumn = class(TCollectionItem) + private + const + cDefaultColumnSpacing = 3; + private + FText, + FHint : string; + FWidth : TDimension; + FPosition : TColumnPosition; + FMinWidth : TDimension; + FMaxWidth : TDimension; + FStyle : TVirtualTreeColumnStyle; + FImageIndex : TImageIndex; + FBiDiMode : TBiDiMode; + FLayout : TVTHeaderColumnLayout; + FMargin, + FSpacing : TDimension; + FOptions : TVTColumnOptions; + FEditOptions : TVTEditOptions; + FEditNextColumn : TDimension; + FTag : NativeInt; + FAlignment : TAlignment; + FCaptionAlignment : TAlignment; // Alignment of the caption. + FLastWidth : TDimension; + FColor : TColor; + FBonusPixel : Boolean; + FSpringRest : Single; // Accumulator for width adjustment when auto spring option is enabled. + FCaptionText : string; + FCheckBox : Boolean; + FCheckType : TCheckType; + FCheckState : TCheckState; + FImageRect : TRect; + FHasImage : Boolean; + FDefaultSortDirection : TSortDirection; + function GetCaptionAlignment : TAlignment; + function GetCaptionWidth : TDimension; + function GetLeft : TDimension; + function IsBiDiModeStored : Boolean; + function IsCaptionAlignmentStored : Boolean; + function IsColorStored : Boolean; + procedure SetAlignment(const Value : TAlignment); + procedure SetBiDiMode(Value : TBiDiMode); + procedure SetCaptionAlignment(const Value : TAlignment); + procedure SetCheckBox(Value : Boolean); + procedure SetCheckState(Value : TCheckState); + procedure SetCheckType(Value : TCheckType); + procedure SetColor(const Value : TColor); + procedure SetImageIndex(Value : TImageIndex); + procedure SetLayout(Value : TVTHeaderColumnLayout); + procedure SetMargin(Value : TDimension); + procedure SetMaxWidth(Value : TDimension); + procedure SetMinWidth(Value : TDimension); + procedure SetOptions(Value : TVTColumnOptions); + procedure SetPosition(Value : TColumnPosition); + procedure SetSpacing(Value : TDimension); + procedure SetStyle(Value : TVirtualTreeColumnStyle); + + protected + FLeft : TDimension; + procedure ChangeScale(M, D : TDimension); virtual; + procedure ComputeHeaderLayout(var PaintInfo : THeaderPaintInfo; DrawFormat : Cardinal; CalculateTextRect : Boolean = False); + procedure DefineProperties(Filer : TFiler); override; + procedure GetAbsoluteBounds(var Left, Right : TDimension); + function GetDisplayName : string; override; + function GetText : string; virtual; // [IPK] + procedure SetText(const Value : string); virtual; // [IPK] private to protected & virtual + function GetOwner : TVirtualTreeColumns; reintroduce; + procedure InternalSetWidth(const Value : TDimension); //bypass side effects in SetWidth + procedure ReadHint(Reader : TReader); + procedure ReadText(Reader : TReader); + procedure SetCollection(Value : TCollection); override; + procedure SetWidth(Value : TDimension); + public + constructor Create(Collection : TCollection); override; + destructor Destroy; override; + + procedure Assign(Source : TPersistent); override; + function Equals(OtherColumnObj : TObject) : Boolean; override; + function GetRect : TRect; virtual; + property HasImage : Boolean read FHasImage; + property ImageRect : TRect read FImageRect; + procedure LoadFromStream(const Stream : TStream; Version : Integer); + procedure ParentBiDiModeChanged; + procedure ParentColorChanged; + procedure RestoreLastWidth; + function GetEffectiveColor() : TColor; + procedure SaveToStream(const Stream : TStream); + function UseRightToLeftReading : Boolean; + + property BonusPixel : Boolean read FBonusPixel write FBonusPixel; + property CaptionText : string read FCaptionText; + property LastWidth : TDimension read FLastWidth; + property Left : TDimension read GetLeft; + property Owner : TVirtualTreeColumns read GetOwner; + property SpringRest : Single read FSpringRest write FSpringRest; + published + property Alignment : TAlignment read FAlignment write SetAlignment default taLeftJustify; + property BiDiMode : TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored; + property CaptionAlignment : TAlignment read GetCaptionAlignment write SetCaptionAlignment + stored IsCaptionAlignmentStored default taLeftJustify; + property CaptionWidth : TDimension read GetCaptionWidth; + property CheckType : TCheckType read FCheckType write SetCheckType default ctCheckBox; + property CheckState : TCheckState read FCheckState write SetCheckState default csUncheckedNormal; + property CheckBox : Boolean read FCheckBox write SetCheckBox default False; + property Color : TColor read FColor write SetColor stored IsColorStored; + property DefaultSortDirection : TSortDirection read FDefaultSortDirection write FDefaultSortDirection default sdAscending; + property Hint : string read FHint write FHint; + property ImageIndex : TImageIndex read FImageIndex write SetImageIndex default - 1; + property Layout : TVTHeaderColumnLayout read FLayout write SetLayout default blGlyphLeft; + property Margin : TDimension read FMargin write SetMargin default 4; + property MaxWidth : TDimension read FMaxWidth write SetMaxWidth default 10000; + property MinWidth : TDimension read FMinWidth write SetMinWidth default 10; + property Options : TVTColumnOptions read FOptions write SetOptions default DefaultColumnOptions; + property EditOptions : TVTEditOptions read FEditOptions write FEditOptions default toDefaultEdit; + property EditNextColumn : TDimension read FEditNextColumn write FEditNextColumn default - 1; + property Position : TColumnPosition read FPosition write SetPosition; + property Spacing : TDimension read FSpacing write SetSpacing default cDefaultColumnSpacing; + property Style : TVirtualTreeColumnStyle read FStyle write SetStyle default vsText; + property Tag : NativeInt read FTag write FTag default 0; + property Text : string read GetText write SetText; + property Width : TDimension read FWidth write SetWidth default 50; + end; + + TVirtualTreeColumnClass = class of TVirtualTreeColumn; + + TColumnsArray = array of TVirtualTreeColumn; + TCardinalArray = array of Cardinal; + TIndexArray = array of TColumnIndex; + + TVirtualTreeColumns = class(TCollection) + private + FHeader : TVTHeader; + FHeaderBitmap : TBitmap; // backbuffer for drawing + FHoverIndex, // currently "hot" column + FDownIndex, // Column on which a mouse button is held down. + FTrackIndex : TColumnIndex; // Index of column which is currently being resized. + FClickIndex : TColumnIndex; // Index of the last clicked column. + FCheckBoxHit : Boolean; // True if the last click was on a header checkbox. + FPositionToIndex : TIndexArray; + FDefaultWidth : TDimension; // the width columns are created with + 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; + procedure SetDefaultWidth(Value : TDimension); + procedure SetItem(Index : TColumnIndex; Value : TVirtualTreeColumn); + function GetTreeView: TCustomControl; + protected + // drag support + FDragIndex : TColumnIndex; // index of column currently being dragged + FDropTarget : TColumnIndex; // current target column (index) while dragging + FDropBefore : Boolean; // True if drop position is in the left half of a column, False for the right + // side to drop the dragged column to + + procedure AdjustAutoSize(CurrentIndex : TColumnIndex; Force : Boolean = False); + function AdjustDownColumn(P : TPoint) : TColumnIndex; + function AdjustHoverColumn(P : TPoint) : Boolean; + procedure AdjustPosition(Column : TVirtualTreeColumn; Position : Cardinal); + function CanSplitterResize(P : TPoint; Column : TColumnIndex) : Boolean; + procedure DoCanSplitterResize(P : TPoint; Column : TColumnIndex; var Allowed : Boolean); virtual; + procedure DrawButtonText(DC : HDC; Caption : string; Bounds : TRect; Enabled, Hot : Boolean; DrawFormat : Cardinal; + WrapCaption : Boolean); + procedure FixPositions; + function GetColumnAndBounds(P : TPoint; var ColumnLeft, ColumnRight : TDimension; Relative : Boolean = True) : Integer; + function GetOwner : TPersistent; override; + function HandleClick(P : TPoint; Button : TMouseButton; Force, DblClick : Boolean) : Boolean; virtual; + procedure HeaderPopupMenuAddHeaderPopupItem(const Sender : TObject; const Column : TColumnIndex; var Cmd : TAddPopupItemType); + procedure IndexChanged(OldIndex, NewIndex : Integer); + procedure InitializePositionArray; + procedure Notify(Item : TCollectionItem; Action : System.Classes.TCollectionNotification); override; + procedure ReorderColumns(RTL : Boolean); + procedure SetHoverIndex(Index : TColumnIndex); + procedure Update(Item : TCollectionItem); override; + procedure UpdatePositions(Force : Boolean = False); + + property HeaderBitmap : TBitmap read FHeaderBitmap; + property PositionToIndex : TIndexArray read FPositionToIndex; + property HoverIndex : TColumnIndex read FHoverIndex write FHoverIndex; + property DownIndex : TColumnIndex read FDownIndex write FDownIndex; + property CheckBoxHit : Boolean read FCheckBoxHit write FCheckBoxHit; + // Mitigator function to use the correct style service for this context (either the style assigned to the control for Delphi > 10.4 or the application style) + function StyleServices(AControl : TControl = nil) : TCustomStyleServices; + public + constructor Create(AOwner : TVTHeader); virtual; + destructor Destroy; override; + + function Add : TVirtualTreeColumn; virtual; + procedure AnimatedResize(Column : TColumnIndex; NewWidth : TDimension); + procedure Assign(Source : TPersistent); override; + procedure Clear; virtual; + function ColumnFromPosition(P : TPoint; Relative : Boolean = True) : TColumnIndex; overload; virtual; + function ColumnFromPosition(PositionIndex : TColumnPosition) : TColumnIndex; overload; virtual; + function Equals(OtherColumnsObj : TObject) : Boolean; override; + procedure GetColumnBounds(Column : TColumnIndex; var Left, Right : TDimension); + function GetFirstVisibleColumn(ConsiderAllowFocus : Boolean = False) : TColumnIndex; + function GetLastVisibleColumn(ConsiderAllowFocus : Boolean = False) : TColumnIndex; + function GetFirstColumn : TColumnIndex; + function GetNextColumn(Column : TColumnIndex) : TColumnIndex; + function GetNextVisibleColumn(Column : TColumnIndex; ConsiderAllowFocus : Boolean = False) : TColumnIndex; + function GetPreviousColumn(Column : TColumnIndex) : TColumnIndex; + function GetPreviousVisibleColumn(Column : TColumnIndex; ConsiderAllowFocus : Boolean = False) : TColumnIndex; + function GetScrollWidth : TDimension; + function GetVisibleColumns : TColumnsArray; + + // multicell support + function GetSelectedCellColumns: TColumnsArray; + function HasMulticellSelection: Boolean; + + function GetVisibleFixedWidth : TDimension; + function IsValidColumn(Column : TColumnIndex) : Boolean; + procedure LoadFromStream(const Stream : TStream; Version : Integer); + procedure PaintHeader(DC : HDC; R : TRect; HOffset : TDimension); overload; virtual; + procedure PaintHeader(TargetCanvas : TCanvas; R : TRect; const Target : TPoint; + RTLOffset : TDimension = 0); overload; virtual; + procedure SaveToStream(const Stream : TStream); + procedure EndUpdate(); override; + function TotalWidth : TDimension; + + property Count : Integer read GetCount; + property ClickIndex : TColumnIndex read FClickIndex write FClickIndex; + property DefaultWidth : TDimension read FDefaultWidth write SetDefaultWidth; + property DragIndex : TColumnIndex read FDragIndex write FDragIndex; + property DropBefore : Boolean read FDropBefore write FDropBefore; + property DropTarget : TColumnIndex read FDropTarget write FDropTarget; + property Items[Index : TColumnIndex] : TVirtualTreeColumn read GetItem write SetItem; default; + property Header: TVTHeader read FHeader; + property TrackIndex : TColumnIndex read FTrackIndex write FTrackIndex; + property TreeView : TCustomControl read GetTreeView; + property UpdateCount; + end; + + TVirtualTreeColumnsClass = class of TVirtualTreeColumns; + + TVTConstraintPercent = 0 .. 100; + + TVTFixedAreaConstraints = class(TPersistent) + private + FHeader : TVTHeader; + FMaxHeightPercent, FMaxWidthPercent, FMinHeightPercent, FMinWidthPercent : TVTConstraintPercent; + FOnChange : TNotifyEvent; + procedure SetConstraints(Index : Integer; Value : TVTConstraintPercent); + protected + procedure Change; + property Header : TVTHeader read FHeader; + public + constructor Create(AOwner : TVTHeader); + + procedure Assign(Source : TPersistent); override; + property OnChange : TNotifyEvent read FOnChange write FOnChange; + published + property MaxHeightPercent : TVTConstraintPercent index 0 read FMaxHeightPercent write SetConstraints default 0; + property MaxWidthPercent : TVTConstraintPercent index 1 read FMaxWidthPercent write SetConstraints default 95; + property MinHeightPercent : TVTConstraintPercent index 2 read FMinHeightPercent write SetConstraints default 0; + property MinWidthPercent : TVTConstraintPercent index 3 read FMinWidthPercent write SetConstraints default 0; + end; + + TVTHeader = class(TPersistent) + private + FOwner : TCustomControl; + FColumns : TVirtualTreeColumns; + FHeight : TDimension; + FFont : TFont; + FParentFont : Boolean; + FOptions : TVTHeaderOptions; + FStyle : TVTHeaderStyle; //button style + FBackgroundColor : TColor; + FAutoSizeIndex : TColumnIndex; + FPopupMenu : TPopupMenu; + FMainColumn : TColumnIndex; //the column which holds the tree + FMaxHeight : TDimension; + FMinHeight : TDimension; + FDefaultHeight : TDimension; + FFixedAreaConstraints : TVTFixedAreaConstraints; //Percentages for the fixed area (header, fixed columns). + FImages : TCustomImageList; + FImageChangeLink : TChangeLink; //connections to the image list to get notified about changes + fSplitterHitTolerance : TDimension; //For property SplitterHitTolerance + FSortColumn : TColumnIndex; + FSortDirection : TSortDirection; + FDragImage : TVTDragImage; //drag image management during header drag + FLastWidth : TDimension; //Used to adjust spring columns. This is the width of all visible columns, not the header rectangle. + FRestoreSelectionColumnIndex : Integer; //The column that is used to implement the coRestoreSelection option + FWasDoubleClick : Boolean; // The previous mouse message was for a double click, that allows us to process mouse-up-messages differently + function GetMainColumn : TColumnIndex; + function GetSortColumn: TColumnIndex; // Getter for the property SortColumn + function GetSortDirection: TSortDirection; // Getter for the property SortDirection + function GetUseColumns : Boolean; + function IsFontStored : Boolean; + procedure SetAutoSizeIndex(Value : TColumnIndex); + procedure SetBackground(Value : TColor); + procedure SetColumns(Value : TVirtualTreeColumns); + procedure SetDefaultHeight(Value : TDimension); + procedure SetFont(const Value : TFont); + procedure SetHeight(Value : TDimension); + procedure SetImages(const Value : TCustomImageList); + procedure SetMainColumn(Value : TColumnIndex); + procedure SetMaxHeight(Value : TDimension); + procedure SetMinHeight(Value : TDimension); + procedure SetOptions(Value : TVTHeaderOptions); + procedure SetParentFont(Value : Boolean); + procedure SetSortColumn(Value : TColumnIndex); + procedure SetSortDirection(const Value : TSortDirection); + procedure SetStyle(Value : TVTHeaderStyle); + function GetRestoreSelectionColumnIndex : Integer; + function AreColumnsStored: Boolean; + protected + FStates : THeaderStates; //Used to keep track of internal states the header can enter. + FDragStart : TPoint; //initial mouse drag position + FTrackStart : TPoint; //client coordinates of the tracking start point + FTrackPoint : TPoint; //Client coordinate where the tracking started. + FDoingAutoFitColumns : Boolean; //Flag to avoid using the stored width for Main column + + procedure FontChanged(Sender : TObject); virtual; + procedure AutoScale(); virtual; + function CanSplitterResize(P : TPoint) : Boolean; + function CanWriteColumns : Boolean; virtual; + procedure ChangeScale(M, D : TDimension); virtual; + function DetermineSplitterIndex(P : TPoint) : Boolean; virtual; + procedure DoAfterAutoFitColumn(Column : TColumnIndex); virtual; + procedure DoAfterColumnWidthTracking(Column : TColumnIndex); virtual; + procedure DoAfterHeightTracking; virtual; + function DoBeforeAutoFitColumn(Column : TColumnIndex; SmartAutoFitType : TSmartAutoFitType) : Boolean; virtual; + procedure DoBeforeColumnWidthTracking(Column : TColumnIndex; Shift : TShiftState); virtual; + procedure DoBeforeHeightTracking(Shift : TShiftState); virtual; + procedure DoCanSplitterResize(P : TPoint; var Allowed : Boolean); virtual; + function DoColumnWidthDblClickResize(Column : TColumnIndex; P : TPoint; Shift : TShiftState) : Boolean; virtual; + function DoColumnWidthTracking(Column : TColumnIndex; Shift : TShiftState; var TrackPoint : TPoint; P : TPoint) : Boolean; virtual; + function DoGetPopupMenu(Column : TColumnIndex; Position : TPoint) : TPopupMenu; virtual; + 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 FixedAreaConstraintsChanged(Sender : TObject); + function GetColumnsClass : TVirtualTreeColumnsClass; virtual; + function GetOwner : TPersistent; override; + function GetShiftState : TShiftState; + function HandleHeaderMouseMove(var Message : TWMMouseMove) : Boolean; + function HandleMessage(var Message : TMessage) : Boolean; virtual; + procedure ImageListChange(Sender : TObject); + procedure PrepareDrag(P, Start : TPoint); + procedure ReadColumns(Reader : TReader); + procedure RecalculateHeader; virtual; + procedure RescaleHeader; + procedure UpdateMainColumn; + procedure UpdateSpringColumns; + procedure WriteColumns(Writer : TWriter); + procedure InternalSetMainColumn(const Index : TColumnIndex); + procedure InternalSetAutoSizeIndex(const Index : TColumnIndex); + procedure InternalSetSortColumn(const Index : TColumnIndex); + public + constructor Create(AOwner : TCustomControl); virtual; + destructor Destroy; override; + + function AllowFocus(ColumnIndex : TColumnIndex) : Boolean; + 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); + procedure LoadFromStream(const Stream : TStream); virtual; + function ResizeColumns(ChangeBy : TDimension; RangeStartCol : TColumnIndex; RangeEndCol : TColumnIndex; Options : TVTColumnOptions = [coVisible]) : TDimension; + procedure RestoreColumns; + procedure SaveToStream(const Stream : TStream); virtual; + procedure StyleChanged(); virtual; + procedure ToggleSortDirection(); + + property DragImage : TVTDragImage read FDragImage; + property RestoreSelectionColumnIndex : Integer read GetRestoreSelectionColumnIndex write FRestoreSelectionColumnIndex default NoColumn; + property States : THeaderStates read FStates; + property Treeview : TCustomControl read FOwner; + property UseColumns : Boolean read GetUseColumns; + property doingAutoFitColumns : Boolean read FDoingAutoFitColumns; + published + property AutoSizeIndex : TColumnIndex read FAutoSizeIndex write SetAutoSizeIndex; + property Background : TColor read FBackgroundColor write SetBackground default clBtnFace; + property Columns : TVirtualTreeColumns read FColumns write SetColumns stored AreColumnsStored; + property DefaultHeight : TDimension read FDefaultHeight write SetDefaultHeight default 19; + property Font : TFont read FFont write SetFont stored IsFontStored; + property FixedAreaConstraints : TVTFixedAreaConstraints read FFixedAreaConstraints write FFixedAreaConstraints; + property Height : TDimension read FHeight write SetHeight default 19; + property Images : TCustomImageList read FImages write SetImages; + property MainColumn : TColumnIndex read GetMainColumn write SetMainColumn default 0; + property MaxHeight : TDimension read FMaxHeight write SetMaxHeight default 10000; + property MinHeight : TDimension read FMinHeight write SetMinHeight default 10; + property Options : TVTHeaderOptions read FOptions write SetOptions default [hoColumnResize, hoDrag, hoShowSortGlyphs]; + property ParentFont : Boolean read FParentFont write SetParentFont default True; + property PopupMenu : TPopupMenu read FPopupMenu write FPopupMenu; + property SortColumn : TColumnIndex read GetSortColumn write SetSortColumn default NoColumn; + property SortDirection : TSortDirection read GetSortDirection write SetSortDirection default sdAscending; + property SplitterHitTolerance : TDimension read fSplitterHitTolerance write fSplitterHitTolerance default 8; + //The area in pixels around a spliter which is sensitive for resizing + property Style : TVTHeaderStyle read FStyle write SetStyle default hsThickButtons; + end; + + TVTHeaderClass = class of TVTHeader; + +implementation + +uses + WinApi.ShlObj, + WinApi.ActiveX, + WinApi.UxTheme, + System.Math, + System.SysUtils, + System.Generics.Defaults, + Vcl.Forms, + VirtualTrees.HeaderPopup, + VirtualTrees.BaseTree, + VirtualTrees.BaseAncestorVcl, // to eliminate H2443 about inline expanding + VirtualTrees.DataObject; + +resourcestring + SConstraintsNotAllowed = 'Cannot set mininum constraints when there are no columns!'; + +type + TVirtualTreeColumnsCracker = class(TVirtualTreeColumns); + TVirtualTreeColumnCracker = class(TVirtualTreeColumn); + TBaseVirtualTreeCracker = class(TBaseVirtualTree); + + TVTHeaderHelper = class helper for TVTHeader + public + function Tree : TBaseVirtualTreeCracker; + end; + + TVirtualTreeColumnHelper = class helper for TVirtualTreeColumn + function TreeViewControl : TBaseVirtualTreeCracker; + function Header : TVTHeader; + end; + + TVirtualTreeColumnsHelper = class helper for TVirtualTreeColumns + 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 ---------------------------------------------------------------------------- + +constructor TVTFixedAreaConstraints.Create(AOwner : TVTHeader); + +begin + inherited Create; + FMaxWidthPercent := 95; + FHeader := AOwner; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTFixedAreaConstraints.SetConstraints(Index : Integer; Value : TVTConstraintPercent); + +begin + case Index of + 0 : + if Value <> FMaxHeightPercent then + begin + FMaxHeightPercent := Value; + if (Value > 0) and (Value < FMinHeightPercent) then + FMinHeightPercent := Value; + Change; + end; + 1 : + if Value <> FMaxWidthPercent then + begin + FMaxWidthPercent := Value; + if (Value > 0) and (Value < FMinWidthPercent) then + FMinWidthPercent := Value; + Change; + end; + 2 : + if Value <> FMinHeightPercent then + begin + FMinHeightPercent := Value; + if (FMaxHeightPercent > 0) and (Value > FMaxHeightPercent) then + FMaxHeightPercent := Value; + Change; + end; + 3 : + if Value <> FMinWidthPercent then + begin + FMinWidthPercent := Value; + if (FMaxWidthPercent > 0) and (Value > FMaxWidthPercent) then + FMaxWidthPercent := Value; + Change; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTFixedAreaConstraints.Change; + +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTFixedAreaConstraints.Assign(Source : TPersistent); + +begin + if Source is TVTFixedAreaConstraints then + begin + FMaxHeightPercent := TVTFixedAreaConstraints(Source).FMaxHeightPercent; + FMaxWidthPercent := TVTFixedAreaConstraints(Source).FMaxWidthPercent; + FMinHeightPercent := TVTFixedAreaConstraints(Source).FMinHeightPercent; + FMinWidthPercent := TVTFixedAreaConstraints(Source).FMinWidthPercent; + Change; + end + else + inherited; +end; + +//----------------- TVTHeader ----------------------------------------------------------------------------------------- + +constructor TVTHeader.Create(AOwner : TCustomControl); + +begin + inherited Create; + FOwner := AOwner; + FColumns := GetColumnsClass.Create(Self); + FHeight := 19; + FDefaultHeight := FHeight; + FMinHeight := 10; + FMaxHeight := 10000; + FFont := TFont.Create; + FFont.OnChange := FontChanged; + FParentFont := True; + FBackgroundColor := clBtnFace; + FOptions := [hoColumnResize, hoDrag, hoShowSortGlyphs]; + + FImageChangeLink := TChangeLink.Create; + FImageChangeLink.OnChange := ImageListChange; + + FSortColumn := NoColumn; + FSortDirection := sdAscending; + FMainColumn := NoColumn; + + FDragImage := TVTDragImage.Create(AOwner); + fSplitterHitTolerance := 8; + FFixedAreaConstraints := TVTFixedAreaConstraints.Create(Self); + FFixedAreaConstraints.OnChange := FixedAreaConstraintsChanged; + + FDoingAutoFitColumns := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +destructor TVTHeader.Destroy; + +begin + FDragImage.Free; + FFixedAreaConstraints.Free; + FImageChangeLink.Free; + FFont.Free; + FColumns.Clear; //TCollection's Clear method is not virtual, so we have to call our own Clear method manually. + FColumns.Free; + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.FontChanged(Sender : TObject); +begin + inherited; + AutoScale(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.AutoScale(); +var + I : Integer; + lMaxHeight : TDimension; +begin + if (toAutoChangeScale in TBaseVirtualTreeCracker(Tree).TreeOptions.AutoOptions) then + begin + //Ensure a minimum header size based on the font, so that all text is visible. + //First find the largest Columns[].Spacing + lMaxHeight := 0; + for I := 0 to Self.Columns.Count - 1 do + lMaxHeight := Max(lMaxHeight, Columns[I].Spacing); + //Calculate the required height based on the font, this is important as the user might just have increased the size of the system icon font. + with TBitmap.Create do + try + Canvas.Font.Assign(FFont); + lMaxHeight := lMaxHeight { top spacing } + Divide(lMaxHeight, 2) { minimum bottom spacing } + Canvas.TextHeight('Q'); + finally + Free; + end; + //Set the calculated size + Self.SetHeight(lMaxHeight); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.GetMainColumn : TColumnIndex; +begin + if FColumns.Count > 0 then + Result := FMainColumn + else + Result := NoColumn; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.GetUseColumns : Boolean; +begin + Result := FColumns.Count > 0; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.IsFontStored : Boolean; +begin + Result := not ParentFont; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetAutoSizeIndex(Value : TColumnIndex); +begin + if FAutoSizeIndex <> Value then + begin + FAutoSizeIndex := Value; + if hoAutoResize in FOptions then + TVirtualTreeColumnsCracker(Columns).AdjustAutoSize(InvalidColumn); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetBackground(Value : TColor); +begin + if FBackgroundColor <> Value then + begin + FBackgroundColor := Value; + Invalidate(nil); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetColumns(Value : TVirtualTreeColumns); + +begin + FColumns.Assign(Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetDefaultHeight(Value : TDimension); +begin + if Value < FMinHeight then + Value := FMinHeight; + if Value > FMaxHeight then + Value := FMaxHeight; + + if FHeight = FDefaultHeight then + SetHeight(Value); + FDefaultHeight := Value; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetFont(const Value : TFont); +begin + FFont.Assign(Value); + FParentFont := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetHeight(Value : TDimension); + +var + RelativeMaxHeight, RelativeMinHeight, EffectiveMaxHeight, EffectiveMinHeight : TDimension; +begin + if not Tree.HandleAllocated then + begin + FHeight := Value; + Include(FStates, hsNeedScaling); + end + else + begin + with FFixedAreaConstraints do + begin + RelativeMaxHeight := Divide((Tree.ClientHeight + FHeight) * FMaxHeightPercent, 100); + RelativeMinHeight := Divide((Tree.ClientHeight + FHeight) * FMinHeightPercent, 100); + + EffectiveMinHeight := IfThen(FMaxHeightPercent > 0, Min(RelativeMaxHeight, FMinHeight), FMinHeight); + EffectiveMaxHeight := IfThen(FMinHeightPercent > 0, Max(RelativeMinHeight, FMaxHeight), FMaxHeight); + + Value := Min(Max(Value, EffectiveMinHeight), EffectiveMaxHeight); + if FMinHeightPercent > 0 then + Value := Max(RelativeMinHeight, Value); + if FMaxHeightPercent > 0 then + Value := Min(RelativeMaxHeight, Value); + end; + + if FHeight <> Value then + begin + FHeight := Value; + if not (csLoading in Tree.ComponentState) and not (hsScaling in FStates) then + RecalculateHeader; + Tree.Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetImages(const Value : TCustomImageList); + +begin + if FImages <> Value then + begin + if Assigned(FImages) then + begin + FImages.UnRegisterChanges(FImageChangeLink); + FImages.RemoveFreeNotification(FOwner); + end; + FImages := Value; + if Assigned(FImages) then + begin + FImages.RegisterChanges(FImageChangeLink); + FImages.FreeNotification(FOwner); + end; + if not (csLoading in Tree.ComponentState) then + Invalidate(nil); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetMainColumn(Value : TColumnIndex); + +begin + if (csLoading in Tree.ComponentState) or (csDestroying in Tree.ComponentState) then + FMainColumn := Value + else + begin + if Value < 0 then + Value := 0; + if Value > FColumns.Count - 1 then + Value := FColumns.Count - 1; + if Value <> FMainColumn then + begin + FMainColumn := Value; + Tree.MainColumnChanged; + if not (toExtendedFocus in Tree.TreeOptions.SelectionOptions) then + Tree.FocusedColumn := FMainColumn; + Tree.Invalidate; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetMaxHeight(Value : TDimension); + +begin + if Value < FMinHeight then + Value := FMinHeight; + FMaxHeight := Value; + SetHeight(FHeight); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetMinHeight(Value : TDimension); + +begin + if Value < 0 then + Value := 0; + if Value > FMaxHeight then + Value := FMaxHeight; + FMinHeight := Value; + SetHeight(FHeight); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetOptions(Value : TVTHeaderOptions); + +var + ToBeSet, ToBeCleared : TVTHeaderOptions; + +begin + ToBeSet := Value - FOptions; + ToBeCleared := FOptions - Value; + FOptions := Value; + + if (hoAutoResize in (ToBeSet + ToBeCleared)) and (FColumns.Count > 0) then + begin + TVirtualTreeColumnsCracker(FColumns).AdjustAutoSize(InvalidColumn); + if Tree.HandleAllocated then + begin + Tree.UpdateHorizontalScrollBar(False); + if hoAutoResize in ToBeSet then + Tree.Invalidate; + end; + end; + + if not (csLoading in Tree.ComponentState) and Tree.HandleAllocated then + begin + if hoVisible in (ToBeSet + ToBeCleared) then + RecalculateHeader; + Invalidate(nil); + Tree.Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetParentFont(Value : Boolean); + +begin + if FParentFont <> Value then + begin + FParentFont := Value; + if FParentFont then + FFont.Assign(TBaseVirtualTree(FOwner).Font); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetSortColumn(Value : TColumnIndex); + +begin + if csLoading in Tree.ComponentState then + FSortColumn := Value + else + DoSetSortColumn(Value, FSortDirection); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetSortDirection(const Value : TSortDirection); + +begin + if Value <> FSortDirection then + begin + FSortDirection := Value; + Invalidate(nil); + if ((toAutoSort in Tree.TreeOptions.AutoOptions) or (hoHeaderClickAutoSort in Options)) and (Tree.UpdateCount = 0) then + Tree.SortTree(FSortColumn, FSortDirection, True); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.CanSplitterResize(P : TPoint) : Boolean; + +begin + Result := hoHeightResize in FOptions; + DoCanSplitterResize(P, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SetStyle(Value : TVTHeaderStyle); + +begin + if FStyle <> Value then + begin + FStyle := Value; + if not (csLoading in Tree.ComponentState) then + Invalidate(nil); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.StyleChanged(); +begin + AutoScale(); //Elements may have changed in size +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.CanWriteColumns : Boolean; + +//descendants may override this to optionally prevent column writing (e.g. if they are build dynamically). + +begin + Result := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.ChangeScale(M, D : TDimension); +var + I : Integer; +begin + //This method is only executed if toAutoChangeScale is set + FMinHeight := MulDiv(FMinHeight, M, D); + FMaxHeight := MulDiv(FMaxHeight, M, D); + Self.Height := MulDiv(FHeight, M, D); + //Scale the columns widths too + for I := 0 to FColumns.Count - 1 do + TVirtualTreeColumnCracker(Self.FColumns[I]).ChangeScale(M, D); + if not ParentFont then + Font.Height := MulDiv(Font.Height, M, D); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.DetermineSplitterIndex(P : TPoint) : Boolean; + +//Tries to find the index of that column whose right border corresponds to P. +//Result is True if column border was hit (with -3..+5 pixels tolerance). +//For continuous resizing the current track index and the column's left/right border are set. +//Note: The hit test is checking from right to left (or left to right in RTL mode) to make enlarging of zero-sized +//columns possible. + +var + VisibleFixedWidth : TDimension; + SplitPoint : TDimension; + + //--------------- local function -------------------------------------------- + + function IsNearBy(IsFixedCol : Boolean; LeftTolerance, RightTolerance : TDimension) : Boolean; + + begin + if IsFixedCol then + Result := (P.X < SplitPoint + Tree.EffectiveOffsetX + RightTolerance) and (P.X > SplitPoint + Tree.EffectiveOffsetX - LeftTolerance) + else + Result := (P.X > VisibleFixedWidth) and (P.X < SplitPoint + RightTolerance) and (P.X > SplitPoint - LeftTolerance); + end; + +//--------------- end local function ---------------------------------------- + +var + I : Integer; + LeftTolerance : TDimension; //The area left of the column divider which allows column resizing +begin + Result := False; + + if FColumns.Count > 0 then + begin + FColumns.TrackIndex := NoColumn; + VisibleFixedWidth := FColumns.GetVisibleFixedWidth; + LeftTolerance := Round(SplitterHitTolerance * 0.6); + if Tree.UseRightToLeftAlignment then + begin + SplitPoint := - Tree.EffectiveOffsetX; + if FColumns.TotalWidth < Tree.ClientWidth then + Inc(SplitPoint, Tree.ClientWidth - FColumns.TotalWidth); + + for I := 0 to FColumns.Count - 1 do + with TVirtualTreeColumnsCracker(FColumns), Items[PositionToIndex[I]] do + if coVisible in Options then + begin + if IsNearBy(coFixed in Options, LeftTolerance, SplitterHitTolerance - LeftTolerance) then + begin + if CanSplitterResize(P, PositionToIndex[I]) then + begin + Result := True; + TrackIndex := PositionToIndex[I]; + + //Keep the right border of this column. This and the current mouse position + //directly determine the current column width. + FTrackPoint.X := SplitPoint + IfThen(coFixed in Options, Tree.EffectiveOffsetX) + Width; + FTrackPoint.Y := P.Y; + Break; + end; + end; + Inc(SplitPoint, Width); + end; + end + else + begin + SplitPoint := - Tree.EffectiveOffsetX + FColumns.TotalWidth; + + for I := FColumns.Count - 1 downto 0 do + with TVirtualTreeColumnsCracker(FColumns), Items[PositionToIndex[I]] do + if coVisible in Options then + begin + if IsNearBy(coFixed in Options, SplitterHitTolerance - LeftTolerance, LeftTolerance) then + begin + if CanSplitterResize(P, PositionToIndex[I]) then + begin + Result := True; + TrackIndex := PositionToIndex[I]; + + //Keep the left border of this column. This and the current mouse position + //directly determine the current column width. + FTrackPoint.X := SplitPoint + IfThen(coFixed in Options, Tree.EffectiveOffsetX) - Width; + FTrackPoint.Y := P.Y; + Break; + end; + end; + Dec(SplitPoint, Width); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.DoAfterAutoFitColumn(Column : TColumnIndex); + +begin + if Assigned(Tree.OnAfterAutoFitColumn) then + Tree.OnAfterAutoFitColumn(Self, Column); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.DoAfterColumnWidthTracking(Column : TColumnIndex); + +//Tell the application that a column width tracking operation has been finished. + +begin + if Assigned(Tree.OnAfterColumnWidthTracking) then + Tree.OnAfterColumnWidthTracking(Self, Column); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.DoAfterHeightTracking; + +//Tell the application that a height tracking operation has been finished. + +begin + if Assigned(Tree.OnAfterHeaderHeightTracking) then + Tree.OnAfterHeaderHeightTracking(Self); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.DoBeforeAutoFitColumn(Column : TColumnIndex; SmartAutoFitType : TSmartAutoFitType) : Boolean; + +//Query the application if we may autofit a column. + +begin + Result := True; + if Assigned(Tree.OnBeforeAutoFitColumn) then + Tree.OnBeforeAutoFitColumn(Self, Column, SmartAutoFitType, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.DoBeforeColumnWidthTracking(Column : TColumnIndex; Shift : TShiftState); + +//Tell the a application that a column width tracking operation may begin. + +begin + if Assigned(Tree.OnBeforeColumnWidthTracking) then + Tree.OnBeforeColumnWidthTracking(Self, Column, Shift); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.DoBeforeHeightTracking(Shift : TShiftState); + +//Tell the application that a height tracking operation may begin. + +begin + if Assigned(Tree.OnBeforeHeaderHeightTracking) then + Tree.OnBeforeHeaderHeightTracking(Self, Shift); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.DoCanSplitterResize(P : TPoint; var Allowed : Boolean); +begin + if Assigned(Tree.OnCanSplitterResizeHeader) then + Tree.OnCanSplitterResizeHeader(Self, P, Allowed); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.DoColumnWidthDblClickResize(Column : TColumnIndex; P : TPoint; Shift : TShiftState) : Boolean; + +//Queries the application whether a double click on the column splitter should resize the column. + +begin + Result := True; + if Assigned(Tree.OnColumnWidthDblClickResize) then + Tree.OnColumnWidthDblClickResize(Self, Column, Shift, P, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.DoColumnWidthTracking(Column : TColumnIndex; Shift : TShiftState; var TrackPoint : TPoint; P : TPoint) : Boolean; + +begin + Result := True; + if Assigned(Tree.OnColumnWidthTracking) then + Tree.OnColumnWidthTracking(Self, Column, Shift, TrackPoint, P, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.DoGetPopupMenu(Column : TColumnIndex; Position : TPoint) : TPopupMenu; + +//Queries the application whether there is a column specific header popup menu. + +var + AskParent : Boolean; + +begin + Result := PopupMenu; + if Assigned(Tree.OnGetPopupMenu) then + Tree.OnGetPopupMenu(TBaseVirtualTree(FOwner), nil, Column, Position, AskParent, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.DoHeightTracking(var P : TPoint; Shift : TShiftState) : Boolean; + +begin + Result := True; + if Assigned(Tree.OnHeaderHeightTracking) then + Tree.OnHeaderHeightTracking(Self, P, Shift, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.DoHeightDblClickResize(var P : TPoint; Shift : TShiftState) : Boolean; + +begin + Result := True; + if Assigned(Tree.OnHeaderHeightDblClickResize) then + Tree.OnHeaderHeightDblClickResize(Self, P, Shift, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.DoSetSortColumn(Value : TColumnIndex; pSortDirection : TSortDirection); + +begin + if Value < NoColumn then + Value := NoColumn; + if Value > Columns.Count - 1 then + Value := Columns.Count - 1; + if FSortColumn <> Value then + begin + if FSortColumn > NoColumn then + Invalidate(Columns[FSortColumn]); + FSortColumn := Value; + FSortDirection := pSortDirection; + if FSortColumn > NoColumn then + Invalidate(Columns[FSortColumn]); + if ((toAutoSort in Tree.TreeOptions.AutoOptions) or (hoHeaderClickAutoSort in Options)) and (Tree.UpdateCount = 0) then + Tree.SortTree(FSortColumn, FSortDirection, True); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.DragTo(P : TPoint); + +//Moves the drag image to a new position, which is determined from the passed point P and the previous +//mouse position. + +var + I, NewTarget : Integer; + //optimized drag image move support + ClientP : TPoint; + Left, Right : TDimension; + NeedRepaint : Boolean; //True if the screen needs an update (changed drop target or drop side) + +begin + //Determine new drop target and which side of it is prefered. + ClientP := Tree.ScreenToClient(P); + //Make coordinates relative to (0, 0) of the non-client area. + Inc(ClientP.Y, FHeight); + NewTarget := FColumns.ColumnFromPosition(ClientP); + NeedRepaint := (NewTarget <> InvalidColumn) and (NewTarget <> FColumns.DropTarget); + if NewTarget >= 0 then + begin + FColumns.GetColumnBounds(NewTarget, Left, Right); + if (ClientP.X < Divide((Left + Right), 2)) <> FColumns.DropBefore then + begin + NeedRepaint := True; + FColumns.DropBefore := not FColumns.DropBefore; + end; + end; + + if NeedRepaint then + begin + //Invalidate columns which need a repaint. + if FColumns.DropTarget > NoColumn then + begin + I := FColumns.DropTarget; + FColumns.DropTarget := NoColumn; + Invalidate(FColumns.Items[I]); + end; + if (NewTarget > NoColumn) and (NewTarget <> FColumns.DropTarget) then + begin + Invalidate(FColumns.Items[NewTarget]); + FColumns.DropTarget := NewTarget; + end; + end; + + //Fix for various problems mentioned in issue 248. + if NeedRepaint then + TBaseVirtualTreeCracker(FOwner).UpdateWindow(); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.FixedAreaConstraintsChanged(Sender : TObject); + +//This method gets called when FFixedAreaConstraints is changed. + + function HasFixedColumns: LongBool; + var + I: Integer; + begin + Result := False; + for I := 0 to Columns.Count-1 do + begin + if coFixed in Columns[I].Options then + Exit(True); + end; + end; + +begin + if Tree.HandleAllocated then + RescaleHeader + else + Include(FStates, hsNeedScaling); + if (FixedAreaConstraints.MinWidthPercent > 0) and not HasFixedColumns then + begin + FixedAreaConstraints.FMinWidthPercent := 0; + raise EVirtualTreeError.CreateRes(PResStringRec(@SConstraintsNotAllowed)); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.GetColumnsClass : TVirtualTreeColumnsClass; + +//Returns the class to be used for the actual column implementation. descendants may optionally override this and +//return their own class. + +begin + Result := TVirtualTreeColumns; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.GetOwner : TPersistent; + +begin + Result := FOwner; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.GetRestoreSelectionColumnIndex : Integer; +begin + if FRestoreSelectionColumnIndex >= 0 then + Result := FRestoreSelectionColumnIndex + else + Result := MainColumn; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.GetShiftState : TShiftState; + +begin + Result := []; + if GetKeyState(VK_SHIFT) < 0 then + Include(Result, ssShift); + if GetKeyState(VK_CONTROL) < 0 then + Include(Result, ssCtrl); + if GetKeyState(VK_MENU) < 0 then + Include(Result, ssAlt); +end; + +function TVTHeader.GetSortColumn: TColumnIndex; +begin + Exit(FSortColumn); // See issue #1319 +end; + +function TVTHeader.GetSortDirection: TSortDirection; +begin + Exit(FSortdirection); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.HandleHeaderMouseMove(var Message : TWMMouseMove) : Boolean; + +var + P : TPoint; + NextColumn, I : TColumnIndex; + NewWidth : TDimension; + iOffsetX : TDimension; + +begin + Result := False; + with Message do + begin + P := Point(XPos, YPos); + if hsColumnWidthTrackPending in FStates then + begin + Tree.StopTimer(HeaderTimer); + FStates := FStates - [hsColumnWidthTrackPending] + [hsColumnWidthTracking]; + HandleHeaderMouseMove := True; + Result := 0; + end + else if hsHeightTrackPending in FStates then + begin + Tree.StopTimer(HeaderTimer); + FStates := FStates - [hsHeightTrackPending] + [hsHeightTracking]; + HandleHeaderMouseMove := True; + Result := 0; + end + else if hsColumnWidthTracking in FStates then + begin + if DoColumnWidthTracking(FColumns.TrackIndex, GetShiftState, FTrackPoint, P) then + begin + if Tree.UseRightToLeftAlignment then + begin + NewWidth := FTrackPoint.X - XPos; + NextColumn := FColumns.GetPreviousVisibleColumn(FColumns.TrackIndex); + end + else + begin + NewWidth := XPos - FTrackPoint.X; + NextColumn := FColumns.GetNextVisibleColumn(FColumns.TrackIndex); + end; + + iOffsetX := Tree.EffectiveOffsetX; + + // The autosized column cannot be resized using the mouse normally. Instead we resize the next + // visible column, so it look as we directly resize the autosized column. + if (hoAutoResize in FOptions) and (FColumns.TrackIndex = FAutoSizeIndex) and + (NextColumn > NoColumn) and (coResizable in FColumns[NextColumn].Options) and + (FColumns[FColumns.TrackIndex].MinWidth < NewWidth) and + (FColumns[FColumns.TrackIndex].MaxWidth > NewWidth) then + FColumns[NextColumn].Width := FColumns[NextColumn].Width - NewWidth + + FColumns[FColumns.TrackIndex].Width + else + FColumns[FColumns.TrackIndex].Width := NewWidth; // 1 EListError seen here (List index out of bounds (-1)) since 10/2013 + + if (iOffsetX > 0) and (iOffsetX <> Tree.EffectiveOffsetX) then + FTrackPoint.X := FTrackPoint.X + iOffsetX - Tree.EffectiveOffsetX; + end; + HandleHeaderMouseMove := True; + Result := 0; + end + else if hsHeightTracking in FStates then + begin + if DoHeightTracking(P, GetShiftState) then + SetHeight(FHeight + P.Y); + HandleHeaderMouseMove := True; + Result := 0; + end + else + begin + if hsDragPending in FStates then + begin + P := Tree.ClientToScreen(P); + //start actual dragging if allowed + if (hoDrag in FOptions) and Tree.DoHeaderDragging(TVirtualTreeColumnsCracker(FColumns).DownIndex) then + begin + if ((Abs(FDragStart.X - P.X) > Mouse.DragThreshold) or (Abs(FDragStart.Y - P.Y) > Mouse.DragThreshold)) then + begin + Tree.StopTimer(HeaderTimer); + with TVirtualTreeColumnsCracker(FColumns) do + begin + I := DownIndex; + DownIndex := NoColumn; + HoverIndex := NoColumn; + if I > NoColumn then + Invalidate(FColumns[I]); + end; + FStates := FStates - [hsDragPending] + [hsDragging]; + PrepareDrag(P, FDragStart); + HandleHeaderMouseMove := True; + Result := 0; + end; + end; + end + else if hsDragging in FStates then + begin + DragTo(Tree.ClientToScreen(Point(XPos, YPos))); + HandleHeaderMouseMove := True; + Result := 0; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.HandleMessage(var Message : TMessage) : Boolean; + +//The header gets here the opportunity to handle certain messages before they reach the tree. This is important +//because the tree needs to handle various non-client area messages for the header as well as some dragging/tracking +//events. +//By returning True the message will not be handled further, otherwise the message is then dispatched +//to the proper message handlers. + +var + P : TPoint; + I : TColumnIndex; + HitIndex : TColumnIndex; + NewCursor : TVTCursor; + Button : TMouseButton; + IsInHeader, IsHSplitterHit, IsVSplitterHit : Boolean; + + //--------------- local function -------------------------------------------- + + function HSplitterHit : Boolean; + begin + Result := (hoColumnResize in FOptions) and DetermineSplitterIndex(P); + if Result and not InHeader(P) then + begin + // Code commented due to issue #1067. What was the orginal inention of this code? It does not make much sense unless you allow column resize outside the header. + //NextCol := FColumns.GetNextVisibleColumn(FColumns.TrackIndex); + //if not (coFixed in FColumns[FColumns.TrackIndex].Options) or (NextCol <= NoColumn) or + // (coFixed in FColumns[NextCol].Options) or (P.Y > Tree.RangeY) then + Result := False; + end; + end; + +//--------------- end local function ---------------------------------------- + +begin + Result := False; + case Message.Msg of + WM_SIZE : + begin + if not (tsWindowCreating in TBaseVirtualTreeCracker(FOwner).TreeStates) then + if (hoAutoResize in FOptions) and not (hsAutoSizing in FStates) then + begin + TVirtualTreeColumnsCracker(FColumns).AdjustAutoSize(InvalidColumn); + Invalidate(nil); + end + else if not (hsScaling in FStates) then + begin + RescaleHeader; + Invalidate(nil); + end; + end; + CM_PARENTFONTCHANGED : + if FParentFont then + FFont.Assign(TBaseVirtualTreeCracker(FOwner).Font); + CM_BIDIMODECHANGED : + for I := 0 to FColumns.Count - 1 do + if coParentBiDiMode in FColumns[I].Options then + FColumns[I].ParentBiDiModeChanged; + WM_NCMBUTTONDOWN : + begin + with TWMNCMButtonDown(Message) do + P := Tree.ScreenToClient(Point(XCursor, YCursor)); + if InHeader(P) then + TBaseVirtualTreeCracker(FOwner).DoHeaderMouseDown(mbMiddle, GetShiftState, P.X, P.Y + FHeight); + end; + WM_NCMBUTTONUP : + begin + with TWMNCMButtonUp(Message) do + P := FOwner.ScreenToClient(Point(XCursor, YCursor)); + if InHeader(P) then + begin + with TVirtualTreeColumnsCracker(FColumns) do + begin + HandleClick(P, mbMiddle, True, False); + TBaseVirtualTreeCracker(FOwner).DoHeaderMouseUp(TmouseButton.mbMiddle, GetShiftState, P.X, P.Y + Self.FHeight); + DownIndex := NoColumn; + CheckBoxHit := False; + end; + end; + fWasDoubleClick := False; + end; + WM_LBUTTONDBLCLK, WM_NCLBUTTONDBLCLK, WM_NCMBUTTONDBLCLK, WM_NCRBUTTONDBLCLK : + begin + fWasDoubleClick := True; + if Message.Msg <> WM_LBUTTONDBLCLK then + with TWMNCLButtonDblClk(Message) do + P := FOwner.ScreenToClient(Point(XCursor, YCursor)) + else + with TWMLButtonDblClk(Message) do + P := Point(XPos, YPos); + + if (hoHeightDblClickResize in FOptions) and InHeaderSplitterArea(P) and (FDefaultHeight > 0) then + begin + if DoHeightDblClickResize(P, GetShiftState) and (FDefaultHeight > 0) then + SetHeight(FMinHeight); + Result := True; + end + else if HSplitterHit and ((Message.Msg = WM_NCLBUTTONDBLCLK) or (Message.Msg = WM_LBUTTONDBLCLK)) and (hoDblClickResize in FOptions) and (FColumns.TrackIndex > NoColumn) + then + begin + //If the click was on a splitter then resize column to smallest width. + if DoColumnWidthDblClickResize(FColumns.TrackIndex, P, GetShiftState) then + AutoFitColumns(True, smaUseColumnOption, FColumns[FColumns.TrackIndex].Position, FColumns[FColumns.TrackIndex].Position); + Message.Result := 0; + Result := True; + end + else if InHeader(P) and (Message.Msg <> WM_LBUTTONDBLCLK) then + begin + case Message.Msg of + WM_NCMBUTTONDBLCLK : + Button := TMouseButton.mbMiddle; + WM_NCRBUTTONDBLCLK : + Button := TMouseButton.mbRight; + else + //WM_NCLBUTTONDBLCLK + Button := TMouseButton.mbLeft; + end; + if Button = TMouseButton.mbLeft then + TVirtualTreeColumnsCracker(FColumns).AdjustDownColumn(P); + TVirtualTreeColumnsCracker(FColumns).HandleClick(P, Button, True, True); + end; + end; + //The "hot" area of the headers horizontal splitter is partly within the client area of the the tree, so we need + //to handle WM_LBUTTONDOWN here, too. + WM_LBUTTONDOWN, WM_NCLBUTTONDOWN : + begin + + Application.CancelHint; + + if not (csDesigning in Tree.ComponentState) then + begin + with Tree do + begin + //make sure no auto scrolling is active... + StopTimer(ScrollTimer); + DoStateChange([], [tsScrollPending, tsScrolling]); + //... pending editing is cancelled (actual editing remains active) + StopTimer(EditTimer); + DoStateChange([], [tsEditPending]); + end; + end; + + if Message.Msg = WM_LBUTTONDOWN then + //Coordinates are already client area based. + with TWMLButtonDown(Message) do + begin + P := Point(XPos, YPos); + //#909 + FDragStart := Tree.ClientToScreen(P); + end + else + with TWMNCLButtonDown(Message) do + begin + //want the drag start point in screen coordinates + FDragStart := Point(XCursor, YCursor); + P := Tree.ScreenToClient(FDragStart); + end; + + IsInHeader := InHeader(P); + //in design-time header columns are always resizable + if (csDesigning in Tree.ComponentState) then + IsVSplitterHit := InHeaderSplitterArea(P) + else + IsVSplitterHit := InHeaderSplitterArea(P) and CanSplitterResize(P); + IsHSplitterHit := HSplitterHit; + + if IsVSplitterHit or IsHSplitterHit then + begin + FTrackStart := P; + TVirtualTreeColumnsCracker(FColumns).HoverIndex := NoColumn; + if IsVSplitterHit then + begin + if not (csDesigning in Tree.ComponentState) then + DoBeforeHeightTracking(GetShiftState); + Include(FStates, hsHeightTrackPending); + end + else + begin + if not (csDesigning in Tree.ComponentState) then + DoBeforeColumnWidthTracking(FColumns.TrackIndex, GetShiftState); + Include(FStates, hsColumnWidthTrackPending); + end; + + SetCapture(Tree.Handle); + Result := True; + Message.Result := 0; + end + else if IsInHeader then + begin + HitIndex := TVirtualTreeColumnsCracker(FColumns).AdjustDownColumn(P); + //in design-time header columns are always draggable + if ((csDesigning in Tree.ComponentState) and (HitIndex > NoColumn)) or ((hoDrag in FOptions) and (HitIndex > NoColumn) and (coDraggable in FColumns[HitIndex].Options)) + then + begin + //Show potential drag operation. + //Disabled columns do not start a drag operation because they can't be clicked. + Include(FStates, hsDragPending); + SetCapture(Tree.Handle); + Result := True; + Message.Result := 0; + end; + end; + + //This is a good opportunity to notify the application. + if not (csDesigning in Tree.ComponentState) and IsInHeader then + TBaseVirtualTreeCracker(FOwner).DoHeaderMouseDown(TMouseButton.mbLeft, GetShiftState, P.X, P.Y + FHeight); + end; + WM_NCRBUTTONDOWN : + begin + with TWMNCRButtonDown(Message) do + P := FOwner.ScreenToClient(Point(XCursor, YCursor)); + if InHeader(P) then + TBaseVirtualTreeCracker(FOwner).DoHeaderMouseDown(TMouseButton.mbRight, GetShiftState, P.X, P.Y + FHeight); + end; + WM_NCRBUTTONUP : + if not (csDesigning in FOwner.ComponentState) then + with TWMNCRButtonUp(Message) do + begin + Application.CancelHint; + P := FOwner.ScreenToClient(Point(XCursor, YCursor)); + if InHeader(P) then + begin + HandleMessage := TVirtualTreeColumnsCracker(FColumns).HandleClick(P, TMouseButton.mbRight, True, False); + TBaseVirtualTreeCracker(FOwner).DoHeaderMouseUp(TMouseButton.mbRight, GetShiftState, P.X, P.Y + FHeight); + end; + fWasDoubleClick := False; + end; + //When the tree window has an active mouse capture then we only get "client-area" messages. + WM_LBUTTONUP, WM_NCLBUTTONUP : + begin + Application.CancelHint; + + if FStates <> [] then + begin + ReleaseCapture; + if hsDragging in FStates then + begin + //successfull dragging moves columns + with TWMLButtonUp(Message) do + P := Tree.ClientToScreen(Point(XPos, YPos)); + ColumnDropped(P); + end; + Result := True; + Message.Result := 0; + fWasDoubleClick := False; + end; + + case Message.Msg of + WM_LBUTTONUP : + with TWMLButtonUp(Message) do + begin + with TVirtualTreeColumnsCracker(FColumns) do + begin + if DownIndex > NoColumn then + HandleClick(Point(XPos, YPos), TMouseButton.mbLeft, False, False); + end; + if FStates <> [] then + TBaseVirtualTreeCracker(FOwner).DoHeaderMouseUp(TMouseButton.mbLeft, KeysToShiftState(Keys), XPos, YPos); + fWasDoubleClick := False; + end; + WM_NCLBUTTONUP : + begin + with TWMNCLButtonUp(Message) do + P := FOwner.ScreenToClient(Point(XCursor, YCursor)); + if not fWasDoubleClick then + TVirtualTreeColumnsCracker(FColumns).HandleClick(P, TMouseButton.mbLeft, True, False); + TBaseVirtualTreeCracker(FOwner).DoHeaderMouseUp(TMouseButton.mbLeft, GetShiftState, P.X, P.Y + FHeight); + Result := True; + fWasDoubleClick := False; + end; + end; + + if FColumns.TrackIndex > NoColumn then + begin + if hsColumnWidthTracking in FStates then + DoAfterColumnWidthTracking(FColumns.TrackIndex); + Invalidate(Columns[FColumns.TrackIndex]); + FColumns.TrackIndex := NoColumn; + end; + with TVirtualTreeColumnsCracker(FColumns) do + begin + if DownIndex > NoColumn then + begin + Invalidate(FColumns[DownIndex]); + DownIndex := NoColumn; + end; + end; + if hsHeightTracking in FStates then + DoAfterHeightTracking; + + FStates := FStates - [hsDragging, hsDragPending, hsColumnWidthTracking, hsColumnWidthTrackPending, hsHeightTracking, hsHeightTrackPending]; + end; //WM_NCLBUTTONUP + //hovering, mouse leave detection + WM_NCMOUSEMOVE : + with TWMNCMouseMove(Message), TVirtualTreeColumnsCracker(FColumns) do + begin + P := Tree.ScreenToClient(Point(XCursor, YCursor)); + Tree.DoHeaderMouseMove(GetShiftState, P.X, P.Y + FHeight); + if InHeader(P) and ((AdjustHoverColumn(P)) or ((DownIndex >= 0) and (HoverIndex <> DownIndex))) then + begin + //We need a mouse leave detection from here for the non client area. + //TODO: The best solution available would be the TrackMouseEvent API. + //With the drop of the support of Win95 totally and WinNT4 we should replace the timer. + Tree.StopTimer(HeaderTimer); + SetTimer(Tree.Handle, HeaderTimer, 50, nil); + //use Delphi's internal hint handling for header hints too + if hoShowHint in FOptions then + begin + //client coordinates! + XCursor := P.X; + YCursor := P.Y + FHeight; + Application.HintMouseMessage(FOwner, Message); + end; + end; + end; + WM_TIMER : + if TWMTimer(Message).TimerID = HeaderTimer then + begin + //determine current mouse position to check if it left the window + GetCursorPos(P); + P := Tree.ScreenToClient(P); + with TVirtualTreeColumnsCracker(FColumns) do + begin + if not InHeader(P) or ((DownIndex > NoColumn) and (HoverIndex <> DownIndex)) then + begin + Tree.StopTimer(HeaderTimer); + HoverIndex := NoColumn; + ClickIndex := NoColumn; + DownIndex := NoColumn; + CheckBoxHit := False; + Result := True; + Message.Result := 0; + Invalidate(nil); + end; + end; + end; + WM_MOUSEMOVE : //mouse capture and general message redirection + Result := HandleHeaderMouseMove(TWMMouseMove(Message)); + WM_SETCURSOR : + //Feature: design-time header + if (FStates = []) then + begin + //Retrieve last cursor position (GetMessagePos does not work here, I don't know why). + GetCursorPos(P); + + //Is the mouse in the header rectangle and near the splitters? + P := Tree.ScreenToClient(P); + IsHSplitterHit := HSplitterHit; + //in design-time header columns are always resizable + if (csDesigning in Tree.ComponentState) then + IsVSplitterHit := InHeaderSplitterArea(P) + else + IsVSplitterHit := InHeaderSplitterArea(P) and CanSplitterResize(P); + + if IsVSplitterHit or IsHSplitterHit then + begin + NewCursor := Screen.Cursors[Tree.Cursor]; + if IsVSplitterHit and ((hoHeightResize in FOptions) or (csDesigning in Tree.ComponentState)) then + NewCursor := Screen.Cursors[crVSplit] + else if IsHSplitterHit then + NewCursor := Screen.Cursors[crHSplit]; + + if not (csDesigning in Tree.ComponentState) then + Tree.DoGetHeaderCursor(NewCursor); + Result := NewCursor <> Screen.Cursors[crDefault]; + if Result then + begin + WinApi.Windows.SetCursor(NewCursor); + Message.Result := 1; + end; + end; + end + else + begin + Message.Result := 1; + Result := True; + end; + WM_KEYDOWN, WM_KILLFOCUS : + if (Message.Msg = WM_KILLFOCUS) or (TWMKeyDown(Message).CharCode = VK_ESCAPE) then + begin + if hsDragging in FStates then + begin + ReleaseCapture; + FDragImage.EndDrag; + Exclude(FStates, hsDragging); + FColumns.DropTarget := NoColumn; + Invalidate(nil); + Result := True; + Message.Result := 0; + end + else + begin + if [hsColumnWidthTracking, hsHeightTracking] * FStates <> [] then + begin + ReleaseCapture; + if hsColumnWidthTracking in FStates then + DoAfterColumnWidthTracking(FColumns.TrackIndex); + if hsHeightTracking in FStates then + DoAfterHeightTracking; + Result := True; + Message.Result := 0; + end; + + FStates := FStates - [hsColumnWidthTracking, hsColumnWidthTrackPending, hsHeightTracking, hsHeightTrackPending]; + end; + end; + 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); + +begin + if not (csDestroying in Tree.ComponentState) then + Invalidate(nil); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.PrepareDrag(P, Start : TPoint); + +//Initializes dragging of the header, P is the current mouse postion and Start the initial mouse position. + +var + Image : TBitmap; + 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). + FColumns.DropTarget := NoColumn; + Start := Tree.ScreenToClient(Start); + Inc(Start.Y, FHeight); + FColumns.DragIndex := FColumns.ColumnFromPosition(Start); + DragColumn := FColumns[FColumns.DragIndex]; + + Image := TBitmap.Create; + with Image do + try + PixelFormat := pf32Bit; + SetSize(DragColumn.Width, FHeight); + + //Erase the entire image with the color key value, for the case not everything + //in the image is covered by the header image. + Canvas.Brush.Color := clBtnFace; + Canvas.FillRect(Rect(0, 0, Width, Height)); + + if Tree.UseRightToLeftAlignment then + RTLOffset := Tree.ComputeRTLOffset + else + RTLOffset := 0; + with DragColumn do + FColumns.PaintHeader(Canvas, Rect(Left, 0, Left + Width, Height), Point( - RTLOffset, 0), RTLOffset); + + //Column rectangles are given in local window coordinates not client coordinates. + 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; + + 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; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.ReadColumns(Reader : TReader); + +begin + Include(FStates, hsLoading); + Columns.Clear; + Reader.ReadValue; + Reader.ReadCollection(Columns); + Exclude(FStates, hsLoading); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.RecalculateHeader; + +//Initiate a recalculation of the non-client area of the owner tree. + +begin + if Tree.HandleAllocated then + begin + Tree.UpdateHeaderRect; + SetWindowPos(Tree.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOSENDCHANGING or SWP_NOSIZE or SWP_NOZORDER); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.RescaleHeader; + +//Rescale the fixed elements (fixed columns, header itself) to FixedAreaConstraints. + +var + FixedWidth, MaxFixedWidth, MinFixedWidth : TDimension; + + //--------------- local function -------------------------------------------- + + procedure ComputeConstraints; + + var + I : TColumnIndex; + + begin + with FColumns do + begin + I := GetFirstVisibleColumn; + while I > NoColumn do + begin + if (coFixed in FColumns[I].Options) and (FColumns[I].Width < FColumns[I].MinWidth) then + TVirtualTreeColumnCracker(FColumns[I]).InternalSetWidth(FColumns[I].MinWidth); //SetWidth has side effects and this bypasses them + I := GetNextVisibleColumn(I); + end; + FixedWidth := GetVisibleFixedWidth; + end; + + with FFixedAreaConstraints do + begin + MinFixedWidth := Divide(Tree.ClientWidth * FMinWidthPercent, 100); + MaxFixedWidth := Divide(Tree.ClientWidth * FMaxWidthPercent, 100); + end; + end; + +//----------- end local function -------------------------------------------- + +begin + if ([csLoading, csReading, csWriting, csDestroying] * Tree.ComponentState = []) and not (hsLoading in FStates) and Tree.HandleAllocated then + begin + Include(FStates, hsScaling); + + SetHeight(FHeight); + RecalculateHeader; + + with FFixedAreaConstraints do + if (FMaxWidthPercent > 0) or (FMinWidthPercent > 0) or (FMinHeightPercent > 0) or (FMaxHeightPercent > 0) then + begin + ComputeConstraints; + + with FColumns do + if (FMaxWidthPercent > 0) and (FixedWidth > MaxFixedWidth) then + ResizeColumns(MaxFixedWidth - FixedWidth, 0, Count - 1, [coVisible, coFixed]) + else if (FMinWidthPercent > 0) and (FixedWidth < MinFixedWidth) then + ResizeColumns(MinFixedWidth - FixedWidth, 0, Count - 1, [coVisible, coFixed]); + + TVirtualTreeColumnsCracker(FColumns).UpdatePositions; + end; + + Exclude(FStates, hsScaling); + Exclude(FStates, hsNeedScaling); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.UpdateMainColumn(); + +//Called once the load process of the owner tree is done. + +begin + if FMainColumn < 0 then + MainColumn := 0; + if FMainColumn > FColumns.Count - 1 then + MainColumn := FColumns.Count - 1; + if (FMainColumn >= 0) and not (coVisible in Self.Columns[FMainColumn].Options) then + begin + //Issue #946: Choose new MainColumn if current one ist not visible + MainColumn := Self.Columns.GetFirstVisibleColumn(); + end +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.UpdateSpringColumns; + +var + I : TColumnIndex; + SpringCount : Integer; + Sign : Integer; + ChangeBy : Single; + Difference : Single; + NewAccumulator : Single; + +begin + with Tree do + ChangeBy := HeaderRect.Right - HeaderRect.Left - FLastWidth; + if (hoAutoSpring in FOptions) and (FLastWidth <> 0) and (ChangeBy <> 0) then + begin + //Stay positive if downsizing the control. + if ChangeBy < 0 then + Sign := - 1 + else + Sign := 1; + ChangeBy := Abs(ChangeBy); + //Count how many columns have spring enabled. + SpringCount := 0; + for I := 0 to FColumns.Count - 1 do + if [coVisible, coAutoSpring] * FColumns[I].Options = [coVisible, coAutoSpring] then + System.Inc(SpringCount); + if SpringCount > 0 then + begin + //Calculate the size to add/sub to each columns. + Difference := ChangeBy / SpringCount; + //Adjust the column's size accumulators and resize if the result is >= 1. + for I := 0 to FColumns.Count - 1 do + if [coVisible, coAutoSpring] * FColumns[I].Options = [coVisible, coAutoSpring] then + begin + //Sum up rest changes from previous runs and the amount from this one and store it in the + //column. If there is at least one pixel difference then do a resize and reset the accumulator. + NewAccumulator := FColumns[I].SpringRest + Difference; + //Set new width if at least one pixel size difference is reached. + if NewAccumulator >= 1 then + TVirtualTreeColumnCracker(FColumns[I]).SetWidth(FColumns[I].Width + (Trunc(NewAccumulator) * Sign)); + FColumns[I].SpringRest := Frac(NewAccumulator); + + //Keep track of the size count. + ChangeBy := ChangeBy - Difference; + //Exit loop if resize count drops below freezing point. + if ChangeBy < 0 then + Break; + end; + end; + end; + with Tree do + FLastWidth := HeaderRect.Right - HeaderRect.Left; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +type + //--- HACK WARNING! + //This type cast is a partial rewrite of the private section of TWriter. The purpose is to have access to + //the FPropPath member, which is otherwise not accessible. The reason why this access is needed is that + //with nested components this member contains unneeded property path information. These information prevent + //successful load of the stored properties later. + //In System.Classes.pas you can see that FPropPath is reset several times to '' to prevent this case for certain properies. + //Unfortunately, there is no clean way for us here to do the same. +{$HINTS off} + TWriterHack = class(TFiler) + private + FRootAncestor : TComponent; + FPropPath : string; + end; +{$HINTS on} + + +procedure TVTHeader.WriteColumns(Writer : TWriter); + +//Write out the columns but take care for the case VT is a nested component. + +var + LastPropPath : string; + +begin + //Save last property path for restoration. + LastPropPath := TWriterHack(Writer).FPropPath; + try + //If VT is a nested component then this path contains the name of the parent component at this time + //(otherwise it is already empty). This path is then combined with the property name under which the tree + //is defined in the parent component. Unfortunately, the load code in System.Classes.pas does not consider this case + //is then unable to load this property. + TWriterHack(Writer).FPropPath := ''; + Writer.WriteCollection(Columns); + finally + TWriterHack(Writer).FPropPath := LastPropPath; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.AllowFocus(ColumnIndex : TColumnIndex) : Boolean; +begin + Result := False; + if not FColumns.IsValidColumn(ColumnIndex) then + Exit; //Just in case. + + Result := (coAllowFocus in FColumns[ColumnIndex].Options); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.AreColumnsStored: Boolean; +begin + // The columns are stored by the owner tree to support Visual Form Inheritance + // GnutGetText skips non-stored properties, so retur Stored True at runtime + Result := not (csDesigning in Self.Treeview.ComponentState); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.Assign(Source : TPersistent); + +begin + if Source is TVTHeader then + begin + AutoSizeIndex := TVTHeader(Source).AutoSizeIndex; + Background := TVTHeader(Source).Background; + Columns := TVTHeader(Source).Columns; + Font := TVTHeader(Source).Font; + FixedAreaConstraints.Assign(TVTHeader(Source).FixedAreaConstraints); + Height := TVTHeader(Source).Height; + Images := TVTHeader(Source).Images; + MainColumn := TVTHeader(Source).MainColumn; + Options := TVTHeader(Source).Options; + ParentFont := TVTHeader(Source).ParentFont; + PopupMenu := TVTHeader(Source).PopupMenu; + SortColumn := TVTHeader(Source).SortColumn; + SortDirection := TVTHeader(Source).SortDirection; + Style := TVTHeader(Source).Style; + + RescaleHeader; + end + else + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.AutoFitColumns(); +begin + AutoFitColumns(not Tree.IsUpdating); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.AutoFitColumns(Animated : Boolean; SmartAutoFitType : TSmartAutoFitType = smaUseColumnOption; RangeStartCol : Integer = NoColumn; + RangeEndCol : Integer = NoColumn); + +//--------------- local functions ------------------------------------------- + + function GetUseSmartColumnWidth(ColumnIndex : TColumnIndex) : Boolean; + + begin + case SmartAutoFitType of + smaAllColumns : + Result := True; + smaUseColumnOption : + Result := coSmartResize in FColumns.Items[ColumnIndex].Options; + else + Result := False; + end; + end; + +//---------------------------------------------------------------------------- + + procedure DoAutoFitColumn(Column : TColumnIndex); + + begin + with TVirtualTreeColumnsCracker(FColumns) do + if ([coResizable, coVisible] * Items[PositionToIndex[Column]].Options = [coResizable, coVisible]) and DoBeforeAutoFitColumn(PositionToIndex[Column], SmartAutoFitType) and + not Tree.OperationCanceled then + begin + if Animated then + AnimatedResize(PositionToIndex[Column], Tree.GetMaxColumnWidth(PositionToIndex[Column], GetUseSmartColumnWidth(PositionToIndex[Column]))) + else + FColumns[PositionToIndex[Column]].Width := Tree.GetMaxColumnWidth(PositionToIndex[Column], GetUseSmartColumnWidth(PositionToIndex[Column])); + + DoAfterAutoFitColumn(PositionToIndex[Column]); + end; + end; + +//--------------- end local functions ---------------------------------------- + +var + I : Integer; + StartCol, EndCol : Integer; + +begin + StartCol := Max(NoColumn + 1, RangeStartCol); + + if RangeEndCol <= NoColumn then + EndCol := FColumns.Count - 1 + else + EndCol := Min(RangeEndCol, FColumns.Count - 1); + + if StartCol > EndCol then + Exit; //nothing to do + + Tree.StartOperation(okAutoFitColumns); + FDoingAutoFitColumns := True; + try + if Assigned(Tree.OnBeforeAutoFitColumns) then + Tree.OnBeforeAutoFitColumns(Self, SmartAutoFitType); + + for I := StartCol to EndCol do + DoAutoFitColumn(I); + + if Assigned(Tree.OnAfterAutoFitColumns) then + Tree.OnAfterAutoFitColumns(Self); + + finally + Tree.EndOperation(okAutoFitColumns); + Tree.Invalidate(); + FDoingAutoFitColumns := False; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.InHeader(P : TPoint) : Boolean; + +//Determines whether the given point (client coordinates!) is within the header rectangle (non-client coordinates). + +var + R, RW : TRect; + +begin + R := Tree.HeaderRect; + + //Current position of the owner in screen coordinates. + GetWindowRect(Tree.Handle, RW); + + //Convert to client coordinates. + MapWindowPoints(0, Tree.Handle, RW, 2); + + //Consider the header within this rectangle. + OffsetRect(R, RW.Left, RW.Top); + Result := PtInRect(R, P); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.InHeaderSplitterArea(P : TPoint) : Boolean; + +//Determines whether the given point (client coordinates!) hits the horizontal splitter area of the header. + +var + R, RW : TRect; + +begin + if (P.Y > 2) or (P.Y < - 2) or not (hoVisible in FOptions) then + Result := False + else + begin + R := Tree.HeaderRect; + Inc(R.Bottom, 2); + + //Current position of the owner in screen coordinates. + GetWindowRect(Tree.Handle, RW); + + //Convert to client coordinates. + MapWindowPoints(0, Tree.Handle, RW, 2); + + //Consider the header within this rectangle. + OffsetRect(R, RW.Left, RW.Top); + Result := PtInRect(R, P); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.InternalSetAutoSizeIndex(const Index : TColumnIndex); +begin + FAutoSizeIndex := index; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.InternalSetMainColumn(const Index : TColumnIndex); +begin + FMainColumn := index; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.InternalSetSortColumn(const Index : TColumnIndex); +begin + FSortColumn := index; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.Invalidate(Column : TVirtualTreeColumn; ExpandToBorder : Boolean = False; UpdateNowFlag : Boolean = False); + +//Because the header is in the non-client area of the tree it needs some special handling in order to initiate its +//repainting. +//If ExpandToBorder is True then not only the given column but everything or (depending on hoFullRepaintOnResize) just +//everything to its right (or left, in RTL mode) will be invalidated (useful for resizing). This makes only sense when +//a column is given. + +var + R, RW : TRect; + Flags : Cardinal; + +begin + if (hoVisible in FOptions) and Tree.HandleAllocated then + with Tree do + begin + if Column = nil then + R := HeaderRect + else + begin + R := Column.GetRect; + if not (coFixed in Column.Options) then + OffsetRect(R, - EffectiveOffsetX, 0); + if UseRightToLeftAlignment then + OffsetRect(R, ComputeRTLOffset, 0); + if ExpandToBorder then + begin + if (hoFullRepaintOnResize in Header.Options) then + begin + R.Left := HeaderRect.Left; + R.Right := HeaderRect.Right; + end + else + begin + if UseRightToLeftAlignment then + R.Left := HeaderRect.Left + else + R.Right := HeaderRect.Right; + end; + end; + end; + R.Bottom := Tree.ClientHeight; //We want to repaint the entire column to bottom, not just the header + + //Current position of the owner in screen coordinates. + GetWindowRect(Handle, RW); + + //Consider the header within this rectangle. + OffsetRect(R, RW.Left, RW.Top); + + //Expressed in client coordinates (because RedrawWindow wants them so, they will actually become negative). + MapWindowPoints(0, Handle, R, 2); + Flags := RDW_FRAME or RDW_INVALIDATE or RDW_VALIDATE or RDW_NOINTERNALPAINT or RDW_NOERASE or RDW_NOCHILDREN; + if UpdateNowFlag then + Flags := Flags or RDW_UPDATENOW; + RedrawWindow(@R, 0, Flags); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.LoadFromStream(const Stream : TStream); + +//restore the state of the header from the given stream + +var + Dummy, Version : Integer; + S : AnsiString; + OldOptions : TVTHeaderOptions; + +begin + Include(FStates, hsLoading); + with Stream do + try + //Switch off all options which could influence loading the columns (they will be later set again). + OldOptions := FOptions; + FOptions := []; + + //Determine whether the stream contains data without a version number. + ReadBuffer(Dummy, SizeOf(Dummy)); + if Dummy > - 1 then + begin + //Seek back to undo the read operation if this is an old stream format. + Seek( - SizeOf(Dummy), soFromCurrent); + Version := - 1; + end + else //Read version number if this is a "versionized" format. + ReadBuffer(Version, SizeOf(Version)); + Columns.LoadFromStream(Stream, Version); + + ReadBuffer(Dummy, SizeOf(Dummy)); + AutoSizeIndex := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + Background := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + Height := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + FOptions := OldOptions; + Options := TVTHeaderOptions(Dummy); + //PopupMenu is neither saved nor restored + ReadBuffer(Dummy, SizeOf(Dummy)); + Style := TVTHeaderStyle(Dummy); + //TFont has no own save routine so we do it manually + with Font do + begin + ReadBuffer(Dummy, SizeOf(Dummy)); + Color := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + Height := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + SetLength(S, Dummy); + ReadBuffer(PAnsiChar(S)^, Dummy); + Name := UTF8ToString(S); + ReadBuffer(Dummy, SizeOf(Dummy)); + Pitch := TFontPitch(Dummy); + ReadBuffer(Dummy, SizeOf(Dummy)); + Style := TFontStyles(Byte(Dummy)); + end; + + //Read data introduced by stream version 1+. + if Version > 0 then + begin + ReadBuffer(Dummy, SizeOf(Dummy)); + MainColumn := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + SortColumn := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + SortDirection := TSortDirection(Byte(Dummy)); + end; + + //Read data introduced by stream version 5+. + if Version > 4 then + begin + ReadBuffer(Dummy, SizeOf(Dummy)); + ParentFont := Boolean(Dummy); + ReadBuffer(Dummy, SizeOf(Dummy)); + FMaxHeight := Integer(Dummy); + ReadBuffer(Dummy, SizeOf(Dummy)); + FMinHeight := Integer(Dummy); + ReadBuffer(Dummy, SizeOf(Dummy)); + FDefaultHeight := Integer(Dummy); + with FFixedAreaConstraints do + begin + ReadBuffer(Dummy, SizeOf(Dummy)); + FMaxHeightPercent := TVTConstraintPercent(Dummy); + ReadBuffer(Dummy, SizeOf(Dummy)); + FMaxWidthPercent := TVTConstraintPercent(Dummy); + ReadBuffer(Dummy, SizeOf(Dummy)); + FMinHeightPercent := TVTConstraintPercent(Dummy); + ReadBuffer(Dummy, SizeOf(Dummy)); + FMinWidthPercent := TVTConstraintPercent(Dummy); + end; + end; + finally + Exclude(FStates, hsLoading); + RecalculateHeader(); + Tree.DoColumnResize(NoColumn); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVTHeader.ResizeColumns(ChangeBy : TDimension; RangeStartCol : TColumnIndex; RangeEndCol : TColumnIndex; Options : TVTColumnOptions = [coVisible]) : TDimension; + +//Distribute the given width change to a range of columns. A 'fair' way is used to distribute ChangeBy to the columns, +//while ensuring that everything that can be distributed will be distributed. + +var + Start, I : TColumnIndex; + ColCount, + Sign: Integer; + ToGo, MaxDelta, Difference, Rest: TDimension; + Constraints, Widths : array of TDimension; + BonusPixel : Boolean; + + //--------------- local functions ------------------------------------------- + + function IsResizable(Column : TColumnIndex) : Boolean; + + begin + if BonusPixel then + Result := Widths[Column - RangeStartCol] < Constraints[Column - RangeStartCol] + else + Result := Widths[Column - RangeStartCol] > Constraints[Column - RangeStartCol]; + end; + +//--------------------------------------------------------------------------- + + procedure IncDelta(Column : TColumnIndex); + + begin + if BonusPixel then + Inc(MaxDelta, FColumns[Column].MaxWidth - Widths[Column - RangeStartCol]) + else + Inc(MaxDelta, Widths[Column - RangeStartCol] - Constraints[Column - RangeStartCol]); + end; + +//--------------------------------------------------------------------------- + + function ChangeWidth(Column : TColumnIndex; Delta : TDimension) : TDimension; + + begin + if Delta > 0 then + Delta := Min(Delta, Constraints[Column - RangeStartCol] - Widths[Column - RangeStartCol]) + else + Delta := Max(Delta, Constraints[Column - RangeStartCol] - Widths[Column - RangeStartCol]); + + Inc(Widths[Column - RangeStartCol], Delta); + Dec(ToGo, Abs(Delta)); + Result := Abs(Delta); + end; + +//--------------------------------------------------------------------------- + + function ReduceConstraints : Boolean; + + var + MaxWidth: TDimension; + MaxReserveCol, Column : TColumnIndex; + + begin + Result := True; + if not (hsScaling in FStates) or BonusPixel then + Exit; + + MaxWidth := 0; + MaxReserveCol := NoColumn; + for Column := RangeStartCol to RangeEndCol do + if (Options * FColumns[Column].Options = Options) and (FColumns[Column].Width > MaxWidth) then + begin + MaxWidth := Widths[Column - RangeStartCol]; + MaxReserveCol := Column; + end; + + if (MaxReserveCol <= NoColumn) or (Constraints[MaxReserveCol - RangeStartCol] <= 10) then + Result := False + else + Dec(Constraints[MaxReserveCol - RangeStartCol], Divide(Constraints[MaxReserveCol - RangeStartCol], 10)); + end; + +//----------- end local functions ------------------------------------------- + +begin + Result := 0; + if (ChangeBy <> 0) and (RangeEndCol >= 0) then // RangeEndCol == -1 means no columns, so nothing to do + begin + //Do some initialization here + BonusPixel := ChangeBy > 0; + Sign := IfThen(BonusPixel, 1, - 1); + Start := IfThen(BonusPixel, RangeStartCol, RangeEndCol); + ToGo := Abs(ChangeBy); + SetLength(Widths, RangeEndCol - RangeStartCol + 1); + SetLength(Constraints, RangeEndCol - RangeStartCol + 1); + for I := RangeStartCol to RangeEndCol do + begin + Widths[I - RangeStartCol] := FColumns[I].Width; + Constraints[I - RangeStartCol] := IfThen(BonusPixel, FColumns[I].MaxWidth, FColumns[I].MinWidth); + end; + + repeat + repeat + MaxDelta := 0; + ColCount := 0; + for I := RangeStartCol to RangeEndCol do + if (Options * FColumns[I].Options = Options) and IsResizable(I) then + begin + System.Inc(ColCount); + IncDelta(I); + end; + if MaxDelta < Abs(ChangeBy) then + if not ReduceConstraints then + Break; + if ColCount = 0 then // Fixes #1236: infinite loop + Break; + until (MaxDelta >= Abs(ChangeBy)) or not (hsScaling in FStates); + + if ColCount = 0 then + Break; + + ToGo := Min(ToGo, MaxDelta); + Difference := ToGo div ColCount; + Rest := ToGo mod ColCount; + + if Difference > 0 then + for I := RangeStartCol to RangeEndCol do + if (Options * FColumns[I].Options = Options) and IsResizable(I) then + ChangeWidth(I, Difference * Sign); + + //Now distribute Rest. + I := Start; + while Rest > 0 do + begin + if (Options * FColumns[I].Options = Options) and IsResizable(I) then + if FColumns[I].BonusPixel <> BonusPixel then + begin + Dec(Rest, ChangeWidth(I, Sign)); + FColumns[I].BonusPixel := BonusPixel; + end; + System.Inc(I, Sign); + if (BonusPixel and (I > RangeEndCol)) or (not BonusPixel and (I < RangeStartCol)) then + begin + for I := RangeStartCol to RangeEndCol do + if Options * FColumns[I].Options = Options then + FColumns[I].BonusPixel := not FColumns[I].BonusPixel; + I := Start; + end; + end; + until ToGo <= 0; + + //Now set the computed widths. We also compute the result here. + Include(FStates, hsResizing); + for I := RangeStartCol to RangeEndCol do + if (Options * FColumns[I].Options = Options) then + begin + Inc(Result, Widths[I - RangeStartCol] - FColumns[I].Width); + TVirtualTreeColumnCracker(FColumns[I]).SetWidth(Widths[I - RangeStartCol]); + end; + Exclude(FStates, hsResizing); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.RestoreColumns; + +//Restores all columns to their width which they had before they have been auto fitted. + +var + I : TColumnIndex; + +begin + with TVirtualTreeColumnsCracker(FColumns) do + for I := Count - 1 downto 0 do + if [coResizable, coVisible] * Items[PositionToIndex[I]].Options = [coResizable, coVisible] then + Items[I].RestoreLastWidth; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.ToggleSortDirection; +// Toggles the current sorting direction +begin + if SortDirection = sdDescending then + SortDirection := sdAscending + else + SortDirection := sdDescending; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVTHeader.SaveToStream(const Stream : TStream); + +//Saves the complete state of the header into the provided stream. + +var + Dummy : Integer; + DummyDimension: TDimension; + Tmp : AnsiString; + +begin + with Stream do + begin + //In previous version of VT was no header stream version defined. + //For feature enhancements it is necessary, however, to know which stream + //format we are trying to load. + //In order to distict from non-version streams an indicator is inserted. + Dummy := - 1; + WriteBuffer(Dummy, SizeOf(Dummy)); + //Write current stream version number, nothing more is required at the time being. + Dummy := VTHeaderStreamVersion; + WriteBuffer(Dummy, SizeOf(Dummy)); + + //Save columns in case they depend on certain options (like auto size). + Columns.SaveToStream(Stream); + + Dummy := FAutoSizeIndex; + WriteBuffer(Dummy, SizeOf(Dummy)); + Dummy := FBackgroundColor; + WriteBuffer(Dummy, SizeOf(Dummy)); + DummyDimension:= FHeight; + WriteBuffer(DummyDimension, SizeOf(DummyDimension)); + Dummy := Integer(FOptions); + WriteBuffer(Dummy, SizeOf(Dummy)); + //PopupMenu is neither saved nor restored + Dummy := Ord(FStyle); + WriteBuffer(Dummy, SizeOf(Dummy)); + //TFont has no own save routine so we do it manually + with Font do + begin + Dummy := Color; + WriteBuffer(Dummy, SizeOf(Dummy)); + + //Need only to write one: size or height, I decided to write height. + DummyDimension := Height; + WriteBuffer(DummyDimension, SizeOf(DummyDimension)); + Tmp := UTF8Encode(Name); + Dummy := Length(Tmp); + WriteBuffer(Dummy, SizeOf(Dummy)); + WriteBuffer(PAnsiChar(Tmp)^, Dummy); + Dummy := Ord(Pitch); + WriteBuffer(Dummy, SizeOf(Dummy)); + Dummy := Byte(Style); + WriteBuffer(Dummy, SizeOf(Dummy)); + end; + + //Data introduced by stream version 1. + Dummy := FMainColumn; + WriteBuffer(Dummy, SizeOf(Dummy)); + Dummy := FSortColumn; + WriteBuffer(Dummy, SizeOf(Dummy)); + Dummy := Byte(FSortDirection); + WriteBuffer(Dummy, SizeOf(Dummy)); + + //Data introduced by stream version 5. + Dummy := Integer(ParentFont); + WriteBuffer(Dummy, SizeOf(Dummy)); + DummyDimension := FMaxHeight; + WriteBuffer(DummyDimension, SizeOf(DummyDimension)); + DummyDimension := FMinHeight; + WriteBuffer(DummyDimension, SizeOf(DummyDimension)); + DummyDimension := FDefaultHeight; + WriteBuffer(DummyDimension, SizeOf(DummyDimension)); + + with FFixedAreaConstraints do + begin + Dummy := Integer(FMaxHeightPercent); + WriteBuffer(Dummy, SizeOf(Dummy)); + Dummy := Integer(FMaxWidthPercent); + WriteBuffer(Dummy, SizeOf(Dummy)); + Dummy := Integer(FMinHeightPercent); + WriteBuffer(Dummy, SizeOf(Dummy)); + Dummy := Integer(FMinWidthPercent); + WriteBuffer(Dummy, SizeOf(Dummy)); + end; + end; +end; + +{ TVTHeaderHelper } + +function TVTHeaderHelper.Tree : TBaseVirtualTreeCracker; +begin + Result := TBaseVirtualTreeCracker(Self.FOwner); +end; + + +//----------------- TVirtualTreeColumn --------------------------------------------------------------------------------- + +constructor TVirtualTreeColumn.Create(Collection : TCollection); + +begin + FMinWidth := 10; + FMaxWidth := 10000; + FImageIndex := - 1; + FMargin := 4; + FSpacing := cDefaultColumnSpacing; + FText := ''; + FOptions := DefaultColumnOptions; + FAlignment := taLeftJustify; + FBiDiMode := bdLeftToRight; + FColor := clWindow; + FLayout := blGlyphLeft; + FBonusPixel := False; + FCaptionAlignment := taLeftJustify; + FCheckType := ctCheckBox; + FCheckState := csUncheckedNormal; + FCheckBox := False; + FHasImage := False; + FDefaultSortDirection := sdAscending; + FEditNextColumn := - 1; + + inherited Create(Collection); + + if Assigned(Owner) then + begin + FWidth := Owner.DefaultWidth; + FLastWidth := Owner.DefaultWidth; + FPosition := Owner.Count - 1; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetCollection(Value : TCollection); +begin + inherited; + // Read parent bidi mode and color values as default values. + ParentBiDiModeChanged; + ParentColorChanged; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +destructor TVirtualTreeColumn.Destroy; + +var + I : Integer; + ai : TColumnIndex; + sc : TColumnIndex; + + //--------------- local function --------------------------------------------- + + procedure AdjustColumnIndex(var ColumnIndex : TColumnIndex); + + begin + if Index = ColumnIndex then + ColumnIndex := NoColumn + else + if Index < ColumnIndex then + System.Dec(ColumnIndex); + end; + + //--------------- end local function ----------------------------------------- + +begin + // Check if this column is somehow referenced by its collection parent or the header. + with Owner do + begin + // If the columns collection object is currently deleting all columns + // then we don't need to check the various cached indices individually. + if not FClearing then + begin + TreeViewControl.CancelEditNode; + IndexChanged(Index, - 1); + + AdjustColumnIndex(FHoverIndex); + AdjustColumnIndex(FDownIndex); + AdjustColumnIndex(FTrackIndex); + AdjustColumnIndex(FClickIndex); + + with Header do + begin + ai := AutoSizeIndex; + AdjustColumnIndex(ai); + InternalSetAutoSizeIndex(ai); + if Index = MainColumn then + begin + // If the current main column is about to be destroyed then we have to find a new main column. + InternalSetMainColumn(NoColumn); //SetColumn has side effects we want to avoid here. + for I := 0 to Count - 1 do + if I <> Index then + begin + InternalSetMainColumn(I); + Break; + end; + end; + sc := SortColumn; + AdjustColumnIndex(sc); + InternalSetSortColumn(sc); + end; + end; + end; + + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.GetCaptionAlignment : TAlignment; + +begin + if coUseCaptionAlignment in FOptions then + Result := FCaptionAlignment + else + Result := FAlignment; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.GetCaptionWidth : TDimension; +var + Theme : HTHEME; + AdvancedOwnerDraw : Boolean; + PaintInfo : THeaderPaintInfo; + RequestedElements : THeaderPaintElements; + + TextSize : TSize; + HeaderGlyphSize : TPoint; + UseText : Boolean; + R : TRect; +begin + AdvancedOwnerDraw := (hoOwnerDraw in Header.Options) and Assigned(TreeViewControl.OnAdvancedHeaderDraw) and Assigned(TreeViewControl.OnHeaderDrawQueryElements) and + not (csDesigning in TreeViewControl.ComponentState); + + PaintInfo.Column := Self; + PaintInfo.TargetCanvas := Owner.HeaderBitmap.Canvas; + PaintInfo.TargetCanvas.Font := Header.Font; + + with PaintInfo, Column do + begin + ShowHeaderGlyph := (hoShowImages in Header.Options) and ((Assigned(Header.Images) and (FImageIndex > - 1)) or FCheckBox); + ShowSortGlyph := ((Header.SortColumn > - 1) and (Self = Owner.Items[Header.SortColumn])) and (hoShowSortGlyphs in Header.Options); + + // This path for text columns or advanced owner draw. + // See if the application wants to draw part of the header itself. + RequestedElements := []; + if AdvancedOwnerDraw then + begin + PaintInfo.Column := Self; + TreeViewControl.DoHeaderDrawQueryElements(PaintInfo, RequestedElements); + end; + end; + + UseText := Length(FText) > 0; + // If nothing is to show then don't waste time with useless preparation. + if not (UseText or PaintInfo.ShowHeaderGlyph or PaintInfo.ShowSortGlyph) then + Exit(0); + + // Calculate sizes of the involved items. + with Header do + begin + if PaintInfo.ShowHeaderGlyph then + if not FCheckBox then + begin + if Assigned(Images) then + HeaderGlyphSize := Point(Images.Width, Images.Height); + end + else + with Self.TreeViewControl do + begin + if Assigned(CheckImages) then + HeaderGlyphSize := Point(CheckImages.Width, CheckImages.Height); + end + else + HeaderGlyphSize := Point(0, 0); + if PaintInfo.ShowSortGlyph then + begin + if tsUseExplorerTheme in Self.TreeViewControl.TreeStates then + begin + R := Rect(0, 0, 100, 100); + Theme := OpenThemeData(Self.TreeViewControl.Handle, 'HEADER'); + GetThemePartSize(Theme, PaintInfo.TargetCanvas.Handle, HP_HEADERSORTARROW, HSAS_SORTEDUP, @R, TS_TRUE, PaintInfo.SortGlyphSize); + CloseThemeData(Theme); + end + else + begin + PaintInfo.SortGlyphSize.cx := Self.TreeViewControl.ScaledPixels(16); + PaintInfo.SortGlyphSize.cy := Self.TreeViewControl.ScaledPixels(4); + end; + end + else + begin + PaintInfo.SortGlyphSize.cx := 0; + PaintInfo.SortGlyphSize.cy := 0; + end; + end; + + if UseText then + begin + GetTextExtentPoint32W(PaintInfo.TargetCanvas.Handle, PWideChar(FText), Length(FText), TextSize); + Inc(TextSize.cx, 2); + end + else + begin + TextSize.cx := 0; + TextSize.cy := 0; + end; + + // if CalculateTextRect then + Result := TextSize.cx; + if PaintInfo.ShowHeaderGlyph then + if Layout in [blGlyphLeft, blGlyphRight] then + Inc(Result, HeaderGlyphSize.X + FSpacing) + else // if Layout in [ blGlyphTop, blGlyphBottom] then + Result := Max(Result, HeaderGlyphSize.X); + if PaintInfo.ShowSortGlyph then + Inc(Result, PaintInfo.SortGlyphSize.cx + FSpacing + 2); // without this +2, there is a slight movement of the sort glyph when expanding the column + +end; +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.GetLeft : TDimension; + +begin + Result := FLeft; + if [coVisible, coFixed] * FOptions <> [coVisible, coFixed] then + Dec(Result, TreeViewControl.EffectiveOffsetX); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.IsBiDiModeStored : Boolean; + +begin + Result := not (coParentBidiMode in FOptions); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.IsCaptionAlignmentStored : Boolean; + +begin + Result := coUseCaptionAlignment in FOptions; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.IsColorStored : Boolean; + +begin + Result := not (coParentColor in FOptions); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetAlignment(const Value : TAlignment); + +begin + if FAlignment <> Value then + begin + FAlignment := Value; + Changed(False); + // Setting the alignment affects also the tree, hence invalidate it too. + TreeViewControl.Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetBiDiMode(Value : TBiDiMode); + +begin + if Value <> FBiDiMode then + begin + FBiDiMode := Value; + Exclude(FOptions, coParentBidiMode); + Changed(False); + // Setting the alignment affects also the tree, hence invalidate it too. + TreeViewControl.Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetCaptionAlignment(const Value : TAlignment); + +begin + if not (coUseCaptionAlignment in FOptions) or (FCaptionAlignment <> Value) then + begin + FCaptionAlignment := Value; + Include(FOptions, coUseCaptionAlignment); + // Setting the alignment affects also the tree, hence invalidate it too. + Header.Invalidate(Self); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetColor(const Value : TColor); + +begin + if FColor <> Value then + begin + FColor := Value; + Exclude(FOptions, coParentColor); + Exclude(FOptions, coStyleColor); // Issue #919 + Changed(False); + TreeViewControl.Invalidate; + end; +end; + +function TVirtualTreeColumn.GetEffectiveColor() : TColor; +// Returns the color that should effectively be used as background color for this +// column considering all flags in the TVirtualTreeColumn.Options property +begin + if (coParentColor in Options) or ((coStyleColor in Options) and TreeViewControl.VclStyleEnabled) then + Result := TreeViewControl.Colors.BackGroundColor + else + Result := Self.Color; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetCheckBox(Value : Boolean); + +begin + if Value <> FCheckBox then + begin + FCheckBox := Value; + if Value and (csDesigning in TreeViewControl.ComponentState) then + Header.Options := Header.Options + [hoShowImages]; + Changed(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetCheckState(Value : TCheckState); + +begin + if Value <> FCheckState then + begin + FCheckState := Value; + Changed(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetCheckType(Value : TCheckType); + +begin + if Value <> FCheckType then + begin + FCheckType := Value; + Changed(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetImageIndex(Value : TImageIndex); + +begin + if Value <> FImageIndex then + begin + FImageIndex := Value; + Changed(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetLayout(Value : TVTHeaderColumnLayout); + +begin + if FLayout <> Value then + begin + FLayout := Value; + Changed(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetMargin(Value : TDimension); + +begin + // Compatibility setting for -1. + if Value < 0 then + Value := 4; + if FMargin <> Value then + begin + FMargin := Value; + Changed(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetMaxWidth(Value : TDimension); + +begin + if Value < FMinWidth then + Value := FMinWidth; + FMaxWidth := Value; + SetWidth(FWidth); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetMinWidth(Value : TDimension); + +begin + if Value < 0 then + Value := 0; + if Value > FMaxWidth then + Value := FMaxWidth; + FMinWidth := Value; + SetWidth(FWidth); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetOptions(Value : TVTColumnOptions); + +var + ToBeSet: TVTColumnOptions; + ToBeCleared: TVTColumnOptions; + lAppearanceChanged: Boolean; + lParentColorSet : Boolean; +begin + if FOptions <> Value then + begin + ToBeCleared := FOptions - Value; + ToBeSet := Value - FOptions; + + FOptions := Value; + if coFixed in ToBeSet then + FOptions := FOptions - [coDraggable]; // issue #1314 + + lAppearanceChanged := ([coVisible, coFixed, coStyleColor, coParentBidiMode, coWrapCaption] * (ToBeSet + ToBeCleared)) <> []; + lParentColorSet := coParentColor in ToBeSet; + + if coParentBidiMode in ToBeSet then + ParentBiDiModeChanged; + if lParentColorSet then + begin + Include(FOptions, coStyleColor); // Issue #919 + ParentColorChanged(); + end; + + if coAutoSpring in ToBeSet then + FSpringRest := 0; + + if coVisible in ToBeCleared then + Header.UpdateMainColumn(); // Fixes issue #946 + + if ((coFixed in ToBeSet) or (coFixed in ToBeCleared)) and (coVisible in FOptions) then + Header.RescaleHeader; + + Changed(False); + // Need to repaint and adjust the owner tree too. + if not (csLoading in TreeViewControl.ComponentState) and (lAppearanceChanged or lParentColorSet) and (Owner.UpdateCount = 0) and TreeViewControl.HandleAllocated then + begin + TreeViewControl.Invalidate(); + if lAppearanceChanged then + begin + TreeViewControl.DoColumnVisibilityChanged(Self.Index, coVisible in ToBeSet); + TreeViewControl.UpdateHorizontalScrollBar(False); + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetPosition(Value : TColumnPosition); + +var + Temp : TColumnIndex; + +begin + if (csLoading in TreeViewControl.ComponentState) or (Owner.UpdateCount > 0) then + // Only cache the position for final fixup when loading from DFM. + FPosition := Value + else + begin + if Value >= TColumnPosition(Collection.Count) then + Value := Collection.Count - 1; + if FPosition <> Value then + begin + with Owner do + begin + InitializePositionArray; + TreeViewControl.CancelEditNode; + AdjustPosition(Self, Value); + Self.Changed(False); + + // Need to repaint. + with Self.Header do + begin + if (UpdateCount = 0) and TreeViewControl.HandleAllocated then + begin + Invalidate(Self); + TreeViewControl.Invalidate; + end; + end; + end; + + // If the moved column is now within the fixed columns then we make it fixed as well. If it's not + // we clear the fixed state (in case that fixed column is moved outside fixed area). + if (coFixed in FOptions) and (FPosition > 0) then + Temp := Owner.ColumnFromPosition(FPosition - 1) + else + Temp := Owner.ColumnFromPosition(FPosition + 1); + + if Temp <> NoColumn then + begin + if coFixed in Owner[Temp].Options then + Options := Options + [coFixed] + else + Options := Options - [coFixed]; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetSpacing(Value : TDimension); + +begin + if FSpacing <> Value then + begin + FSpacing := Value; + Changed(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetStyle(Value : TVirtualTreeColumnStyle); + +begin + if FStyle <> Value then + begin + FStyle := Value; + Changed(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetText(const Value : string); + +begin + if FText <> Value then + begin + FText := Value; + FCaptionText := ''; + Changed(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SetWidth(Value : TDimension); + +var + EffectiveMaxWidth, + EffectiveMinWidth, + TotalFixedMaxWidth, + TotalFixedMinWidth : TDimension; + I : TColumnIndex; + +begin + if not (hsScaling in Header.States) then + if ([coVisible, coFixed] * FOptions = [coVisible, coFixed]) then + begin + with Header, FixedAreaConstraints, TreeViewControl do + begin + TotalFixedMinWidth := 0; + TotalFixedMaxWidth := 0; + for I := 0 to Columns.Count - 1 do + if ([coVisible, coFixed] * Columns[I].Options = [coVisible, coFixed]) then + begin + Inc(TotalFixedMaxWidth, Columns[I].MaxWidth); + Inc(TotalFixedMinWidth, Columns[I].MinWidth); + end; + + if HandleAllocated then // Prevent premature creation of window handle, see issue #1073 + begin + // The percentage values have precedence over the pixel values. + If MaxWidthPercent > 0 then + TotalFixedMinWidth := Min(Divide(ClientWidth * MaxWidthPercent, 100), TotalFixedMinWidth); + If MinWidthPercent > 0 then + TotalFixedMaxWidth := Max(Divide(ClientWidth * MinWidthPercent, 100), TotalFixedMaxWidth); + + EffectiveMaxWidth := Min(TotalFixedMaxWidth - (Columns.GetVisibleFixedWidth - Self.FWidth), FMaxWidth); + EffectiveMinWidth := Max(TotalFixedMinWidth - (Columns.GetVisibleFixedWidth - Self.FWidth), FMinWidth); + Value := Min(Max(Value, EffectiveMinWidth), EffectiveMaxWidth); + + if MinWidthPercent > 0 then + Value := Max(Divide(ClientWidth * MinWidthPercent, 100) - Columns.GetVisibleFixedWidth + Self.FWidth, Value); + if MaxWidthPercent > 0 then + Value := Min(Divide(ClientWidth * MaxWidthPercent, 100) - Columns.GetVisibleFixedWidth + Self.FWidth, Value); + end;// if HandleAllocated + end; + end + else + Value := Min(Max(Value, FMinWidth), FMaxWidth); + + if FWidth <> Value then + begin + FLastWidth := FWidth; + if not (hsResizing in Header.States) then + FBonusPixel := False; + if not (hoAutoResize in Header.Options) or (Index <> Header.AutoSizeIndex) then + begin + FWidth := Value; + Owner.UpdatePositions; + end; + if not (csLoading in TreeViewControl.ComponentState) and (TreeViewControl.UpdateCount = 0) then + begin + if hoAutoResize in Header.Options then + Owner.AdjustAutoSize(Index); + TreeViewControl.DoColumnResize(Index); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.ChangeScale(M, D : TDimension); +begin + FMinWidth := MulDiv(FMinWidth, M, D); + FMaxWidth := MulDiv(FMaxWidth, M, D); + FSpacing := MulDiv(FSpacing, M, D); + Self.Width := MulDiv(Self.Width, M, D); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.ComputeHeaderLayout(var PaintInfo : THeaderPaintInfo; DrawFormat : Cardinal; CalculateTextRect : Boolean = False); + +// The layout of a column header is determined by a lot of factors. This method takes them all into account and +// determines all necessary positions and bounds: +// - for the header text +// - the header glyph +// - the sort glyph + +var + TextSize : TSize; + TextPos, + ClientSize, + HeaderGlyphSize : TPoint; + CurrentAlignment : TAlignment; + MinLeft, + MaxRight, + TextSpacing : TDimension; + UseText : Boolean; + R : TRect; + Theme : HTHEME; + +begin + UseText := Length(FText) > 0; + // If nothing is to show then don't waste time with useless preparation. + if not (UseText or PaintInfo.ShowHeaderGlyph or PaintInfo.ShowSortGlyph) then + Exit; + + CurrentAlignment := CaptionAlignment; + if FBiDiMode <> bdLeftToRight then + ChangeBiDiModeAlignment(CurrentAlignment); + + // Calculate sizes of the involved items. + ClientSize := Point(PaintInfo.PaintRectangle.Right - PaintInfo.PaintRectangle.Left, PaintInfo.PaintRectangle.Bottom - PaintInfo.PaintRectangle.Top); + with Owner, Header do + begin + if PaintInfo.ShowHeaderGlyph then + if not FCheckBox then + HeaderGlyphSize := Point(Images.Width, Images.Height) + else + with Self.TreeViewControl do + begin + if Assigned(CheckImages) then + HeaderGlyphSize := Point(CheckImages.Width, CheckImages.Height); + end + else + HeaderGlyphSize := Point(0, 0); + if PaintInfo.ShowSortGlyph then + begin + if tsUseExplorerTheme in Self.TreeViewControl.TreeStates then + begin + R := Rect(0, 0, 100, 100); + Theme := OpenThemeData(TreeViewControl.Handle, 'HEADER'); + GetThemePartSize(Theme, PaintInfo.TargetCanvas.Handle, HP_HEADERSORTARROW, HSAS_SORTEDUP, @R, TS_TRUE, PaintInfo.SortGlyphSize); + CloseThemeData(Theme); + end + else + begin + PaintInfo.SortGlyphSize.cx := Self.TreeViewControl.ScaledPixels(16); + PaintInfo.SortGlyphSize.cy := Self.TreeViewControl.ScaledPixels(4); + end; + + // In any case, the sort glyph is vertically centered. + PaintInfo.SortGlyphPos.Y := Divide(ClientSize.Y - PaintInfo.SortGlyphSize.cy, 2); + end + else + begin + PaintInfo.SortGlyphSize.cx := 0; + PaintInfo.SortGlyphSize.cy := 0; + end; + end; + + if UseText then + begin + if not (coWrapCaption in FOptions) then + begin + FCaptionText := FText; + GetTextExtentPoint32W(PaintInfo.TargetCanvas.Handle, PWideChar(FText), Length(FText), TextSize); + Inc(TextSize.cx, 2); + PaintInfo.TextRectangle := Rect(0, 0, TextSize.cx, TextSize.cy); + end + else + begin + R := PaintInfo.PaintRectangle; + if FCaptionText = '' then + FCaptionText := WrapString(PaintInfo.TargetCanvas.Handle, FText, R, DT_RTLREADING and DrawFormat <> 0, DrawFormat); + + GetStringDrawRect(PaintInfo.TargetCanvas.Handle, FCaptionText, R, DrawFormat); + TextSize.cx := PaintInfo.PaintRectangle.Right - PaintInfo.PaintRectangle.Left; + TextSize.cy := R.Bottom - R.Top; + PaintInfo.TextRectangle := Rect(0, 0, TextSize.cx, TextSize.cy); + end; + TextSpacing := FSpacing; + end + else + begin + TextSpacing := 0; + TextSize.cx := 0; + TextSize.cy := 0; + end; + + // Check first for the special case where nothing is shown except the sort glyph. + if PaintInfo.ShowSortGlyph and not (UseText or PaintInfo.ShowHeaderGlyph) then + begin + // Center the sort glyph in the available area if nothing else is there. + PaintInfo.SortGlyphPos := Point(Divide(ClientSize.X - PaintInfo.SortGlyphSize.cx, 2), Divide(ClientSize.Y - PaintInfo.SortGlyphSize.cy, 2)); + end + else + begin + // Determine extents of text and glyph and calculate positions which are clear from the layout. + if (Layout in [blGlyphLeft, blGlyphRight]) or not PaintInfo.ShowHeaderGlyph then + begin + PaintInfo.GlyphPos.Y := Divide(ClientSize.Y - HeaderGlyphSize.Y, 2); + // If the text is taller than the given height, perform no vertical centration as this + // would make the text even less readable. + //Using Max() fixes badly positioned text if Extra Large fonts have been activated in the Windows display options + TextPos.Y := Max( - 5, Divide(ClientSize.Y - TextSize.cy, 2)); + end + else + begin + if Layout = blGlyphTop then + begin + PaintInfo.GlyphPos.Y := Divide(ClientSize.Y - HeaderGlyphSize.Y - TextSize.cy - TextSpacing, 2); + TextPos.Y := PaintInfo.GlyphPos.Y + HeaderGlyphSize.Y + TextSpacing; + end + else + begin + TextPos.Y := Divide(ClientSize.Y - HeaderGlyphSize.Y - TextSize.cy - TextSpacing, 2); + PaintInfo.GlyphPos.Y := TextPos.Y + TextSize.cy + TextSpacing; + end; + end; + + // Each alignment needs special consideration. + case CurrentAlignment of + taLeftJustify : + begin + MinLeft := FMargin; + if PaintInfo.ShowSortGlyph and (FBiDiMode <> bdLeftToRight) then + begin + // In RTL context is the sort glyph placed on the left hand side. + PaintInfo.SortGlyphPos.X := MinLeft; + Inc(MinLeft, PaintInfo.SortGlyphSize.cx + FSpacing); + end; + if Layout in [blGlyphTop, blGlyphBottom] then + begin + // Header glyph is above or below text, so both must be considered when calculating + // the left positition of the sort glyph (if it is on the right hand side). + TextPos.X := MinLeft; + if PaintInfo.ShowHeaderGlyph then + begin + PaintInfo.GlyphPos.X := Divide(ClientSize.X - HeaderGlyphSize.X, 2); + if PaintInfo.GlyphPos.X < MinLeft then + PaintInfo.GlyphPos.X := MinLeft; + MinLeft := Max(TextPos.X + TextSize.cx + TextSpacing, PaintInfo.GlyphPos.X + HeaderGlyphSize.X + FSpacing); + end + else + MinLeft := TextPos.X + TextSize.cx + TextSpacing; + end + else + begin + // Everything is lined up. TextSpacing might be 0 if there is no text. + // This simplifies the calculation because no extra tests are necessary. + if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphLeft) then + begin + PaintInfo.GlyphPos.X := MinLeft; + Inc(MinLeft, HeaderGlyphSize.X + FSpacing); + end; + TextPos.X := MinLeft; + Inc(MinLeft, TextSize.cx + TextSpacing); + if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphRight) then + begin + PaintInfo.GlyphPos.X := MinLeft; + Inc(MinLeft, HeaderGlyphSize.X + FSpacing); + end; + end; + if PaintInfo.ShowSortGlyph and (FBiDiMode = bdLeftToRight) then + PaintInfo.SortGlyphPos.X := MinLeft; + end; + taCenter : + begin + if Layout in [blGlyphTop, blGlyphBottom] then + begin + PaintInfo.GlyphPos.X := Divide(ClientSize.X - HeaderGlyphSize.X, 2); + TextPos.X := Divide(ClientSize.X - TextSize.cx, 2); + if PaintInfo.ShowSortGlyph then + Dec(TextPos.X, Divide(PaintInfo.SortGlyphSize.cx, 2)); + end + else + begin + MinLeft := Divide(ClientSize.X - HeaderGlyphSize.X - TextSpacing - TextSize.cx, 2); + if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphLeft) then + begin + PaintInfo.GlyphPos.X := MinLeft; + Inc(MinLeft, HeaderGlyphSize.X + TextSpacing); + end; + TextPos.X := MinLeft; + Inc(MinLeft, TextSize.cx + TextSpacing); + if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphRight) then + PaintInfo.GlyphPos.X := MinLeft; + end; + if PaintInfo.ShowHeaderGlyph then + begin + MinLeft := Min(PaintInfo.GlyphPos.X, TextPos.X); + MaxRight := Max(PaintInfo.GlyphPos.X + HeaderGlyphSize.X, TextPos.X + TextSize.cx); + end + else + begin + MinLeft := TextPos.X; + MaxRight := TextPos.X + TextSize.cx; + end; + // Place the sort glyph directly to the left or right of the larger item. + if PaintInfo.ShowSortGlyph then + if FBiDiMode = bdLeftToRight then + begin + // Sort glyph on the right hand side. + PaintInfo.SortGlyphPos.X := MaxRight + FSpacing; + end + else + begin + // Sort glyph on the left hand side. + PaintInfo.SortGlyphPos.X := MinLeft - FSpacing - PaintInfo.SortGlyphSize.cx; + end; + end; + else + // taRightJustify + MaxRight := ClientSize.X - FMargin; + if PaintInfo.ShowSortGlyph and (FBiDiMode = bdLeftToRight) then + begin + // In LTR context is the sort glyph placed on the right hand side. + Dec(MaxRight, PaintInfo.SortGlyphSize.cx); + PaintInfo.SortGlyphPos.X := MaxRight; + Dec(MaxRight, FSpacing); + end; + if Layout in [blGlyphTop, blGlyphBottom] then + begin + TextPos.X := MaxRight - TextSize.cx; + if PaintInfo.ShowHeaderGlyph then + begin + PaintInfo.GlyphPos.X := Divide(ClientSize.X - HeaderGlyphSize.X, 2); + if PaintInfo.GlyphPos.X + HeaderGlyphSize.X + FSpacing > MaxRight then + PaintInfo.GlyphPos.X := MaxRight - HeaderGlyphSize.X - FSpacing; + MaxRight := Min(TextPos.X - TextSpacing, PaintInfo.GlyphPos.X - FSpacing); + end + else + MaxRight := TextPos.X - TextSpacing; + end + else + begin + // Everything is lined up. TextSpacing might be 0 if there is no text. + // This simplifies the calculation because no extra tests are necessary. + if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphRight) then + begin + PaintInfo.GlyphPos.X := MaxRight - HeaderGlyphSize.X; + MaxRight := PaintInfo.GlyphPos.X - FSpacing; + end; + TextPos.X := MaxRight - TextSize.cx; + MaxRight := TextPos.X - TextSpacing; + if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphLeft) then + begin + PaintInfo.GlyphPos.X := MaxRight - HeaderGlyphSize.X; + MaxRight := PaintInfo.GlyphPos.X - FSpacing; + end; + end; + if PaintInfo.ShowSortGlyph and (FBiDiMode <> bdLeftToRight) then + PaintInfo.SortGlyphPos.X := MaxRight - PaintInfo.SortGlyphSize.cx; + end; + end; + + // Once the position of each element is determined there remains only one but important step. + // The horizontal positions of every element must be adjusted so that it always fits into the + // given header area. This is accomplished by shorten the text appropriately. + + // These are the maximum bounds. Nothing goes beyond them. + MinLeft := FMargin; + MaxRight := ClientSize.X - FMargin; + if PaintInfo.ShowSortGlyph then + begin + if FBiDiMode = bdLeftToRight then + begin + // Sort glyph on the right hand side. + if PaintInfo.SortGlyphPos.X + PaintInfo.SortGlyphSize.cx > MaxRight then + PaintInfo.SortGlyphPos.X := MaxRight - PaintInfo.SortGlyphSize.cx; + MaxRight := PaintInfo.SortGlyphPos.X - FSpacing; + end; + + // Consider also the left side of the sort glyph regardless of the bidi mode. + if PaintInfo.SortGlyphPos.X < MinLeft then + PaintInfo.SortGlyphPos.X := MinLeft; + // Left border needs only adjustment if the sort glyph marks the left border. + if FBiDiMode <> bdLeftToRight then + MinLeft := PaintInfo.SortGlyphPos.X + PaintInfo.SortGlyphSize.cx + FSpacing; + + // Finally transform sort glyph to its actual position. + Inc(PaintInfo.SortGlyphPos.X, PaintInfo.PaintRectangle.Left); + Inc(PaintInfo.SortGlyphPos.Y, PaintInfo.PaintRectangle.Top); + end; + if PaintInfo.ShowHeaderGlyph then + begin + if PaintInfo.GlyphPos.X + HeaderGlyphSize.X > MaxRight then + PaintInfo.GlyphPos.X := MaxRight - HeaderGlyphSize.X; + if Layout = blGlyphRight then + MaxRight := PaintInfo.GlyphPos.X - FSpacing; + if PaintInfo.GlyphPos.X < MinLeft then + PaintInfo.GlyphPos.X := MinLeft; + if Layout = blGlyphLeft then + MinLeft := PaintInfo.GlyphPos.X + HeaderGlyphSize.X + FSpacing; + if FCheckBox and (Header.MainColumn = Self.Index) then + Dec(PaintInfo.GlyphPos.X, 2) + else + if Header.MainColumn <> Self.Index then + Dec(PaintInfo.GlyphPos.X, 2); + + // Finally transform header glyph to its actual position. + Inc(PaintInfo.GlyphPos.X, PaintInfo.PaintRectangle.Left); + Inc(PaintInfo.GlyphPos.Y, PaintInfo.PaintRectangle.Top); + end; + if UseText then + begin + if TextPos.X < MinLeft then + TextPos.X := MinLeft; + OffsetRect(PaintInfo.TextRectangle, TextPos.X, TextPos.Y); + if PaintInfo.TextRectangle.Right > MaxRight then + PaintInfo.TextRectangle.Right := MaxRight; + OffsetRect(PaintInfo.TextRectangle, PaintInfo.PaintRectangle.Left, PaintInfo.PaintRectangle.Top); + + if coWrapCaption in FOptions then + begin + // Wrap the column caption if necessary. + R := PaintInfo.TextRectangle; + FCaptionText := WrapString(PaintInfo.TargetCanvas.Handle, FText, R, DT_RTLREADING and DrawFormat <> 0, DrawFormat); + GetStringDrawRect(PaintInfo.TargetCanvas.Handle, FCaptionText, R, DrawFormat); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.DefineProperties(Filer : TFiler); + +begin + inherited; + + // These properites are remains from non-Unicode Delphi versions, readers remain for backward compatibility. + Filer.DefineProperty('WideText', ReadText, nil, False); + Filer.DefineProperty('WideHint', ReadHint, nil, False); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.GetAbsoluteBounds(var Left, Right : TDimension); + +// Returns the column's left and right bounds in header coordinates, that is, independant of the scrolling position. + +begin + Left := FLeft; + Right := FLeft + FWidth; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.GetDisplayName : string; +begin + Result := FText; // Use column header caption as display name +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.GetOwner : TVirtualTreeColumns; + +begin + Result := Collection as TVirtualTreeColumns; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.InternalSetWidth(const Value : TDimension); +begin + FWidth := Value; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.ReadText(Reader : TReader); + +begin + SetText(Reader.ReadString); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.ReadHint(Reader : TReader); + +begin + FHint := Reader.ReadString; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.Assign(Source : TPersistent); + +var + OldOptions : TVTColumnOptions; + +begin + if Source is TVirtualTreeColumn then + begin + OldOptions := FOptions; + FOptions := []; + + BiDiMode := TVirtualTreeColumn(Source).BiDiMode; + ImageIndex := TVirtualTreeColumn(Source).ImageIndex; + Layout := TVirtualTreeColumn(Source).Layout; + Margin := TVirtualTreeColumn(Source).Margin; + MaxWidth := TVirtualTreeColumn(Source).MaxWidth; + MinWidth := TVirtualTreeColumn(Source).MinWidth; + Position := TVirtualTreeColumn(Source).Position; + Spacing := TVirtualTreeColumn(Source).Spacing; + Style := TVirtualTreeColumn(Source).Style; + Text := TVirtualTreeColumn(Source).Text; + Hint := TVirtualTreeColumn(Source).Hint; + Width := TVirtualTreeColumn(Source).Width; + Alignment := TVirtualTreeColumn(Source).Alignment; + CaptionAlignment := TVirtualTreeColumn(Source).CaptionAlignment; + Color := TVirtualTreeColumn(Source).Color; + Tag := TVirtualTreeColumn(Source).Tag; + EditOptions := TVirtualTreeColumn(Source).EditOptions; + EditNextColumn := TVirtualTreeColumn(Source).EditNextColumn; + + // Order is important. Assign options last. + FOptions := OldOptions; + Options := TVirtualTreeColumn(Source).Options; + + Changed(False); + end + else + inherited Assign(Source); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.Equals(OtherColumnObj : TObject) : Boolean; +var + OtherColumn : TVirtualTreeColumn; +begin + if OtherColumnObj is TVirtualTreeColumn then + begin + OtherColumn := TVirtualTreeColumn(OtherColumnObj); + Result := (BiDiMode = OtherColumn.BiDiMode) and + (ImageIndex = OtherColumn.ImageIndex) and + (Layout = OtherColumn.Layout) and + (Margin = OtherColumn.Margin) and + (MaxWidth = OtherColumn.MaxWidth) and + (MinWidth = OtherColumn.MinWidth) and + (Position = OtherColumn.Position) and + (Spacing = OtherColumn.Spacing) and + (Style = OtherColumn.Style) and + (Text = OtherColumn.Text) and + (Hint = OtherColumn.Hint) and + (Width = OtherColumn.Width) and + (Alignment = OtherColumn.Alignment) and + (CaptionAlignment = OtherColumn.CaptionAlignment) and + (Color = OtherColumn.Color) and + (Tag = OtherColumn.Tag) and + (Options = OtherColumn.Options); + end + else + Result := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.GetRect : TRect; + +// Returns the rectangle this column occupies in the header (relative to (0, 0) of the non-client area). + +begin + with TVirtualTreeColumns(GetOwner).FHeader do + Result := TreeViewControl.HeaderRect; + Inc(Result.Left, FLeft); + Result.Right := Result.Left + FWidth; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +// [IPK] +function TVirtualTreeColumn.GetText : string; + +begin + Result := FText; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.LoadFromStream(const Stream : TStream; Version : Integer); +var + Dummy : Integer; + S : string; + +begin + with Stream do + begin + ReadBuffer(Dummy, SizeOf(Dummy)); + SetLength(S, Dummy); + ReadBuffer(PWideChar(S)^, 2 * Dummy); + Text := S; + ReadBuffer(Dummy, SizeOf(Dummy)); + SetLength(FHint, Dummy); + ReadBuffer(PWideChar(FHint)^, 2 * Dummy); + ReadBuffer(Dummy, SizeOf(Dummy)); + Width := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + MinWidth := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + MaxWidth := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + Style := TVirtualTreeColumnStyle(Dummy); + ReadBuffer(Dummy, SizeOf(Dummy)); + ImageIndex := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + Layout := TVTHeaderColumnLayout(Dummy); + ReadBuffer(Dummy, SizeOf(Dummy)); + Margin := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + Spacing := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + BiDiMode := TBiDiMode(Dummy); + + ReadBuffer(Dummy, SizeOf(Dummy)); + if Version >= 3 then + Options := TVTColumnOptions(Dummy); + + if Version > 0 then + begin + // Parts which have been introduced/changed with header stream version 1+. + ReadBuffer(Dummy, SizeOf(Dummy)); + Tag := Dummy; + ReadBuffer(Dummy, SizeOf(Dummy)); + Alignment := TAlignment(Dummy); + + if Version > 1 then + begin + ReadBuffer(Dummy, SizeOf(Dummy)); + Color := TColor(Dummy); + end; + + if Version > 5 then + begin + if coUseCaptionAlignment in FOptions then + begin + ReadBuffer(Dummy, SizeOf(Dummy)); + CaptionAlignment := TAlignment(Dummy); + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.ParentBiDiModeChanged; + +var + Columns : TVirtualTreeColumns; + +begin + if coParentBidiMode in FOptions then + begin + Columns := GetOwner as TVirtualTreeColumns; + if Assigned(Columns) and (FBiDiMode <> TreeViewControl.BiDiMode) then + begin + FBiDiMode := TreeViewControl.BiDiMode; + Changed(False); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.ParentColorChanged; + +var + Columns : TVirtualTreeColumns; + +begin + if coParentColor in FOptions then + begin + Columns := GetOwner as TVirtualTreeColumns; + if Assigned(Columns) and (FColor <> TreeViewControl.Color) then + begin + FColor := TreeViewControl.Color; + Changed(False); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.RestoreLastWidth; + +begin + TVirtualTreeColumns(GetOwner).AnimatedResize(Index, FLastWidth); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumn.SaveToStream(const Stream : TStream); + +var + Dummy : Integer; + +begin + with Stream do + begin + Dummy := Length(FText); + WriteBuffer(Dummy, SizeOf(Dummy)); + WriteBuffer(PWideChar(FText)^, 2 * Dummy); + Dummy := Length(FHint); + WriteBuffer(Dummy, SizeOf(Dummy)); + WriteBuffer(PWideChar(FHint)^, 2 * Dummy); + WriteBuffer(FWidth, SizeOf(FWidth)); + WriteBuffer(FMinWidth, SizeOf(FMinWidth)); + WriteBuffer(FMaxWidth, SizeOf(FMaxWidth)); + Dummy := Ord(FStyle); + WriteBuffer(Dummy, SizeOf(Dummy)); + Dummy := FImageIndex; + WriteBuffer(Dummy, SizeOf(Dummy)); + Dummy := Ord(FLayout); + WriteBuffer(Dummy, SizeOf(Dummy)); + WriteBuffer(FMargin, SizeOf(FMargin)); + WriteBuffer(FSpacing, SizeOf(FSpacing)); + Dummy := Ord(FBiDiMode); + WriteBuffer(Dummy, SizeOf(Dummy)); + Dummy := Integer(FOptions); + WriteBuffer(Dummy, SizeOf(Dummy)); + + // parts introduced with stream version 1 + WriteBuffer(FTag, SizeOf(Dummy)); + Dummy := Cardinal(FAlignment); + WriteBuffer(Dummy, SizeOf(Dummy)); + + // parts introduced with stream version 2 + Dummy := Integer(FColor); + WriteBuffer(Dummy, SizeOf(Dummy)); + + // parts introduced with stream version 6 + if coUseCaptionAlignment in FOptions then + begin + Dummy := Cardinal(FCaptionAlignment); + WriteBuffer(Dummy, SizeOf(Dummy)); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumn.UseRightToLeftReading : Boolean; + +begin + Result := FBiDiMode <> bdLeftToRight; +end; + +//----------------- TVirtualTreeColumns -------------------------------------------------------------------------------- + +constructor TVirtualTreeColumns.Create(AOwner : TVTHeader); + +var + ColumnClass : TVirtualTreeColumnClass; + +begin + FHeader := AOwner; + + // Determine column class to be used in the header. + ColumnClass := Self.TreeViewControl.GetColumnClass; + // The owner tree always returns the default tree column class if not changed by application/descendants. + inherited Create(ColumnClass); + + FHeaderBitmap := TBitmap.Create; + FHeaderBitmap.PixelFormat := pf32Bit; + + FHoverIndex := NoColumn; + FDownIndex := NoColumn; + FClickIndex := NoColumn; + FDropTarget := NoColumn; + FTrackIndex := NoColumn; + FDefaultWidth := 50; + Self.FColumnPopupMenu := nil; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +destructor TVirtualTreeColumns.Destroy; + +begin + FreeAndNil(FColumnPopupMenu); + FreeAndNil(FHeaderBitmap); + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetCount : Integer; + +begin + Result := inherited Count; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetItem(Index : TColumnIndex) : TVirtualTreeColumn; + +begin + Result := TVirtualTreeColumn(inherited GetItem(Index)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetNewIndex(P : TPoint; var OldIndex : TColumnIndex) : Boolean; + +var + NewIndex : Integer; + +begin + Result := False; + // convert to local coordinates + Inc(P.Y, Header.Height); + NewIndex := ColumnFromPosition(P); + if NewIndex <> OldIndex then + begin + if OldIndex > NoColumn then + Header.Invalidate(Items[OldIndex], False, True); + OldIndex := NewIndex; + if OldIndex > NoColumn then + Header.Invalidate(Items[OldIndex], False, True); + Result := True; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.SetDefaultWidth(Value : TDimension); + +begin + FDefaultWidth := Value; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.SetItem(Index : TColumnIndex; Value : TVirtualTreeColumn); + +begin + inherited SetItem(Index, Value); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.StyleServices(AControl : TControl) : TCustomStyleServices; +begin + if AControl = nil then + AControl := TreeView; + Result := VTStyleServices(AControl); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.AdjustAutoSize(CurrentIndex : TColumnIndex; Force : Boolean = False); + +// Called only if the header is in auto-size mode which means a column needs to be so large +// that it fills all the horizontal space not occupied by the other columns. +// CurrentIndex (if not InvalidColumn) describes which column has just been resized. + +var + AutoIndex, + Index: Integer; + NewValue, RestWidth : TDimension; + WasUpdating : Boolean; +begin + if Count > 0 then + begin + // Determine index to be used for auto resizing. This is usually given by the owner's AutoSizeIndex, but + // could be different if the column whose resize caused the invokation here is either the auto column itself + // or visually to the right of the auto size column. + AutoIndex := Header.AutoSizeIndex; + if (AutoIndex < 0) or (AutoIndex >= Count) then + AutoIndex := Count - 1; + + if AutoIndex >= 0 then + begin + with TreeViewControl do + begin + if HandleAllocated then + RestWidth := ClientWidth + else + RestWidth := Width; + end; + + // Go through all columns and calculate the rest space remaining. + for Index := 0 to Count - 1 do + if (Index <> AutoIndex) and (coVisible in Items[Index].Options) then + Dec(RestWidth, Items[Index].Width); + + with Items[AutoIndex] do + begin + NewValue := Max(MinWidth, Min(MaxWidth, RestWidth)); + if Force or (FWidth <> NewValue) then + begin + FWidth := NewValue; + UpdatePositions; + WasUpdating := csUpdating in TreeViewControl.ComponentState; + if not WasUpdating then + TreeViewControl.Updating(); // Fixes #398 + try + TreeViewControl.DoColumnResize(AutoIndex); + finally + if not WasUpdating then + TreeViewControl.Updated(); + end; + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.AdjustDownColumn(P : TPoint) : TColumnIndex; + +// Determines the column from the given position and returns it. If this column is allowed to be clicked then +// it is also kept for later use. + +begin + // Convert to local coordinates. + Inc(P.Y, Header.Height); + Result := ColumnFromPosition(P); + if (Result > NoColumn) and (Result <> FDownIndex) and (coAllowClick in Items[Result].Options) and + (coEnabled in Items[Result].Options) then + begin + if FDownIndex > NoColumn then + Header.Invalidate(Items[FDownIndex]); + FDownIndex := Result; + FCheckBoxHit := Items[Result].HasImage and PtInRect(Items[Result].ImageRect, P) and Items[Result].CheckBox; + Header.Invalidate(Items[FDownIndex]); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.AdjustHoverColumn(P : TPoint) : Boolean; + +// Determines the new hover column index and returns True if the index actually changed else False. + +begin + Result := GetNewIndex(P, FHoverIndex); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.AdjustPosition(Column : TVirtualTreeColumn; Position : Cardinal); + +// Reorders the column position array so that the given column gets the given position. + +var + OldPosition : Cardinal; + +begin + OldPosition := Column.Position; + if OldPosition <> Position then + begin + if OldPosition < Position then + begin + // column will be moved up so move down other entries + Move(FPositionToIndex[OldPosition + 1], FPositionToIndex[OldPosition], (Position - OldPosition) * SizeOf(Cardinal)); + end + else + begin + // column will be moved down so move up other entries + Move(FPositionToIndex[Position], FPositionToIndex[Position + 1], (OldPosition - Position) * SizeOf(Cardinal)); + end; + FPositionToIndex[Position] := Column.Index; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.CanSplitterResize(P : TPoint; Column : TColumnIndex) : Boolean; + +begin + Result := (Column > NoColumn) and ([coResizable, coVisible] * Items[Column].Options = [coResizable, coVisible]); + DoCanSplitterResize(P, Column, Result); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.DoCanSplitterResize(P : TPoint; Column : TColumnIndex; var Allowed : Boolean); + +begin + if Assigned(TreeViewControl.OnCanSplitterResizeColumn) then + TreeViewControl.OnCanSplitterResizeColumn(Header, P, Column, Allowed); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.DrawButtonText(DC : HDC; Caption : string; Bounds : TRect; Enabled, Hot : Boolean; + DrawFormat : Cardinal; WrapCaption : Boolean); + +var + TextSpace : TDimension; + Size : TSize; + +begin + if not WrapCaption then + begin + // Do we need to shorten the caption due to limited space? + GetTextExtentPoint32W(DC, PWideChar(Caption), Length(Caption), Size); + TextSpace := Bounds.Right - Bounds.Left; + if TextSpace < Size.cx then + Caption := ShortenString(DC, Caption, TextSpace); + end; + + SetBkMode(DC, TRANSPARENT); + if not Enabled then + if TreeViewControl.VclStyleEnabled then + begin + SetTextColor(DC, ColorToRGB(TreeViewControl.Colors.HeaderFontColor)); + WinApi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); + end + else + begin + OffsetRect(Bounds, 1, 1); + SetTextColor(DC, ColorToRGB(clBtnHighlight)); + WinApi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); + OffsetRect(Bounds, - 1, - 1); + SetTextColor(DC, ColorToRGB(clBtnShadow)); + WinApi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); + end + else + begin + if Hot then + SetTextColor(DC, ColorToRGB(TreeViewControl.Colors.HeaderHotColor)) + else + SetTextColor(DC, ColorToRGB(TreeViewControl.Colors.HeaderFontColor)); + WinApi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.FixPositions; +// Fixes column positions after loading from DFM or Bidi mode change. +var + LColumnsByPos: TList; + I: Integer; +begin + LColumnsByPos := TList.Create; + try + LColumnsByPos.Capacity := Self.Count; + for I := 0 to Self.Count-1 do + LColumnsByPos.Add(Items[I]); + + LColumnsByPos.Sort( + TComparer.Construct( + function(const A, B: TVirtualTreeColumn): Integer + begin + Result := CompareValue(A.Position, B.Position); + if Result = 0 then + Result := CompareValue(A.Index, B.Index); + end) + ); + + for I := 0 to LColumnsByPos.Count-1 do + begin + LColumnsByPos[I].FPosition := I; + Self.FPositionToIndex[I] := LColumnsByPos[I].Index; + end; + + finally + LColumnsByPos.Free; + end; + + FNeedPositionsFix := False; + UpdatePositions(True); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetColumnAndBounds(P : TPoint; var ColumnLeft, ColumnRight : TDimension; + Relative : Boolean = True) : Integer; + +// Returns the column where the mouse is currently in as well as the left and right bound of +// this column (Left and Right are undetermined if no column is involved). + +var + I : Integer; + +begin + Result := InvalidColumn; + if Relative and (P.X >= Header.Columns.GetVisibleFixedWidth) then + ColumnLeft := - TreeViewControl.EffectiveOffsetX + else + ColumnLeft := 0; + + if TreeViewControl.UseRightToLeftAlignment then + Inc(ColumnLeft, TreeViewControl.ComputeRTLOffset(True)); + + for I := 0 to Count - 1 do + with Items[FPositionToIndex[I]] do + if coVisible in FOptions then + begin + ColumnRight := ColumnLeft + FWidth; + + //fix: in right to left alignment, X can be in the + //area on the left of first column which is OUT. + if (P.X < ColumnLeft) and (I = 0) then + begin + Result := InvalidColumn; + Exit; + end; + if P.X < ColumnRight then + begin + Result := FPositionToIndex[I]; + Exit; + end; + ColumnLeft := ColumnRight; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetOwner : TPersistent; + +begin + Result := FHeader; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.HandleClick(P : TPoint; Button : TMouseButton; Force, DblClick : Boolean) : Boolean; + +// Generates a click event if the mouse button has been released over the same column it was pressed first. +// Alternatively, Force might be set to True to indicate that the down index does not matter (right, middle and +// double click). +// Returns true if the click was handled, False otherwise. + +var + HitInfo : TVTHeaderHitInfo; + NewClickIndex : Integer; + Menu : TPopupMenu; +begin + Result := False; + if (csDesigning in TreeViewControl.ComponentState) then + Exit; + // Convert vertical position to local coordinates. + Inc(P.Y, Header.Height); + NewClickIndex := ColumnFromPosition(P); + with HitInfo do + begin + X := P.X; + Y := P.Y; + Shift := Header.GetShiftState; + if DblClick then + Shift := Shift + [ssDouble]; + end; + HitInfo.Button := Button; + + if (NewClickIndex > NoColumn) and (coAllowClick in Items[NewClickIndex].Options) and + ((NewClickIndex = FDownIndex) or Force) then + begin + FClickIndex := NewClickIndex; + HitInfo.Column := NewClickIndex; + HitInfo.HitPosition := [hhiOnColumn]; + + if Items[NewClickIndex].HasImage and PtInRect(Items[NewClickIndex].ImageRect, P) then + begin + Include(HitInfo.HitPosition, hhiOnIcon); + if Items[NewClickIndex].CheckBox then + begin + if Button = TMouseButton.mbLeft then + TreeViewControl.UpdateColumnCheckState(Items[NewClickIndex]); + Include(HitInfo.HitPosition, hhiOnCheckbox); + end; + end; + end + else + begin + FClickIndex := NoColumn; + HitInfo.Column := NoColumn; + HitInfo.HitPosition := [hhiNoWhere]; + end; + + if DblClick then + TreeViewControl.DoHeaderDblClick(HitInfo) + else begin + if (hoHeaderClickAutoSort in Header.Options) and (HitInfo.Button = TMouseButton.mbLeft) and not (hhiOnCheckbox in HitInfo.HitPosition) and (HitInfo.Column >= 0) then + begin + // handle automatic setting of SortColumn and toggling of the sort order + if HitInfo.Column <> Header.SortColumn then + begin + // set sort column + Header.DoSetSortColumn(HitInfo.Column, Self[HitInfo.Column].DefaultSortDirection); + end//if + else + begin + // toggle sort direction + if Header.SortDirection = sdDescending then + Header.SortDirection := sdAscending + else + Header.SortDirection := sdDescending; + end; //else + Result := True; + end; //if + + if (Button = TMouseButton.mbRight) then + begin + Dec(P.Y, Header.Height); // popup menus at actual clicked point + FreeAndNil(FColumnPopupMenu); // Attention: Do not free the TVTHeaderPopupMenu at the end of this method, otherwise the clikc events of the menu item will not be fired. + Self.FDownIndex := NoColumn; + Self.FTrackIndex := NoColumn; + Self.FCheckBoxHit := False; + Menu := Header.DoGetPopupMenu(Self.ColumnFromPosition(Point(P.X, P.Y + TreeViewControl.Height)), P); + if Assigned(Menu) then + begin + TreeViewControl.StopTimer(ScrollTimer); + TreeViewControl.StopTimer(HeaderTimer); + Header.Columns.SetHoverIndex(NoColumn); + TreeViewControl.DoStateChange([], [tsScrollPending, tsScrolling]); + + Menu.PopupComponent := TreeViewControl; + With TreeViewControl.ClientToScreen(P) do + Menu.Popup(X, Y); + Result := True; + end + else if (hoAutoColumnPopupMenu in Header.Options) then + begin + FColumnPopupMenu := TVTHeaderPopupMenu.Create(TreeViewControl); + TVTHeaderPopupMenu(FColumnPopupMenu).OnAddHeaderPopupItem := HeaderPopupMenuAddHeaderPopupItem; + FColumnPopupMenu.PopupComponent := TreeViewControl; + if (hoDblClickResize in Header.Options) and ((TreeViewControl.ChildCount[nil] > 0) or (hoAutoResizeInclCaption in Header.Options)) then + TVTHeaderPopupMenu(FColumnPopupMenu).Options := TVTHeaderPopupMenu(FColumnPopupMenu).Options + [poResizeToFitItem] + else + TVTHeaderPopupMenu(FColumnPopupMenu).Options := TVTHeaderPopupMenu(FColumnPopupMenu).Options - [poResizeToFitItem]; + With TreeViewControl.ClientToScreen(P) do + FColumnPopupMenu.Popup(X, Y); + Result := True; + end; // if hoAutoColumnPopupMenu + end; //if mbRight + TreeViewControl.DoHeaderClick(HitInfo); + end; //else (not DblClick) + + if not (hhiNoWhere in HitInfo.HitPosition) then + Header.Invalidate(Items[NewClickIndex]); + if (FClickIndex > NoColumn) and (FClickIndex <> NewClickIndex) then + Header.Invalidate(Items[FClickIndex]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.HeaderPopupMenuAddHeaderPopupItem(const Sender : TObject; const Column : TColumnIndex; var Cmd : TAddPopupItemType); +begin + TBaseVirtualTreeCracker(Sender).DoHeaderAddPopupItem(Column, Cmd); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.IndexChanged(OldIndex, NewIndex : Integer); + +// Called by a column when its index in the collection changes. If NewIndex is -1 then the column is +// about to be removed, otherwise it is moved to a new index. +// The method will then update the position array to reflect the change. + +var + I : Integer; + Increment : Integer; + Lower, + Upper : Integer; + +begin + if NewIndex = - 1 then + begin + // Find position in the array with the old index. + Upper := High(FPositionToIndex); + for I := 0 to Upper do + begin + if FPositionToIndex[I] = OldIndex then + begin + // Index found. Move all higher entries one step down and remove the last entry. + if I < Upper then + System.Move(FPositionToIndex[I + 1], FPositionToIndex[I], (Upper - I) * SizeOf(TColumnIndex)); + end; + // Decrease all indices, which are greater than the index to be deleted. + if FPositionToIndex[I] > OldIndex then + System.Dec(FPositionToIndex[I]); + end; + SetLength(FPositionToIndex, High(FPositionToIndex)); + end + else + begin + if OldIndex < NewIndex then + Increment := - 1 + else + Increment := 1; + + Lower := Min(OldIndex, NewIndex); + Upper := Max(OldIndex, NewIndex); + for I := 0 to High(FPositionToIndex) do + begin + if (FPositionToIndex[I] >= Lower) and (FPositionToIndex[I] < Upper) then + System.Inc(FPositionToIndex[I], Increment) + else + if FPositionToIndex[I] = OldIndex then + FPositionToIndex[I] := NewIndex; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.InitializePositionArray; + +// Ensures that the column position array contains as many entries as columns are defined. +// The array is resized and initialized with default values if needed. + +var + I, OldSize : Integer; + Changed : Boolean; + +begin + if Count <> Length(FPositionToIndex) then + begin + OldSize := Length(FPositionToIndex); + SetLength(FPositionToIndex, Count); + if Count > OldSize then + begin + // New items have been added, just set their position to the same as their index. + for I := OldSize to Count - 1 do + FPositionToIndex[I] := I; + end + else + begin + // Items have been deleted, so reindex remaining entries by decrementing values larger than the highest + // possible index until no entry is higher than this limit. + repeat + Changed := False; + for I := 0 to Count - 1 do + if FPositionToIndex[I] >= Count then + begin + System.Dec(FPositionToIndex[I]); + Changed := True; + end; + until not Changed; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.Notify(Item : TCollectionItem; Action : System.Classes.TCollectionNotification); +var + I : Integer; + lRemovedPosition: TColumnPosition; +begin + if Action in [cnDeleting] then + begin + lRemovedPosition := TVirtualTreeColumn(Item).Position; + // Adjust all positions larger than the deleted column's position. Fixes #959, #1049 + for I := Count - 1 downto 0 do + begin + if Items[I].Position > lRemovedPosition then + Items[I].Position := Items[I].Position - 1; + end; //for I + + with TreeViewControl do + if not (csLoading in ComponentState) and (FocusedColumn = Item.Index) then + InternalSetFocusedColumn(NoColumn); //bypass side effects in SetFocusedColumn + end; // if cnDeleting +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.ReorderColumns(RTL : Boolean); + +var + I : Integer; + +begin + if RTL then + begin + for I := 0 to Count - 1 do + FPositionToIndex[I] := Count - I - 1; + end + else + begin + for I := 0 to Count - 1 do + FPositionToIndex[I] := I; + end; + + UpdatePositions(True); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.SetHoverIndex(Index : TColumnIndex); +begin + FHoverIndex := index; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.EndUpdate; +begin + InitializePositionArray(); + FixPositions(); // Accept the cuurent order. See issue #753 + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.Update(Item : TCollectionItem); + +begin + // This is the only place which gets notified when a new column has been added or removed + // and we need this event to adjust the column position array. + InitializePositionArray; + if csLoading in TreeViewControl.ComponentState then + FNeedPositionsFix := True + else + UpdatePositions; + + // The first column which is created is by definition also the main column. + if (Count > 0) and (Header.MainColumn < 0) then + Header.MainColumn := 0; + + if not (csLoading in TreeViewControl.ComponentState) and not (hsLoading in Header.States) then + begin + with Header do + begin + if hoAutoResize in Options then + AdjustAutoSize(InvalidColumn); + if Assigned(Item) then + Invalidate(Item as TVirtualTreeColumn) + else + if Self.TreeViewControl.HandleAllocated then + begin + Self.TreeViewControl.UpdateHorizontalScrollBar(False); + Invalidate(nil); + TreeViewControl.Invalidate; + end; + + if not (Self.TreeViewControl.IsUpdating) then + // This is mainly to let the designer know when a change occurs at design time which + // doesn't involve the object inspector (like column resizing with the mouse). + // This does NOT include design time code as the communication is done via an interface. + Self.TreeViewControl.UpdateDesigner; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.UpdatePositions(Force : Boolean = False); + +// Recalculates the left border of every column and updates their position property according to the +// PostionToIndex array which primarily determines where each column is placed visually. + +var + I: Integer; + RunningPos: TDimension; +begin + if not (csDestroying in TreeViewControl.ComponentState) and not FNeedPositionsFix and (Force or (UpdateCount = 0)) then + begin + RunningPos := 0; + for I := 0 to High(FPositionToIndex) do + with Items[FPositionToIndex[I]] do + begin + FPosition := I; + FLeft := RunningPos; + if coVisible in FOptions then + Inc(RunningPos, FWidth); + end; + TreeViewControl.UpdateHorizontalScrollBar(False); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.Add : TVirtualTreeColumn; + +begin + Assert(GetCurrentThreadId = MainThreadId, 'UI controls may only be changed in UI thread.'); + Result := TVirtualTreeColumn(inherited Add); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.AnimatedResize(Column : TColumnIndex; NewWidth : TDimension); + +// Resizes the given column animated by scrolling the window DC. + +var + OldWidth : TDimension; + DC : TCanvas; + I, Steps : Integer; + DX : TDimension; + HeaderScrollRect, + ScrollRect, + R : TRect; + +begin + if not IsValidColumn(Column) then + Exit; // Just in case. + + // Make sure the width constrains are considered. + if NewWidth < Items[Column].MinWidth then + NewWidth := Items[Column].MinWidth; + if NewWidth > Items[Column].MaxWidth then + NewWidth := Items[Column].MaxWidth; + + OldWidth := Items[Column].Width; + // Nothing to do if the width is the same. + if OldWidth <> NewWidth then + begin + if not ((hoDisableAnimatedResize in Header.Options) or + (coDisableAnimatedResize in Items[Column].Options)) then + begin + DC := TCanvas.Create; + DC.Handle := GetWindowDC(TreeViewControl.Handle); + with TreeViewControl do + try + Steps := 32; + DX := Divide(NewWidth - OldWidth, Steps); + + // Determination of the scroll rectangle is a bit complicated since we neither want + // to scroll the scrollbars nor the border of the treeview window. + HeaderScrollRect := HeaderRect; + ScrollRect := HeaderScrollRect; + // Exclude the header itself from scrolling. + ScrollRect.Top := ScrollRect.Bottom; + ScrollRect.Bottom := ScrollRect.Top + ClientHeight; + ScrollRect.Right := ScrollRect.Left + ClientWidth; + with Items[Column] do + Inc(ScrollRect.Left, FLeft + FWidth); + HeaderScrollRect.Left := ScrollRect.Left; + HeaderScrollRect.Right := ScrollRect.Right; + + // When the new width is larger then avoid artefacts on the left hand side + // by deleting a small stripe + if NewWidth > OldWidth then + begin + R := ScrollRect; +// NewBrush := CreateSolidBrush(ColorToRGB(Color)); +// LastBrush := SelectObject(DC, NewBrush); + R.Right := R.Left + DX; +// FillRect(DC, R, NewBrush); +// SelectObject(DC, LastBrush); +// DeleteObject(NewBrush); + DC.Brush.Color := Color; + DC.FillRect(R); + end + else + begin + Inc(HeaderScrollRect.Left, DX); + Inc(ScrollRect.Left, DX); + end; + + for I := 0 to Steps - 1 do + begin + ScrollDC(DC.Handle, DX, 0, HeaderScrollRect, HeaderScrollRect, 0, nil); + Inc(HeaderScrollRect.Left, DX); + ScrollDC(DC.Handle, DX, 0, ScrollRect, ScrollRect, 0, nil); + Inc(ScrollRect.Left, DX); + Sleep(1); + end; + finally + ReleaseDC(Handle, DC.Handle); + DC.Free; + end; + end; + Items[Column].Width := NewWidth; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.Assign(Source : TPersistent); + +begin + // Let the collection class assign the items. + inherited; + + if Source is TVirtualTreeColumns then + begin + // Copying the position array is the only needed task here. + FPositionToIndex := Copy(TVirtualTreeColumns(Source).FPositionToIndex, 0, MaxInt); + + // Make sure the left edges are correct after assignment. + FNeedPositionsFix := False; + UpdatePositions(True); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.Clear; + +begin + FClearing := True; + try + TreeViewControl.CancelEditNode; + + // Since we're freeing all columns, the following have to be true when we're done. + FHoverIndex := NoColumn; + FDownIndex := NoColumn; + FTrackIndex := NoColumn; + FClickIndex := NoColumn; + FCheckBoxHit := False; + + with Header do + if not (hsLoading in States) then + begin + InternalSetAutoSizeIndex(NoColumn); //bypass side effects in SetAutoSizeColumn + MainColumn := NoColumn; + InternalSetSortColumn(NoColumn); //bypass side effects in SetSortColumn + end; + + with TreeViewControl do + if not (csLoading in ComponentState) then + InternalSetFocusedColumn(NoColumn); //bypass side effects in SetFocusedColumn + + inherited Clear; + finally + FClearing := False; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.ColumnFromPosition(P : TPoint; Relative : Boolean = True) : TColumnIndex; + +// Determines the current column based on the position passed in P. + +var + I: Integer; + Sum: TDimension; +begin + Result := InvalidColumn; + + // The position must be within the header area, but we extend the vertical bounds to the entire treeview area. + if (P.X >= 0) and (P.Y >= 0) and (P.Y <= TreeViewControl.Height) then + with FHeader, TreeViewControl do + begin + if Relative and (P.X >= GetVisibleFixedWidth) then + Sum := - EffectiveOffsetX + else + Sum := 0; + + if UseRightToLeftAlignment then + Inc(Sum, ComputeRTLOffset(True)); + + for I := 0 to Count - 1 do + if coVisible in Items[FPositionToIndex[I]].Options then + begin + Inc(Sum, Items[FPositionToIndex[I]].Width); + if P.X < Sum then + begin + Result := FPositionToIndex[I]; + Break; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.ColumnFromPosition(PositionIndex : TColumnPosition) : TColumnIndex; + +// Returns the index of the column at the given position. + +begin + if Integer(PositionIndex) < Length(FPositionToIndex) then + Result := FPositionToIndex[PositionIndex] + else + Result := NoColumn; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.Equals(OtherColumnsObj : TObject) : Boolean; + +// Compares itself with the given set of columns and returns True if all published properties are the same +// (including column order), otherwise False is returned. + +var + I : Integer; + OtherColumns : TVirtualTreeColumns; + +begin + if not (OtherColumnsObj is TVirtualTreeColumns) then + begin + Result := False; + Exit; + end; + + OtherColumns := TVirtualTreeColumns(OtherColumnsObj); + + // Same number of columns? + Result := OtherColumns.Count = Count; + if Result then + begin + // Same order of columns? + Result := CompareMem(Pointer(FPositionToIndex), Pointer(OtherColumns.FPositionToIndex), + Length(FPositionToIndex) * SizeOf(TColumnIndex)); + if Result then + begin + for I := 0 to Count - 1 do + if not Items[I].Equals(OtherColumns[I]) then + begin + Result := False; + Break; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.GetColumnBounds(Column : TColumnIndex; var Left, Right : TDimension); + +// Returns the left and right bound of the given column. If Column is NoColumn then the entire client width is returned. + +begin + if Column <= NoColumn then + begin + Left := 0; + Right := TreeViewControl.ClientWidth; + end + else + begin + Left := Items[Column].Left; + Right := Left + Items[Column].Width; + if TreeViewControl.UseRightToLeftAlignment then + begin + Inc(Left, TreeViewControl.ComputeRTLOffset(True)); + Inc(Right, TreeViewControl.ComputeRTLOffset(True)); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetScrollWidth : TDimension; + +// Returns the average width of all visible, non-fixed columns. If there is no such column the indent is returned. + +var + I : Integer; + ScrollColumnCount : Integer; + +begin + + Result := 0; + + ScrollColumnCount := 0; + for I := 0 to Header.Columns.Count - 1 do + begin + if ([coVisible, coFixed] * Header.Columns[I].Options = [coVisible]) then + begin + Inc(Result, Header.Columns[I].Width); + System.Inc(ScrollColumnCount); + end; + end; + + if ScrollColumnCount > 0 then // use average width + Result := Round(Result / ScrollColumnCount) + else // use indent + Result := TreeViewControl.Indent; + +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetTreeView: TCustomControl; +begin + Result := TBaseVirtualTreeCracker(Header.GetOwner); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetFirstVisibleColumn(ConsiderAllowFocus : Boolean = False) : TColumnIndex; + +// Returns the index of the first visible column or "InvalidColumn" if either no columns are defined or +// all columns are hidden. +// If ConsiderAllowFocus is True then the column has not only to be visible but also focus has to be allowed. + +var + I : Integer; + +begin + Result := InvalidColumn; + if (UpdateCount > 0) or (csLoading in TreeViewControl.ComponentState) then + Exit; // See issue #760 + for I := 0 to Count - 1 do + if (coVisible in Items[FPositionToIndex[I]].Options) and + ((not ConsiderAllowFocus) or + (coAllowFocus in Items[FPositionToIndex[I]].Options) + ) then + begin + Result := FPositionToIndex[I]; + Break; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetLastVisibleColumn(ConsiderAllowFocus : Boolean = False) : TColumnIndex; + +// Returns the index of the last visible column or "InvalidColumn" if either no columns are defined or +// all columns are hidden. +// If ConsiderAllowFocus is True then the column has not only to be visible but also focus has to be allowed. + +var + I : Integer; + +begin + Result := InvalidColumn; + if (UpdateCount > 0) or (csLoading in TreeViewControl.ComponentState) then + Exit; // See issue #760 + for I := Count - 1 downto 0 do + if (coVisible in Items[FPositionToIndex[I]].Options) and + ((not ConsiderAllowFocus) or + (coAllowFocus in Items[FPositionToIndex[I]].Options) + ) then + begin + Result := FPositionToIndex[I]; + Break; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetFirstColumn : TColumnIndex; + +// Returns the first column in display order. + +begin + if Count = 0 then + Result := InvalidColumn + else + Result := FPositionToIndex[0]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetNextColumn(Column : TColumnIndex) : TColumnIndex; + +// Returns the next column in display order. Column is the index of an item in the collection (a column). + +var + Position : Integer; + +begin + if Column < 0 then + Result := InvalidColumn + else + begin + Position := Items[Column].Position; + if Position < Count - 1 then + Result := FPositionToIndex[Position + 1] + else + Result := InvalidColumn; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetNextVisibleColumn(Column : TColumnIndex; ConsiderAllowFocus : Boolean = False) : TColumnIndex; + +// Returns the next visible column in display order, Column is an index into the columns list. +// If ConsiderAllowFocus is True then the column has not only to be visible but also focus has to be allowed. + +begin + Result := Column; + repeat + Result := GetNextColumn(Result); + until (Result = InvalidColumn) or + ((coVisible in Items[Result].Options) and + ((not ConsiderAllowFocus) or + (coAllowFocus in Items[Result].Options) + ) + ); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetPreviousColumn(Column : TColumnIndex) : TColumnIndex; + +// Returns the previous column in display order, Column is an index into the columns list. + +var + Position : Integer; + +begin + if Column < 0 then + Result := InvalidColumn + else + begin + Position := Items[Column].Position; + if Position > 0 then + Result := FPositionToIndex[Position - 1] + else + Result := InvalidColumn; + Assert(Column <> Result, 'The previous column must not have the same position as the given column.'); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetPreviousVisibleColumn(Column : TColumnIndex; ConsiderAllowFocus : Boolean = False) : TColumnIndex; + +// Returns the previous visible column in display order, Column is an index into the columns list. +// If ConsiderAllowFocus is True then the column has not only to be visible but also focus has to be allowed. + +begin + Result := Column; + repeat + Result := GetPreviousColumn(Result); + until (Result = InvalidColumn) or + ((coVisible in Items[Result].Options) and + ((not ConsiderAllowFocus) or + (coAllowFocus in Items[Result].Options) + ) + ); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetSelectedCellColumns : TColumnsArray; +var + LColumnIndex: TColumnIndex; +begin + Result := []; + LColumnIndex := GetFirstColumn; + if LColumnIndex = InvalidColumn then + Exit; + while LColumnIndex <> InvalidColumn do + begin + if coMulticellSelected in FHeader.Columns[LColumnIndex].Options then + Result := Result + [FHeader.Columns[LColumnIndex]]; + LColumnIndex := GetNextColumn(LColumnIndex); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.HasMulticellSelection: Boolean; +var + LColumnIndex: TColumnIndex; +begin + LColumnIndex := GetFirstColumn; + if LColumnIndex = InvalidColumn then + Exit(False); + while LColumnIndex <> InvalidColumn do + begin + if coMulticellSelected in FHeader.Columns[LColumnIndex].Options then + Exit(True); + LColumnIndex := GetNextColumn(LColumnIndex); + end; + Result := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetVisibleColumns : TColumnsArray; + +// Returns a list of all currently visible columns in actual order. + +var + I, Counter : Integer; + +begin + SetLength(Result, Count); + Counter := 0; + + for I := 0 to Count - 1 do + if coVisible in Items[FPositionToIndex[I]].Options then + begin + Result[Counter] := Items[FPositionToIndex[I]]; + System.Inc(Counter); + end; + // Set result length to actual visible count. + SetLength(Result, Counter); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.GetVisibleFixedWidth : TDimension; + +// Determines the horizontal space all visible and fixed columns occupy. + +var + I : Integer; + +begin + Result := 0; + for I := 0 to Count - 1 do + begin + if Items[I].Options * [coVisible, coFixed] = [coVisible, coFixed] then + Inc(Result, Items[I].Width); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.IsValidColumn(Column : TColumnIndex) : Boolean; + +// Determines whether the given column is valid or not, that is, whether it is one of the current columns. + +begin + Result := (Column > NoColumn) and (Column < Count); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.LoadFromStream(const Stream : TStream; Version : Integer); + +var + I, + ItemCount : Integer; + +begin + Clear; + Stream.ReadBuffer(ItemCount, SizeOf(ItemCount)); + // number of columns + if ItemCount > 0 then + begin + BeginUpdate; + try + for I := 0 to ItemCount - 1 do + Add.LoadFromStream(Stream, Version); + SetLength(FPositionToIndex, ItemCount); + Stream.ReadBuffer(FPositionToIndex[0], ItemCount * SizeOf(TColumnIndex)); + UpdatePositions(True); + finally + EndUpdate; + end; + end; + + // Data introduced with header stream version 5 + if Version > 4 then + Stream.ReadBuffer(FDefaultWidth, SizeOf(FDefaultWidth)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.PaintHeader(DC : HDC; R : TRect; HOffset : TDimension); + +// Backward compatible header paint method. This method takes care of visually moving floating columns + +var + VisibleFixedWidth : TDimension; + RTLOffset : TDimension; + + procedure PaintFixedArea; + + begin + if VisibleFixedWidth > 0 then + PaintHeader(FHeaderBitmap.Canvas, + Rect(0, 0, Min(R.Right, VisibleFixedWidth), R.Bottom - R.Top), + Point(R.Left, R.Top), RTLOffset); + end; + +begin + // Adjust size of the header bitmap + FHeaderBitmap.SetSize(Max(TreeViewControl.HeaderRect.Right, R.Right - R.Left), TreeViewControl.HeaderRect.Bottom); + + VisibleFixedWidth := GetVisibleFixedWidth; + + // Consider right-to-left directionality. + if TreeViewControl.UseRightToLeftAlignment then + RTLOffset := TreeViewControl.ComputeRTLOffset + else + RTLOffset := 0; + + if RTLOffset = 0 then + PaintFixedArea; + + // Paint the floating part of the header. + PaintHeader(FHeaderBitmap.Canvas, + Rect(VisibleFixedWidth - HOffset, 0, R.Right + VisibleFixedWidth - HOffset, R.Bottom - R.Top), + Point(R.Left + VisibleFixedWidth, R.Top), RTLOffset); + + // In case of right-to-left directionality we paint the fixed part last. + if RTLOffset <> 0 then + PaintFixedArea; + + // Blit the result to target. + BitBlt(DC, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, FHeaderBitmap.Canvas.Handle, R.Left, R.Top, SRCCOPY); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.PaintHeader(TargetCanvas : TCanvas; R : TRect; const Target : TPoint; + RTLOffset : TDimension = 0); + +// Main paint method to draw the header. +// This procedure will paint the a slice (given in R) out of HeaderRect into TargetCanvas starting at position Target. +// This function does not offer the option to visually move floating columns due to scrolling. To accomplish this you +// need to call this method twice. + +var + Run : TColumnIndex; + RightBorderFlag, + NormalButtonStyle, + NormalButtonFlags, + PressedButtonStyle, + PressedButtonFlags, + RaisedButtonStyle, + RaisedButtonFlags : Cardinal; + Images : TCustomImageList; + OwnerDraw, + AdvancedOwnerDraw : Boolean; + PaintInfo : THeaderPaintInfo; + RequestedElements, + ActualElements : THeaderPaintElements; + + //--------------- local functions ------------------------------------------- + + procedure PrepareButtonStyles; + + // Prepare the button styles and flags for later usage. + + begin + RaisedButtonStyle := 0; + RaisedButtonFlags := 0; + case Header.Style of + hsThickButtons : + begin + NormalButtonStyle := BDR_RAISEDINNER or BDR_RAISEDOUTER; + NormalButtonFlags := BF_LEFT or BF_TOP or BF_BOTTOM or BF_MIDDLE or BF_SOFT or BF_ADJUST; + PressedButtonStyle := BDR_RAISEDINNER or BDR_RAISEDOUTER; + PressedButtonFlags := NormalButtonFlags or BF_RIGHT or BF_FLAT or BF_ADJUST; + end; + hsFlatButtons : + begin + NormalButtonStyle := BDR_RAISEDINNER; + NormalButtonFlags := BF_LEFT or BF_TOP or BF_BOTTOM or BF_MIDDLE or BF_ADJUST; + PressedButtonStyle := BDR_SUNKENOUTER; + PressedButtonFlags := BF_RECT or BF_MIDDLE or BF_ADJUST; + end; + else + // hsPlates or hsXPStyle, values are not used in the latter case + begin + NormalButtonStyle := BDR_RAISEDINNER; + NormalButtonFlags := BF_RECT or BF_MIDDLE or BF_SOFT or BF_ADJUST; + PressedButtonStyle := BDR_SUNKENOUTER; + PressedButtonFlags := BF_RECT or BF_MIDDLE or BF_ADJUST; + RaisedButtonStyle := BDR_RAISEDINNER; + RaisedButtonFlags := BF_LEFT or BF_TOP or BF_BOTTOM or BF_MIDDLE or BF_ADJUST; + end; + end; + end; + + //--------------------------------------------------------------------------- + + procedure DrawBackground; + + // Draw the header background. + + var + BackgroundRect : TRect; + Details : TThemedElementDetails; + Theme : HTHEME; + begin + BackgroundRect := Rect(Target.X, Target.Y, Target.X + R.Right - R.Left, Target.Y + Header.Height); + + with TargetCanvas do + begin + if hpeBackground in RequestedElements then + begin + PaintInfo.PaintRectangle := BackgroundRect; + TreeViewControl.DoAdvancedHeaderDraw(PaintInfo, [hpeBackground]); + end + else + begin + if (TreeViewControl.VclStyleEnabled and (seClient in TreeViewControl.StyleElements)) then + begin + Details := StyleServices.GetElementDetails(thHeaderItemRightNormal); + StyleServices.DrawElement(Handle, Details, BackgroundRect, @BackgroundRect {$IF CompilerVersion >= 34}, TreeViewControl.FCurrentPPI{$IFEND}); + end + else + if tsUseThemes in TreeViewControl.TreeStates then + begin + Theme := OpenThemeData(TreeViewControl.Handle, 'HEADER'); + DrawThemeBackground(Theme, Handle, HP_HEADERITEM, HIS_NORMAL, BackgroundRect, nil); + CloseThemeData(Theme); + end + else + begin + Brush.Color := Header.Background; + FillRect(BackgroundRect); + end; + end; + end; + end; + + //--------------------------------------------------------------------------- + + procedure PaintColumnHeader(AColumn : TColumnIndex; ATargetRect : TRect); + + // Draw a single column to TargetRect. The clipping rect needs to be set before + // this procedure is called. + + var + SavedDC : Integer; + ColCaptionText : string; + ColImageInfo : TVTImageInfo; + Glyph : TThemedHeader; + Details : TThemedElementDetails; + WrapCaption : Boolean; + DrawFormat : Cardinal; + Pos : TRect; + DrawHot : Boolean; + ImageWidth : Integer; + begin + ColImageInfo.Ghosted := False; + PaintInfo.Column := Items[AColumn]; + with PaintInfo, Column do + begin + IsHoverIndex := (AColumn = FHoverIndex) and (hoHotTrack in Header.Options) and (coEnabled in Options); + IsDownIndex := (AColumn = FDownIndex) and not FCheckBoxHit; + + if (coShowDropMark in FOptions) and (AColumn = FDropTarget) and (AColumn <> FDragIndex) then + begin + if FDropBefore then + DropMark := dmmLeft + else + DropMark := dmmRight; + end + else + DropMark := dmmNone; + + //Fix for issue 643 + //Do not show the left drop mark if the position to drop is just preceding the target which means + //the dragged column will stay where it is + if (DropMark = dmmLeft) and (Items[FDragIndex].Position = TColumnPosition(Max(Integer(Items[FDropTarget].Position) - 1, 0))) + then + DropMark := dmmNone + else + //Do not show the right drop mark if the position to drop is just following the target which means + //the dragged column will stay where it is + if (DropMark = dmmRight) and (Items[FDragIndex].Position = Items[FDropTarget].Position + 1) + then + DropMark := dmmNone; + + IsEnabled := (coEnabled in FOptions) and (TreeViewControl.Enabled); + ShowHeaderGlyph := (hoShowImages in Header.Options) and ((Assigned(Images) and (FImageIndex > - 1)) or FCheckBox); + ShowSortGlyph := (AColumn = Header.SortColumn) and (hoShowSortGlyphs in Header.Options); + WrapCaption := coWrapCaption in FOptions; + + PaintRectangle := ATargetRect; + + // This path for text columns or advanced owner draw. + if (Style = vsText) or not OwnerDraw or AdvancedOwnerDraw then + begin + // See if the application wants to draw part of the header itself. + RequestedElements := []; + if AdvancedOwnerDraw then + begin + PaintInfo.Column := Items[AColumn]; + TreeViewControl.DoHeaderDrawQueryElements(PaintInfo, RequestedElements); + end; + + if ShowRightBorder or (AColumn < Count - 1) then + RightBorderFlag := BF_RIGHT + else + RightBorderFlag := 0; + + if hpeBackground in RequestedElements then + TreeViewControl.DoAdvancedHeaderDraw(PaintInfo, [hpeBackground]) + else + begin + if (tsUseThemes in TreeViewControl.TreeStates) or (TreeViewControl.VclStyleEnabled and (seClient in TreeViewControl.StyleElements)) then + begin + if IsDownIndex then + Details := StyleServices.GetElementDetails(thHeaderItemPressed) + else + if IsHoverIndex then + Details := StyleServices.GetElementDetails(thHeaderItemHot) + else + Details := StyleServices.GetElementDetails(thHeaderItemNormal); + StyleServices.DrawElement(TargetCanvas.Handle, Details, PaintRectangle, @PaintRectangle{$IF CompilerVersion >= 34}, TreeViewControl.CurrentPPI{$IFEND}); + {$IF CompilerVersion >= 34} + if TreeViewControl.CurrentPPI >= 144 then // Fixes issue #1172 + begin + PaintRectangle.Right := PaintRectangle.Right - 1; // For screens with scaled at 150% or more use a splitter with two pixels width + StyleServices.DrawElement(TargetCanvas.Handle, Details, PaintRectangle, @PaintRectangle, TreeViewControl.CurrentPPI); + end; + {$IFEND} + end + else + begin // Windows classic mode + if IsDownIndex then + DrawEdge(TargetCanvas.Handle, PaintRectangle, PressedButtonStyle, PressedButtonFlags) + else + // Plates have the special case of raising on mouse over. + if (Header.Style = hsPlates) and IsHoverIndex and + (coAllowClick in FOptions) and (coEnabled in FOptions) then + DrawEdge(TargetCanvas.Handle, PaintRectangle, RaisedButtonStyle, + RaisedButtonFlags or RightBorderFlag) + else + DrawEdge(TargetCanvas.Handle, PaintRectangle, NormalButtonStyle, + NormalButtonFlags or RightBorderFlag); + end; + end; + + PaintRectangle := ATargetRect; + + // calculate text and glyph position + InflateRect(PaintRectangle, - cMargin, - cMargin); + DrawFormat := DT_TOP or DT_NOPREFIX; + case CaptionAlignment of + taLeftJustify : + DrawFormat := DrawFormat or DT_LEFT; + taRightJustify : + DrawFormat := DrawFormat or DT_RIGHT; + taCenter : + DrawFormat := DrawFormat or DT_CENTER; + end; + if UseRightToLeftReading then + DrawFormat := DrawFormat + DT_RTLREADING; + ComputeHeaderLayout(PaintInfo, DrawFormat); + + // Move glyph and text one pixel to the right and down to simulate a pressed button. + if IsDownIndex then + begin + OffsetRect(TextRectangle, cDownOffset, cDownOffset); + Inc(GlyphPos.X); + Inc(GlyphPos.Y); + Inc(SortGlyphPos.X); + Inc(SortGlyphPos.Y); + end; + + // Advanced owner draw allows to paint elements, which would normally not be painted (because of space + // limitations, empty captions etc.). + ActualElements := RequestedElements * [hpeHeaderGlyph, hpeSortGlyph, hpeDropMark, hpeText, hpeOverlay]; + + // main glyph + FHasImage := False; + if Assigned(Images) then + ImageWidth := Images.Width + else + ImageWidth := 0; + + if not (hpeHeaderGlyph in ActualElements) and ShowHeaderGlyph and + (not ShowSortGlyph or (FBiDiMode <> bdLeftToRight) or (GlyphPos.X + ImageWidth <= SortGlyphPos.X)) then + begin + if not FCheckBox then + begin + ColImageInfo.Images := Images; + Images.Draw(TargetCanvas, GlyphPos.X, GlyphPos.Y, FImageIndex, IsEnabled); + end + else + begin + with TreeViewControl do + begin + ColImageInfo.Images := CheckImages; + ColImageInfo.Index := GetCheckImage(nil, FCheckType, FCheckState, IsEnabled); + ColImageInfo.XPos := GlyphPos.X; + ColImageInfo.YPos := GlyphPos.Y; + PaintCheckImage(TargetCanvas, ColImageInfo, False); + end; + end; + + FHasImage := True; + FImageRect.Left := GlyphPos.X; + FImageRect.Top := GlyphPos.Y; + FImageRect.Right := FImageRect.Left + ColImageInfo.Images.Width; + FImageRect.Bottom := FImageRect.Top + ColImageInfo.Images.Height; + end; + + // caption + if WrapCaption then + ColCaptionText := FCaptionText + else + ColCaptionText := Text; + if IsHoverIndex and TreeViewControl.VclStyleEnabled then + DrawHot := True + else + DrawHot := (IsHoverIndex and (hoHotTrack in Header.Options) and not (tsUseThemes in TreeViewControl.TreeStates)); + if not (hpeText in ActualElements) and (Length(Text) > 0) then + DrawButtonText(TargetCanvas.Handle, ColCaptionText, TextRectangle, IsEnabled, DrawHot, DrawFormat, WrapCaption); + + // sort glyph + if not (hpeSortGlyph in ActualElements) and ShowSortGlyph then + begin + if tsUseExplorerTheme in TreeViewControl.TreeStates then + begin + Pos.TopLeft := SortGlyphPos; + Pos.Right := Pos.Left + SortGlyphSize.cx; + Pos.Bottom := Pos.Top + SortGlyphSize.cy; + if Header.SortDirection = sdAscending then + Glyph := thHeaderSortArrowSortedUp + else + Glyph := thHeaderSortArrowSortedDown; + Details := StyleServices.GetElementDetails(Glyph); + if not StyleServices.DrawElement(TargetCanvas.Handle, Details, Pos, @Pos {$IF CompilerVersion >= 34}, TreeViewControl.CurrentPPI {$IFEND}) then + PaintInfo.DrawSortArrow(Header.SortDirection); + end + else + begin + PaintInfo.DrawSortArrow(Header.SortDirection); + end; + end; + + // Show an indication if this column is the current drop target in a header drag operation. + if not (hpeDropMark in ActualElements) and (DropMark <> dmmNone) then + begin + PaintInfo.DrawDropMark(); + end; + + if ActualElements <> [] then + begin + SavedDC := SaveDC(TargetCanvas.Handle); + TreeViewControl.DoAdvancedHeaderDraw(PaintInfo, ActualElements); + RestoreDC(TargetCanvas.Handle, SavedDC); + end; + end + else // Let application draw the header. + TreeViewControl.DoHeaderDraw(TargetCanvas, Items[AColumn], PaintRectangle, IsHoverIndex, IsDownIndex, + DropMark); + end; + end; + + //--------------- end local functions --------------------------------------- + +var + TargetRect : TRect; + MaxX : TDimension; + Count: Integer; + EndCol: TColumnIndex; +begin + if IsRectEmpty(R) then + Exit; + + // If both draw posibillities are specified then prefer the advanced way. + AdvancedOwnerDraw := (hoOwnerDraw in Header.Options) and Assigned(TreeViewControl.OnAdvancedHeaderDraw) and + Assigned(TreeViewControl.OnHeaderDrawQueryElements) and not (csDesigning in TreeViewControl.ComponentState); + OwnerDraw := (hoOwnerDraw in Header.Options) and Assigned(TreeViewControl.OnHeaderDraw) and + not (csDesigning in TreeViewControl.ComponentState) and not AdvancedOwnerDraw; + + ZeroMemory(@PaintInfo, SizeOf(PaintInfo)); + PaintInfo.TargetCanvas := TargetCanvas; + + with PaintInfo, TargetCanvas do + begin + // Use shortcuts for the images and the font. + Images := Header.Images; + Font := Header.Font; + + PrepareButtonStyles; + + // At first, query the application which parts of the header it wants to draw on its own. + RequestedElements := []; + if AdvancedOwnerDraw then + begin + PaintRectangle := R; + Column := nil; + TreeViewControl.DoHeaderDrawQueryElements(PaintInfo, RequestedElements); + end; + + // Draw the background. + DrawBackground; + + // Now that we have drawn the background, we apply the header's dimensions to R. + R := Rect(Max(R.Left, 0), Max(R.Top, 0), Min(R.Right, TotalWidth), Min(R.Bottom, Header.Height)); + + // Determine where to stop. + MaxX := Target.X + R.Right - R.Left + //Fixes issues #544, #427 -- MaxX should also shift on BidiMode bdRightToLeft + + RTLOffset; //added for fix + + // Determine the start column. + Run := ColumnFromPosition(Point(R.Left + RTLOffset, 0), False); + if Run <= NoColumn then + Exit; + + TargetRect.Top := Target.Y; + TargetRect.Bottom := Target.Y + R.Bottom - R.Top; + TargetRect.Left := Target.X - R.Left + Items[Run].FLeft + RTLOffset; + // TargetRect.Right will be set in the loop + + ShowRightBorder := (Header.Style = hsThickButtons) or not (hoAutoResize in Header.Options) or (TreeViewControl.BevelKind = TBevelKind.bkNone); + + // Now go for each button. + while (Run > NoColumn) and (TargetRect.Left < MaxX) do + begin + + //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, + Min(TargetRect.Right, MaxX), TargetRect.Bottom)); + + PaintColumnHeader(Run, TargetRect); + + SelectClipRgn(Handle, 0); + + TargetRect.Left := TargetRect.Right; + + Run := EndCol; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualTreeColumns.SaveToStream(const Stream : TStream); + +var + I : Integer; + +begin + I := Count; + Stream.WriteBuffer(I, SizeOf(I)); + if I > 0 then + begin + for I := 0 to Count - 1 do + TVirtualTreeColumn(Items[I]).SaveToStream(Stream); + + Stream.WriteBuffer(FPositionToIndex[0], Count * SizeOf(TColumnIndex)); + end; + + // Data introduced with header stream version 5. + Stream.WriteBuffer(DefaultWidth, SizeOf(DefaultWidth)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualTreeColumns.TotalWidth : TDimension; + +var + LastColumn : TColumnIndex; + +begin + Result := 0; + if (Count > 0) and (Length(FPositionToIndex) > 0) then + begin + LastColumn := FPositionToIndex[Count - 1]; + if not (coVisible in Items[LastColumn].Options) then + LastColumn := GetPreviousVisibleColumn(LastColumn); + if LastColumn > NoColumn then + with Items[LastColumn] do + Result := FLeft + FWidth; + end; +end; + +{ THeaderPaintInfo } + +procedure THeaderPaintInfo.DrawDropMark(); +var + Y : TDimension; + lArrowWidth : TDimension; +begin + lArrowWidth := TBaseVirtualTreeCracker(Self.Column.TreeViewControl).ScaledPixels(5); + Y := Divide(PaintRectangle.Top + PaintRectangle.Bottom - 3 * lArrowWidth, 2); + if DropMark = dmmLeft then + DrawArrow(TargetCanvas, TScrollDirection.sdLeft, Point(PaintRectangle.Left, Y), lArrowWidth) + else + DrawArrow(TargetCanvas, TScrollDirection.sdRight, Point(PaintRectangle.Right - lArrowWidth - Divide(lArrowWidth, 2) {spacing}, Y), lArrowWidth); +end; + +procedure THeaderPaintInfo.DrawSortArrow(pDirection : TSortDirection); +const + cDirection : array [TSortDirection] of TScrollDirection = (TScrollDirection.sdUp, TScrollDirection.sdDown); +var + lOldColor : TColor; +begin + lOldColor := TargetCanvas.Pen.Color; + TargetCanvas.Pen.Color := clDkGray; + DrawArrow(TargetCanvas, cDirection[pDirection], Point(SortGlyphPos.X, SortGlyphPos.Y), SortGlyphSize.cy); + TargetCanvas.Pen.Color := lOldColor; +end; + +{ TVirtualTreeColumnHelper } + +function TVirtualTreeColumnHelper.Header : TVTHeader; +begin + Result := Owner.Header; +end; + +function TVirtualTreeColumnHelper.TreeViewControl : TBaseVirtualTreeCracker; +begin + Result := TBaseVirtualTreeCracker(Owner.Header.GetOwner); +end; + +{ TVirtualTreeColumnsHelper } + +function TVirtualTreeColumnsHelper.TreeViewControl : TBaseVirtualTreeCracker; +begin + Result := TBaseVirtualTreeCracker(Header.GetOwner); +end; + + +end. diff --git a/Source/VirtualTrees.HeaderPopup.pas b/Source/VirtualTrees.HeaderPopup.pas index 2499b4e82..351cbcec8 100644 --- a/Source/VirtualTrees.HeaderPopup.pas +++ b/Source/VirtualTrees.HeaderPopup.pas @@ -1,4 +1,4 @@ -unit VirtualTrees.HeaderPopup; +unit VirtualTrees.HeaderPopup; //---------------------------------------------------------------------------------------------------------------------- // @@ -68,7 +68,8 @@ interface uses System.Classes, Vcl.Menus, - VirtualTrees; + VirtualTrees.Types, + VirtualTrees.BaseTree; type TVTHeaderPopupOption = ( @@ -78,7 +79,7 @@ interface ); TVTHeaderPopupOptions = set of TVTHeaderPopupOption; - TColumnChangeEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex; Visible: Boolean) of object; + TColumnChangeEvent = procedure(const Sender: TObject; const Column: TColumnIndex; Visible: Boolean) of object; TVTHeaderPopupMenu = class(TPopupMenu) strict private @@ -91,10 +92,10 @@ TVTHeaderPopupMenu = class(TPopupMenu) strict protected procedure DoAddHeaderPopupItem(const Column: TColumnIndex; out Cmd: TAddPopupItemType); virtual; procedure DoColumnChange(Column: TColumnIndex; Visible: Boolean); virtual; - procedure OnMenuItemClick(Sender: TObject); + procedure OnMenuItemClick(Sender: TObject); virtual; public constructor Create(AOwner: TComponent); override; - procedure Popup(x, y: Integer); override; + procedure Popup(x, y: TDimension); override; published property Options: TVTHeaderPopupOptions read FOptions write FOptions default [poResizeToFitItem]; @@ -107,7 +108,9 @@ TVTHeaderPopupMenu = class(TPopupMenu) implementation uses - Winapi.Windows, System.Types; + Winapi.Windows, + System.Types, + VirtualTrees.Header; resourcestring sResizeColumnToFit = 'Size &Column to Fit'; @@ -156,13 +159,14 @@ procedure TVTHeaderPopupMenu.OnMenuItemClick(Sender: TObject); Options := Options - [coVisible] else Options := Options + [coVisible]; + DoColumnChange(TVTMenuItem(Sender).Tag, coVisible in Options); end; end; end; //---------------------------------------------------------------------------------------------------------------------- -procedure TVTHeaderPopupMenu.Popup(x, y: Integer); +procedure TVTHeaderPopupMenu.Popup(x, y: TDimension); var ColPos: TColumnPosition; ColIdx: TColumnIndex; @@ -211,7 +215,7 @@ procedure TVTHeaderPopupMenu.Popup(x, y: Integer); with Columns[ColIdx] do begin if coVisible in Options then - Inc(VisibleCounter); + System.Inc(VisibleCounter); DoAddHeaderPopupItem(ColIdx, Cmd); if Cmd <> apHidden then begin @@ -269,4 +273,3 @@ constructor TVTMenuItem.Create(AOwner: TComponent; const ACaption: string; AClic end; end. - diff --git a/Source/VirtualTrees.StyleHooks.pas b/Source/VirtualTrees.StyleHooks.pas index e47bc47d6..0f9bbd52e 100644 --- a/Source/VirtualTrees.StyleHooks.pas +++ b/Source/VirtualTrees.StyleHooks.pas @@ -1,937 +1,1092 @@ -unit VirtualTrees.StyleHooks; - -// The contents of this file are subject to the Mozilla Public License -// Version 1.1 (the "License"); you may not use this file except in compliance -// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ -// -// Alternatively, you may redistribute this library, use and/or modify it under the terms of the -// GNU Lesser General Public License as published by the Free Software Foundation; -// either version 2.1 of the License, or (at your option) any later version. -// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/. -// -// Software distributed under the License is distributed on an "AS IS" basis, -// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the -// specific language governing rights and limitations under the License. -// -// The original code is VirtualTrees.pas, released September 30, 2000. -// -// The initial developer of the original code is digital publishing AG (Munich, Germany, www.digitalpublishing.de), -// written by Mike Lischke (public@soft-gems.net, www.soft-gems.net). -// -// Portions created by digital publishing AG are Copyright -// (C) 1999-2001 digital publishing AG. All Rights Reserved. -//---------------------------------------------------------------------------------------------------------------------- - - -interface - -{$WARN UNSAFE_TYPE OFF} -{$WARN UNSAFE_CAST OFF} -{$WARN UNSAFE_CODE OFF} - -uses - Winapi.Windows, - Winapi.Messages, - Winapi.UxTheme, - - System.Classes, - Vcl.Themes, - Vcl.Forms, - Vcl.Controls; - -const - CM_UPDATE_VCLSTYLE_SCROLLBARS = CM_BASE + 2050; - -type - // XE2+ VCL Style - TVclStyleScrollBarsHook = class(TScrollingStyleHook) - strict private type - {$REGION 'TVclStyleScrollBarWindow'} - TVclStyleScrollBarWindow = class(TWinControl) - strict private - FScrollBarWindowOwner: TVclStyleScrollBarsHook; - FScrollBarVertical: Boolean; - procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST; - procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND; - procedure WMPaint(var Msg: TWMPaint); message WM_PAINT; - public - constructor Create(AOwner: TComponent); override; - property ScrollBarWindowOwner: TVclStyleScrollBarsHook read FScrollBarWindowOwner write FScrollBarWindowOwner; - property ScrollBarVertical: Boolean read FScrollBarVertical write FScrollBarVertical; - end; - {$ENDREGION} - private - FHorzScrollBarWindow: TVclStyleScrollBarWindow; - FLeftMouseButtonDown: Boolean; - FVertScrollBarWindow: TVclStyleScrollBarWindow; - - function NCMousePosToClient(const P: TPoint): TPoint; - - procedure CMUpdateVclStyleScrollbars(var Msg: TMessage); message CM_UPDATE_VCLSTYLE_SCROLLBARS; - procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; - procedure WMKeyDown(var Msg: TMessage); message WM_KEYDOWN; - procedure WMKeyUp(var Msg: TMessage); message WM_KEYUP; - procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN; - procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP; - procedure WMNCLButtonDown(var Msg: TWMMouse); message WM_NCLBUTTONDOWN; - procedure WMNCMouseMove(var Msg: TWMMouse); message WM_NCMOUSEMOVE; - procedure WMNCLButtonUp(var Msg: TWMMouse); message WM_NCLBUTTONUP; - procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT; - procedure WMMouseMove(var Msg: TWMMouse); message WM_MOUSEMOVE; - procedure WMMouseWheel(var Msg: TMessage); message WM_MOUSEWHEEL; - procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL; - procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL; - procedure WMCaptureChanged(var Msg: TMessage); message WM_CAPTURECHANGED; - procedure WMNCLButtonDblClk(var Msg: TWMMouse); message WM_NCLBUTTONDBLCLK; - procedure WMSize(var Msg: TMessage); message WM_SIZE; - procedure WMMove(var Msg: TMessage); message WM_MOVE; - procedure WMPosChanged(var Msg: TMessage); message WM_WINDOWPOSCHANGED; - protected - procedure CalcScrollBarsRect; virtual; - procedure DrawHorzScrollBar(DC: HDC); virtual; - procedure DrawVertScrollBar(DC: HDC); virtual; - procedure MouseLeave; override; - procedure PaintScroll; override; - function PointInTreeHeader(const P: TPoint): Boolean; - procedure UpdateScrollBarWindow; - public - constructor Create(AControl: TWinControl); override; - destructor Destroy; override; - property HorzScrollRect; - property VertScrollRect; - end; - -implementation - -uses - System.SysUtils, - System.Math, - System.Types, - Vcl.Graphics, - VirtualTrees; - -type - TBaseVirtualTreeCracker = class(TBaseVirtualTree) - end; - - -// XE2+ VCL Style -{ TVclStyleScrollBarsHook } - -procedure TVclStyleScrollBarsHook.CalcScrollBarsRect; - - procedure CalcVerticalRects; - var - BarInfo: TScrollBarInfo; - Ret: BOOL; - begin - BarInfo.cbSize := SizeOf(BarInfo); - Ret := GetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), BarInfo); - FVertScrollBarWindow.Visible := (seBorder in Control.StyleElements) and Ret and (not (STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0)); - FVertScrollBarWindow.Enabled := FVertScrollBarWindow.Visible and (not (STATE_SYSTEM_UNAVAILABLE and BarInfo.rgstate[0] <> 0)); - end; - - procedure CalcHorizontalRects; - var - BarInfo: TScrollBarInfo; - Ret: BOOL; - begin - BarInfo.cbSize := SizeOf(BarInfo); - Ret := GetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), BarInfo); - FHorzScrollBarWindow.Visible := (seBorder in Control.StyleElements) and Ret and (not (STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0)); - FHorzScrollBarWindow.Enabled := FHorzScrollBarWindow.Visible and (not (STATE_SYSTEM_UNAVAILABLE and BarInfo.rgstate[0] <> 0)); - end; - -begin - CalcVerticalRects; - CalcHorizontalRects; -end; - -constructor TVclStyleScrollBarsHook.Create(AControl: TWinControl); -begin - inherited; - FVertScrollBarWindow := TVclStyleScrollBarWindow.CreateParented(GetParent(Control.Handle)); - FVertScrollBarWindow.ScrollBarWindowOwner := Self; - FVertScrollBarWindow.ScrollBarVertical := True; - - FHorzScrollBarWindow := TVclStyleScrollBarWindow.CreateParented(GetParent(Control.Handle)); - FHorzScrollBarWindow.ScrollBarWindowOwner := Self; - - VertSliderState := tsThumbBtnVertNormal; - VertUpState := tsArrowBtnUpNormal; - VertDownState := tsArrowBtnDownNormal; - HorzSliderState := tsThumbBtnHorzNormal; - HorzUpState := tsArrowBtnLeftNormal; - HorzDownState := tsArrowBtnRightNormal; -end; - -destructor TVclStyleScrollBarsHook.Destroy; -begin - FVertScrollBarWindow.ScrollBarWindowOwner := nil; - FreeAndNil(FVertScrollBarWindow); - FHorzScrollBarWindow.ScrollBarWindowOwner := nil; - FreeAndNil(FHorzScrollBarWindow); - inherited; -end; - -procedure TVclStyleScrollBarsHook.DrawHorzScrollBar(DC: HDC); -var - B: TBitmap; - Details: TThemedElementDetails; - R: TRect; -begin - if ((Handle = 0) or (DC = 0)) then - Exit; - - if FHorzScrollBarWindow.Visible and StyleServices.Available and (seBorder in Control.StyleElements) then - begin - B := TBitmap.Create; - try - R := HorzScrollRect; - B.Width := R.Width; - B.Height := R.Height; - MoveWindowOrg(B.Canvas.Handle, -R.Left, -R.Top); - - R.Left := HorzUpButtonRect.Right; - R.Right := HorzDownButtonRect.Left; - Details := StyleServices.GetElementDetails(tsUpperTrackHorzNormal); - StyleServices.DrawElement(B.Canvas.Handle, Details, R); - - if FHorzScrollBarWindow.Enabled then - Details := StyleServices.GetElementDetails(HorzSliderState); - StyleServices.DrawElement(B.Canvas.Handle, Details, HorzSliderRect); - - if FHorzScrollBarWindow.Enabled then - Details := StyleServices.GetElementDetails(HorzUpState) - else - Details := StyleServices.GetElementDetails(tsArrowBtnLeftDisabled); - StyleServices.DrawElement(B.Canvas.Handle, Details, HorzUpButtonRect); - - if FHorzScrollBarWindow.Enabled then - Details := StyleServices.GetElementDetails(HorzDownState) - else - Details := StyleServices.GetElementDetails(tsArrowBtnRightDisabled); - StyleServices.DrawElement(B.Canvas.Handle, Details, HorzDownButtonRect); - - R := HorzScrollRect; - MoveWindowOrg(B.Canvas.Handle, R.Left, R.Top); - BitBlt(DC, R.Left, R.Top, B.Width, B.Height, B.Canvas.Handle, 0, 0, SRCCOPY); - finally - B.Free; - end; - end; -end; - -procedure TVclStyleScrollBarsHook.DrawVertScrollBar(DC: HDC); -var - B: TBitmap; - Details: TThemedElementDetails; - R: TRect; -begin - if ((Handle = 0) or (DC = 0)) then - Exit; - - if FVertScrollBarWindow.Visible and StyleServices.Available and (seBorder in Control.StyleElements) then - begin - B := TBitmap.Create; - try - R := VertScrollRect; - B.Width := R.Width; - B.Height := FVertScrollBarWindow.Height; // <> R.Height - MoveWindowOrg(B.Canvas.Handle, -R.Left, -R.Top); - - R.Bottom := B.Height + R.Top; - Details := StyleServices.GetElementDetails(tsUpperTrackVertNormal); - StyleServices.DrawElement(B.Canvas.Handle, Details, R); - - R.Top := VertUpButtonRect.Bottom; - R.Bottom := VertDownButtonRect.Top; - Details := StyleServices.GetElementDetails(tsUpperTrackVertNormal); - StyleServices.DrawElement(B.Canvas.Handle, Details, R); - - if FVertScrollBarWindow.Enabled then - Details := StyleServices.GetElementDetails(VertSliderState); - StyleServices.DrawElement(B.Canvas.Handle, Details, VertSliderRect); - - if FVertScrollBarWindow.Enabled then - Details := StyleServices.GetElementDetails(VertUpState) - else - Details := StyleServices.GetElementDetails(tsArrowBtnUpDisabled); - StyleServices.DrawElement(B.Canvas.Handle, Details, VertUpButtonRect); - - if FVertScrollBarWindow.Enabled then - Details := StyleServices.GetElementDetails(VertDownState) - else - Details := StyleServices.GetElementDetails(tsArrowBtnDownDisabled); - StyleServices.DrawElement(B.Canvas.Handle, Details, VertDownButtonRect); - - R := VertScrollRect; - MoveWindowOrg(B.Canvas.Handle, R.Left, R.Top); - BitBlt(DC, R.Left, R.Top, B.Width, B.Height, B.Canvas.Handle, 0, 0, SRCCOPY); - finally - B.Free; - end; - end; -end; - -procedure TVclStyleScrollBarsHook.MouseLeave; -begin - inherited; - if VertSliderState = tsThumbBtnVertHot then - VertSliderState := tsThumbBtnVertNormal; - - if HorzSliderState = tsThumbBtnHorzHot then - HorzSliderState := tsThumbBtnHorzNormal; - - if VertUpState = tsArrowBtnUpHot then - VertUpState := tsArrowBtnUpNormal; - - if VertDownState = tsArrowBtnDownHot then - VertDownState := tsArrowBtnDownNormal; - - if HorzUpState = tsArrowBtnLeftHot then - HorzUpState := tsArrowBtnLeftNormal; - - if HorzDownState = tsArrowBtnRightHot then - HorzDownState := tsArrowBtnRightNormal; - - PaintScroll; -end; - -function TVclStyleScrollBarsHook.NCMousePosToClient(const P: TPoint): TPoint; -begin - Result := P; - ScreenToClient(Handle, Result); - if HasBorder then - begin - if HasClientEdge then - Result.Offset(2, 2) - else - Result.Offset(1, 1); - end; -end; - -procedure TVclStyleScrollBarsHook.PaintScroll; -begin - if FVertScrollBarWindow.HandleAllocated then - begin - FVertScrollBarWindow.Repaint; - RedrawWindow(FVertScrollBarWindow.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698 - end; - if FHorzScrollBarWindow.HandleAllocated then - begin - FHorzScrollBarWindow.Repaint; - RedrawWindow(FHorzScrollBarWindow.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698 - end; -end; - -function TVclStyleScrollBarsHook.PointInTreeHeader(const P: TPoint): Boolean; -begin - Result := TBaseVirtualTree(Control).Header.InHeader(P); -end; - -procedure TVclStyleScrollBarsHook.UpdateScrollBarWindow; -var - R: TRect; - HeaderHeight: Integer; - PaddingSize: Integer; - BorderSize: Integer; -begin - // ScrollBarWindow Visible/Enabled Control - CalcScrollBarsRect; - - HeaderHeight := 0; - if (hoVisible in TBaseVirtualTree(Control).Header.Options) then - Inc(HeaderHeight, TBaseVirtualTree(Control).Header.Height); - - PaddingSize := TBaseVirtualTreeCracker(Control).BorderWidth; - if TBaseVirtualTreeCracker(Control).BevelKind <> bkNone then - begin - if TBaseVirtualTreeCracker(Control).BevelInner <> bvNone then - Inc(PaddingSize, TBaseVirtualTreeCracker(Control).BevelWidth); - if TBaseVirtualTreeCracker(Control).BevelOuter <> bvNone then - Inc(PaddingSize, TBaseVirtualTreeCracker(Control).BevelWidth); - end; - - BorderSize := 0; - if HasBorder then - Inc(BorderSize, GetSystemMetrics(SM_CYEDGE)); - - // VertScrollBarWindow - if FVertScrollBarWindow.Visible then - begin - R := VertScrollRect; - if Control.UseRightToLeftScrollBar then - OffsetRect(R, -R.Left + BorderSize, 0); - - ShowWindow(FVertScrollBarWindow.Handle, SW_SHOW); - SetWindowPos(FVertScrollBarWindow.Handle, HWND_TOP, - Control.Left + R.Left + PaddingSize, - Control.Top + R.Top + HeaderHeight + PaddingSize, - R.Width, - Control.Height - HeaderHeight - ((PaddingSize + BorderSize) * 2), // <> R.Height - SWP_SHOWWINDOW); - end else - ShowWindow(FVertScrollBarWindow.Handle, SW_HIDE); - - // HorzScrollBarWindow - if FHorzScrollBarWindow.Visible then - begin - R := HorzScrollRect; - if Control.UseRightToLeftScrollBar then - OffsetRect(R, VertScrollRect.Width, 0); - - ShowWindow(FHorzScrollBarWindow.Handle, SW_SHOW); - SetWindowPos(FHorzScrollBarWindow.Handle, HWND_TOP, - Control.Left + R.Left + PaddingSize, - Control.Top + R.Top + HeaderHeight + PaddingSize, - R.Width, R.Height, SWP_SHOWWINDOW); - end else - ShowWindow(FHorzScrollBarWindow.Handle, SW_HIDE); -end; - -procedure TVclStyleScrollBarsHook.WMCaptureChanged(var Msg: TMessage); -begin - if FVertScrollBarWindow.Visible and FVertScrollBarWindow.Enabled then - begin - if VertUpState = tsArrowBtnUpPressed then - begin - VertUpState := tsArrowBtnUpNormal; - PaintScroll; - end; - - if VertDownState = tsArrowBtnDownPressed then - begin - VertDownState := tsArrowBtnDownNormal; - PaintScroll; - end; - end; - - if FHorzScrollBarWindow.Visible and FHorzScrollBarWindow.Enabled then - begin - if HorzUpState = tsArrowBtnLeftPressed then - begin - HorzUpState := tsArrowBtnLeftNormal; - PaintScroll; - end; - - if HorzDownState = tsArrowBtnRightPressed then - begin - HorzDownState := tsArrowBtnRightNormal; - PaintScroll; - end; - end; - - CallDefaultProc(TMessage(Msg)); - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.WMEraseBkgnd(var Msg: TWMEraseBkgnd); -begin - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.WMHScroll(var Msg: TWMHScroll); -begin - CallDefaultProc(TMessage(Msg)); - if not (Msg.ScrollCode in [SB_THUMBTRACK, SB_THUMBPOSITION]) then - UpdateScrollBarWindow - else - PaintScroll; - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.CMUpdateVclStyleScrollbars(var Msg: TMessage); -begin - CalcScrollBarsRect; - PaintScroll; -end; - -procedure TVclStyleScrollBarsHook.WMKeyDown(var Msg: TMessage); -begin - CallDefaultProc(TMessage(Msg)); - UpdateScrollBarWindow; - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.WMKeyUp(var Msg: TMessage); -begin - CallDefaultProc(TMessage(Msg)); - PaintScroll; - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.WMLButtonDown(var Msg: TWMMouse); -begin - CallDefaultProc(TMessage(Msg)); - UpdateScrollBarWindow; - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.WMLButtonUp(var Msg: TWMMouse); -var - P: TPoint; -begin - P := Point(Msg.XPos, Msg.YPos); - ScreenToClient(Handle, P); - if not PointInTreeHeader(P) then - begin - if FVertScrollBarWindow.Visible then - begin - if VertSliderState = tsThumbBtnVertPressed then - begin - PostMessage(Handle, WM_VSCROLL, Integer(SmallPoint(SB_ENDSCROLL, 0)), 0); - FLeftMouseButtonDown := False; - VertSliderState := tsThumbBtnVertNormal; - PaintScroll; - Handled := True; - Mouse.Capture := 0; - Exit; - end else - if VertUpState = tsArrowBtnUpPressed then - VertUpState := tsArrowBtnUpNormal - else if VertDownState = tsArrowBtnDownPressed then - VertDownState := tsArrowBtnDownNormal; - end; - - if FHorzScrollBarWindow.Visible then - begin - if HorzSliderState = tsThumbBtnHorzPressed then - begin - PostMessage(Handle, WM_HSCROLL, Integer(SmallPoint(SB_ENDSCROLL, 0)), 0); - FLeftMouseButtonDown := False; - HorzSliderState := tsThumbBtnHorzNormal; - PaintScroll; - Handled := True; - Mouse.Capture := 0; - Exit; - end else - if HorzUpState = tsArrowBtnLeftPressed then - HorzUpState := tsArrowBtnLeftNormal - else if HorzDownState = tsArrowBtnRightPressed then - HorzDownState := tsArrowBtnRightNormal; - end; - PaintScroll; - end; - FLeftMouseButtonDown := False; -end; - -procedure TVclStyleScrollBarsHook.WMMouseMove(var Msg: TWMMouse); -var - SF: TScrollInfo; - OverrideMax: Integer; -begin - if VertSliderState = tsThumbBtnVertPressed then - begin - SF.fMask := SIF_ALL; - SF.cbSize := SizeOf(SF); - GetScrollInfo(Handle, SB_VERT, SF); - - OverrideMax := SF.nMax; - if 0 < SF.nPage then - OverrideMax := SF.nMax - Integer(SF.nPage) + 1; - ScrollPos := System.Math.EnsureRange(ListPos + (OverrideMax - SF.nMin) * ((Mouse.CursorPos.Y - PrevScrollPos) / (VertTrackRect.Height - VertSliderRect.Height)), - SF.nMin, OverrideMax); - SF.fMask := SIF_POS; - SF.nPos := Round(ScrollPos); - SetScrollInfo(Handle, SB_VERT, SF, False); - PostMessage(Handle, WM_VSCROLL, Integer(SmallPoint(SB_THUMBPOSITION, Min(SF.nPos, High(SmallInt)))), 0); - - PaintScroll; - Handled := True; - Exit; - end else - if VertSliderState = tsThumbBtnVertHot then - begin - VertSliderState := tsThumbBtnVertNormal; - PaintScroll; - end; - - if HorzSliderState = tsThumbBtnHorzPressed then - begin - SF.fMask := SIF_ALL; - SF.cbSize := SizeOf(SF); - GetScrollInfo(Handle, SB_HORZ, SF); - - OverrideMax := SF.nMax; - if 0 < SF.nPage then - OverrideMax := SF.nMax - Integer(SF.nPage) + 1; - ScrollPos := System.Math.EnsureRange(ListPos + (OverrideMax - SF.nMin) * ((Mouse.CursorPos.X - PrevScrollPos) / (HorzTrackRect.Width - HorzSliderRect.Width)), - SF.nMin, OverrideMax); - SF.fMask := SIF_POS; - SF.nPos := Round(ScrollPos); - SetScrollInfo(Handle, SB_HORZ, SF, False); - PostMessage(Handle, WM_HSCROLL, Integer(SmallPoint(SB_THUMBPOSITION, Min(SF.nPos, High(SmallInt)))), 0); - - PaintScroll; - Handled := True; - Exit; - end else - if HorzSliderState = tsThumbBtnHorzHot then - begin - HorzSliderState := tsThumbBtnHorzNormal; - PaintScroll; - end; - - if (HorzUpState <> tsArrowBtnLeftPressed) and (HorzUpState = tsArrowBtnLeftHot) then - begin - HorzUpState := tsArrowBtnLeftNormal; - PaintScroll; - end; - - if (HorzDownState <> tsArrowBtnRightPressed) and (HorzDownState = tsArrowBtnRightHot) then - begin - HorzDownState := tsArrowBtnRightNormal; - PaintScroll; - end; - - if (VertUpState <> tsArrowBtnUpPressed) and (VertUpState = tsArrowBtnUpHot) then - begin - VertUpState := tsArrowBtnUpNormal; - PaintScroll; - end; - - if (VertDownState <> tsArrowBtnDownPressed) and (VertDownState = tsArrowBtnDownHot) then - begin - VertDownState := tsArrowBtnDownNormal; - PaintScroll; - end; - - CallDefaultProc(TMessage(Msg)); - if FLeftMouseButtonDown then - PaintScroll; - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.WMMouseWheel(var Msg: TMessage); -begin - CallDefaultProc(TMessage(Msg)); - CalcScrollBarsRect; - PaintScroll; - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.WMNCLButtonDblClk(var Msg: TWMMouse); -begin - WMNCLButtonDown(Msg); -end; - -procedure TVclStyleScrollBarsHook.WMNCLButtonDown(var Msg: TWMMouse); -var - P: TPoint; - SF: TScrollInfo; -begin - P := NCMousePosToClient(Point(Msg.XPos, Msg.YPos)); - if not PointInTreeHeader(P) then - begin - if FVertScrollBarWindow.Visible and FVertScrollBarWindow.Enabled then - begin - if PtInRect(VertSliderRect, P) then - begin - FLeftMouseButtonDown := True; - SF.fMask := SIF_ALL; - SF.cbSize := SizeOf(SF); - GetScrollInfo(Handle, SB_VERT, SF); - ListPos := SF.nPos; - ScrollPos := SF.nPos; - PrevScrollPos := Mouse.CursorPos.Y; - VertSliderState := tsThumbBtnVertPressed; - PaintScroll; - Mouse.Capture := Handle; - Handled := True; - Exit; - end else - if PtInRect(VertDownButtonRect, P) then - VertDownState := tsArrowBtnDownPressed - else if PtInRect(VertUpButtonRect, P) then - VertUpState := tsArrowBtnUpPressed; - end; - - if FHorzScrollBarWindow.Visible and FHorzScrollBarWindow.Enabled then - begin - if PtInRect(HorzSliderRect, P) then - begin - FLeftMouseButtonDown := True; - SF.fMask := SIF_ALL; - SF.cbSize := SizeOf(SF); - GetScrollInfo(Handle, SB_HORZ, SF); - ListPos := SF.nPos; - ScrollPos := SF.nPos; - PrevScrollPos := Mouse.CursorPos.X; - HorzSliderState := tsThumbBtnHorzPressed; - PaintScroll; - Mouse.Capture := Handle; - Handled := True; - Exit; - end else - if PtInRect(HorzDownButtonRect, P) then - HorzDownState := tsArrowBtnRightPressed - else if PtInRect(HorzUpButtonRect, P) then - HorzUpState := tsArrowBtnLeftPressed; - end; - FLeftMouseButtonDown := True; - PaintScroll; - end; -end; - -procedure TVclStyleScrollBarsHook.WMNCLButtonUp(var Msg: TWMMouse); -var - P: TPoint; -begin - P := NCMousePosToClient(Point(Msg.XPos, Msg.YPos)); - if not PointInTreeHeader(P) then - begin - if FVertScrollBarWindow.Visible and FVertScrollBarWindow.Enabled then - begin - if VertSliderState = tsThumbBtnVertPressed then - begin - FLeftMouseButtonDown := False; - VertSliderState := tsThumbBtnVertNormal; - PaintScroll; - Handled := True; - Exit; - end; - - if PtInRect(VertDownButtonRect, P) then - VertDownState := tsArrowBtnDownHot - else - VertDownState := tsArrowBtnDownNormal; - - if PtInRect(VertUpButtonRect, P) then - VertUpState := tsArrowBtnUpHot - else - VertUpState := tsArrowBtnUpNormal; - end; - - if FHorzScrollBarWindow.Visible and FHorzScrollBarWindow.Enabled then - begin - if HorzSliderState = tsThumbBtnHorzPressed then - begin - FLeftMouseButtonDown := False; - HorzSliderState := tsThumbBtnHorzNormal; - PaintScroll; - Handled := True; - Exit; - end; - - if PtInRect(HorzDownButtonRect, P) then - HorzDownState := tsArrowBtnRightHot - else - HorzDownState := tsArrowBtnRightNormal; - - if PtInRect(HorzUpButtonRect, P) then - HorzUpState := tsArrowBtnLeftHot - else - HorzUpState := tsArrowBtnLeftNormal; - end; - - CallDefaultProc(TMessage(Msg)); - if (FHorzScrollBarWindow.Visible) or (FVertScrollBarWindow.Visible) then - PaintScroll; - end; - - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.WMNCMouseMove(var Msg: TWMMouse); -var - P: TPoint; - MustUpdateScroll: Boolean; - B: Boolean; -begin - inherited; - P := NCMousePosToClient(Point(Msg.XPos, Msg.YPos)); - if PointInTreeHeader(P) then - begin - CallDefaultProc(TMessage(Msg)); - PaintScroll; - Handled := True; - Exit; - end; - - MustUpdateScroll := False; - if FVertScrollBarWindow.Visible and FVertScrollBarWindow.Enabled then - begin - B := PtInRect(VertSliderRect, P); - if B and (VertSliderState = tsThumbBtnVertNormal) then - begin - VertSliderState := tsThumbBtnVertHot; - MustUpdateScroll := True; - end else - if not B and (VertSliderState = tsThumbBtnVertHot) then - begin - VertSliderState := tsThumbBtnVertNormal; - MustUpdateScroll := True; - end; - - B := PtInRect(VertDownButtonRect, P); - if B and (VertDownState = tsArrowBtnDownNormal) then - begin - VertDownState := tsArrowBtnDownHot; - MustUpdateScroll := True; - end else - if not B and (VertDownState = tsArrowBtnDownHot) then - begin - VertDownState := tsArrowBtnDownNormal; - MustUpdateScroll := True; - end; - - B := PtInRect(VertUpButtonRect, P); - if B and (VertUpState = tsArrowBtnUpNormal) then - begin - VertUpState := tsArrowBtnUpHot; - MustUpdateScroll := True; - end else - if not B and (VertUpState = tsArrowBtnUpHot) then - begin - VertUpState := tsArrowBtnUpNormal; - MustUpdateScroll := True; - end; - end; - - if FHorzScrollBarWindow.Visible and FHorzScrollBarWindow.Enabled then - begin - B := PtInRect(HorzSliderRect, P); - if B and (HorzSliderState = tsThumbBtnHorzNormal) then - begin - HorzSliderState := tsThumbBtnHorzHot; - MustUpdateScroll := True; - end else - if not B and (HorzSliderState = tsThumbBtnHorzHot) then - begin - HorzSliderState := tsThumbBtnHorzNormal; - MustUpdateScroll := True; - end; - - B := PtInRect(HorzDownButtonRect, P); - if B and (HorzDownState = tsArrowBtnRightNormal) then - begin - HorzDownState := tsArrowBtnRightHot; - MustUpdateScroll := True; - end else - if not B and (HorzDownState = tsArrowBtnRightHot) then - begin - HorzDownState := tsArrowBtnRightNormal; - MustUpdateScroll := True; - end; - - B := PtInRect(HorzUpButtonRect, P); - if B and (HorzUpState = tsArrowBtnLeftNormal) then - begin - HorzUpState := tsArrowBtnLeftHot; - MustUpdateScroll := True; - end else - if not B and (HorzUpState = tsArrowBtnLeftHot) then - begin - HorzUpState := tsArrowBtnLeftNormal; - MustUpdateScroll := True; - end; - end; - - if MustUpdateScroll then - PaintScroll; -end; - -procedure TVclStyleScrollBarsHook.WMNCPaint(var Msg: TMessage); -begin - //if (tsWindowCreating in TBaseVirtualTree(Control).TreeStates) then - // UpdateScrollBarWindow; - //inherited; -end; - -procedure TVclStyleScrollBarsHook.WMSize(var Msg: TMessage); -begin - CallDefaultProc(TMessage(Msg)); - UpdateScrollBarWindow; - PaintScroll; - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.WMMove(var Msg: TMessage); -begin - CallDefaultProc(TMessage(Msg)); - if not(tsWindowCreating in TBaseVirtualTree(Control).TreeStates) then - begin - UpdateScrollBarWindow; - PaintScroll; - end; - Handled := True; -end; - -procedure TVclStyleScrollBarsHook.WMPosChanged(var Msg: TMessage); -begin - WMMove(Msg); -end; - -procedure TVclStyleScrollBarsHook.WMVScroll(var Msg: TWMVScroll); -begin - CallDefaultProc(TMessage(Msg)); - if not (Msg.ScrollCode in [SB_THUMBTRACK, SB_THUMBPOSITION]) then - UpdateScrollBarWindow - else - PaintScroll; - Handled := True; -end; - -{ TVclStyleScrollBarsHook.TVclStyleScrollBarWindow } - -constructor TVclStyleScrollBarsHook.TVclStyleScrollBarWindow.Create(AOwner: TComponent); -begin - inherited; - ControlStyle := ControlStyle + [csOverrideStylePaint]; - FScrollBarWindowOwner := nil; - FScrollBarVertical := False; -end; - -procedure TVclStyleScrollBarsHook.TVclStyleScrollBarWindow.WMEraseBkgnd(var Msg: TMessage); -begin - Msg.Result := 1; -end; - -procedure TVclStyleScrollBarsHook.TVclStyleScrollBarWindow.WMNCHitTest(var Msg: TWMNCHitTest); -begin - Msg.Result := HTTRANSPARENT; -end; - -procedure TVclStyleScrollBarsHook.TVclStyleScrollBarWindow.WMPaint(var Msg: TWMPaint); -var - PS: TPaintStruct; - DC: HDC; - R: TRect; -begin - BeginPaint(Handle, PS); - try - if FScrollBarWindowOwner <> nil then - begin - DC := GetWindowDC(Handle); - try - if FScrollBarVertical then - begin - R := FScrollBarWindowOwner.VertScrollRect; - MoveWindowOrg(DC, -R.Left, -R.Top); - FScrollBarWindowOwner.DrawVertScrollBar(DC); - end else - begin - R := FScrollBarWindowOwner.HorzScrollRect; - MoveWindowOrg(DC, -R.Left, -R.Top); - FScrollBarWindowOwner.DrawHorzScrollBar(DC); - end; - finally - ReleaseDC(Handle, DC); - end; - end; - finally - EndPaint(Handle, PS); - end; -end; - -initialization - TCustomStyleEngine.RegisterStyleHook(TVirtualStringTree, TVclStyleScrollBarsHook); - TCustomStyleEngine.RegisterStyleHook(TVirtualDrawTree, TVclStyleScrollBarsHook); - -finalization - TCustomStyleEngine.UnRegisterStyleHook(TVirtualStringTree, TVclStyleScrollBarsHook); - TCustomStyleEngine.UnRegisterStyleHook(TVirtualDrawTree, TVclStyleScrollBarsHook); - -end. - +unit VirtualTrees.StyleHooks; + +// The contents of this file are subject to the Mozilla Public License +// Version 1.1 (the "License"); you may not use this file except in compliance +// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ +// +// Alternatively, you may redistribute this library, use and/or modify it under the terms of the +// GNU Lesser General Public License as published by the Free Software Foundation; +// either version 2.1 of the License, or (at your option) any later version. +// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/. +// +// Software distributed under the License is distributed on an "AS IS" basis, +// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the +// specific language governing rights and limitations under the License. +// +// The original code is VirtualTrees.pas, released September 30, 2000. +// +// The initial developer of the original code is digital publishing AG (Munich, Germany, www.digitalpublishing.de), +// written by Mike Lischke (public@soft-gems.net, www.soft-gems.net). +// +// Portions created by digital publishing AG are Copyright +// (C) 1999-2001 digital publishing AG. All Rights Reserved. +//---------------------------------------------------------------------------------------------------------------------- + + +interface + +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CAST OFF} +{$WARN UNSAFE_CODE OFF} +{$if CompilerVersion < 34} + {$DEFINE NOT_USE_VCL_STYLEHOOK} // Do not use inherited style hook but own code in this class. Needed for older Delphi versions 10.3 and below +{$ifend} + +uses + Winapi.Windows, + Winapi.Messages, + Winapi.UxTheme, + System.Classes, + System.UITypes, + Vcl.Graphics, + Vcl.Themes, + Vcl.Forms, + Vcl.Controls; + +const + CM_UPDATE_VCLSTYLE_SCROLLBARS = CM_BASE + 2050; + +type + // XE2+ VCL Style + TVclStyleScrollBarsHook = class(TScrollingStyleHook) + {$ifdef NOT_USE_VCL_STYLEHOOK} + strict private type + {$REGION 'TVclStyleScrollBarWindow'} + TScrollWindow = class(TWinControl) + strict private + FStyleHook: TVclStyleScrollBarsHook; + FVertical: Boolean; + procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST; + procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND; + procedure WMPaint(var Msg: TWMPaint); message WM_PAINT; + public + constructor Create(AOwner: TComponent); override; + property StyleHook: TVclStyleScrollBarsHook read FStyleHook write FStyleHook; + property Vertical: Boolean read FVertical write FVertical; + end; + {$ENDREGION} + private + FHorzScrollWnd: TScrollWindow; + FLeftButtonDown: Boolean; + FVertScrollWnd: TScrollWindow; + + procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; + procedure WMKeyDown(var Msg: TMessage); message WM_KEYDOWN; + procedure WMKeyUp(var Msg: TMessage); message WM_KEYUP; + procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN; + procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP; + procedure WMNCLButtonDown(var Msg: TWMMouse); message WM_NCLBUTTONDOWN; + procedure WMNCLButtonDblClk(var Msg: TWMMouse); message WM_NCLBUTTONDBLCLK; + procedure WMNCLButtonUp(var Msg: TWMMouse); message WM_NCLBUTTONUP; + procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT; + procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL; + procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL; + procedure WMSize(var Msg: TMessage); message WM_SIZE; + procedure WMMove(var Msg: TMessage); message WM_MOVE; + procedure WMPosChanged(var Msg: TMessage); message WM_WINDOWPOSCHANGED; + procedure WMMouseWheel(var Msg: TMessage); message WM_MOUSEWHEEL; + procedure WMCaptureChanged(var Msg: TMessage); message WM_CAPTURECHANGED; + procedure InitScrollBars; + procedure WMNCMouseMove(var Msg: TWMMouse); message WM_NCMOUSEMOVE; + procedure WMMouseMove(var Msg: TWMMouse); message WM_MOUSEMOVE; + function NCMousePosToClient(const P: TPoint): TPoint; + function PointInTreeHeader(const P: TPoint): Boolean; + {$endif} + private + procedure CMUpdateVclStyleScrollbars(var Msg: TMessage); message CM_UPDATE_VCLSTYLE_SCROLLBARS; + protected + procedure CalcScrollBarsRect; virtual; + procedure UpdateScroll;{$if CompilerVersion >= 34}override;{$ifend} + {$ifdef NOT_USE_VCL_STYLEHOOK} + procedure MouseLeave; override; + procedure DrawHorzScrollBar(DC: HDC); virtual; + procedure DrawVertScrollBar(DC: HDC); virtual; + procedure PaintScroll; override; + property HorzScrollWnd: TScrollWindow read FHorzScrollWnd; + property VertScrollWnd: TScrollWindow read FVertScrollWnd; + property LeftButtonDown: Boolean read FLeftButtonDown; + {$ifend} + public + constructor Create(AControl: TWinControl); override; + {$ifdef NOT_USE_VCL_STYLEHOOK} + destructor Destroy; override; + {$ifend} + /// Draws an expand arrow like used in the RAD Studio IDE. + /// The code is not yet dpi-aware. + class procedure DrawExpandArrow(pBitmap: TBitmap; pExpanded: Boolean; pColor: TColor = clNone); + property HorzScrollRect; + property VertScrollRect; + end; + +type + /// prototype for the global callback VTStyleServicesFunc. + TVTStyleServicesFunc = function (AControl: TControl = nil): TCustomStyleServices; + + +var + /// Callback that can be used to assign an alternative function to supply style services. + /// Needed for IDE plugins. See pull request #1011 + VTStyleServicesFunc: TVTStyleServicesFunc = nil; + + +/// Wrapper function for styles services that handles differences between RAD Studio 10.4 and older versions, +/// as well as the case if these controls are used inside the IDE. +function VTStyleServices(AControl: TControl = nil): TCustomStyleServices; + + +implementation + +uses + System.SysUtils, + System.Math, + System.Types, + VirtualTrees.Header, + VirtualTrees.Types, + VirtualTrees.BaseTree; + +function VTStyleServices(AControl: TControl = nil): TCustomStyleServices; +begin + if Assigned(VTStyleServicesFunc) then + Result := VTStyleServicesFunc(AControl) + else + Result := Vcl.Themes.StyleServices{$if CompilerVersion >= 34}(AControl){$ifend}; +end; + +//---------------------------------------------------------------------------------------------------------------------- + + +type + TBaseVirtualTreeCracker = class(TBaseVirtualTree) + end; + + +// XE2+ VCL Style +{ TVclStyleScrollBarsHook } + +procedure TVclStyleScrollBarsHook.CalcScrollBarsRect(); + + procedure CalcVerticalRects; + var + BarInfo: TScrollBarInfo; + Ret: BOOL; + begin + if not Assigned(VertScrollWnd) then // Might happen, when FInitingScrollBars is set, so InitScrollBars did not yet initialize the members + Exit; + + BarInfo.cbSize := SizeOf(BarInfo); + Ret := GetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), BarInfo); + VertScrollWnd.Visible := (seBorder in Control.StyleElements) and Ret and (not (STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0)); + VertScrollWnd.Enabled := VertScrollWnd.Visible and (not (STATE_SYSTEM_UNAVAILABLE and BarInfo.rgstate[0] <> 0)); + end; + + procedure CalcHorizontalRects; + var + BarInfo: TScrollBarInfo; + Ret: BOOL; + begin + if not Assigned(HorzScrollWnd) then // Might happen, when FInitingScrollBars is set, so InitScrollBars did not yet initialize the members + Exit; + + BarInfo.cbSize := SizeOf(BarInfo); + Ret := GetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), BarInfo); + HorzScrollWnd.Visible := (seBorder in Control.StyleElements) and Ret and (not (STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0)); + HorzScrollWnd.Enabled := HorzScrollWnd.Visible and (not (STATE_SYSTEM_UNAVAILABLE and BarInfo.rgstate[0] <> 0)); + end; + +begin + CalcVerticalRects; + CalcHorizontalRects; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +constructor TVclStyleScrollBarsHook.Create(AControl: TWinControl); +begin + inherited; + {$ifdef NOT_USE_VCL_STYLEHOOK} + VertSliderState := tsThumbBtnVertNormal; + VertUpState := tsArrowBtnUpNormal; + VertDownState := tsArrowBtnDownNormal; + HorzSliderState := tsThumbBtnHorzNormal; + HorzUpState := tsArrowBtnLeftNormal; + HorzDownState := tsArrowBtnRightNormal; + {$ifend} +end; + +//---------------------------------------------------------------------------------------------------------------------- + +class procedure TVclStyleScrollBarsHook.DrawExpandArrow(pBitmap: TBitmap; pExpanded: Boolean; pColor: TColor); +const + Size: TRect = (Left: 0; Top: 0; Right: 12; Bottom: 12); + ArrowPoints: array[Boolean, 0..5] of TPoint = ( + ((X:3; Y:1), (X:8; Y:6), (X:3; Y:11), (X:4; Y:11), (X:9; Y:6), (X:3; Y:0)), + ((X:1; Y:3), (X:6; Y:8), (X:11; Y:3), (X:11; Y:4), (X:6; Y:9), (X:0; Y:3)) + ); +var + canvas: TCanvas; +begin + pBitmap.SetSize(Size.Width, Size.Height); + canvas := pBitmap.Canvas; + canvas.FillRect(Size); + if pColor = clNone then + begin + if Assigned(VTStyleServicesFunc) then + canvas.Pen.Color := VTStyleServicesFunc.GetSystemColor(clGrayText) + else + canvas.Pen.Color := Vcl.Themes.StyleServices.GetSystemColor(clGrayText) + end + else + canvas.Pen.Color := pColor; + canvas.Pen.Width := 1; + canvas.Polyline(ArrowPoints[pExpanded]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.UpdateScroll; +var + R: TRect; + HeaderHeight: Integer; + PaddingSize: Integer; + BorderSize: Integer; +begin + if VertScrollWnd = nil then + InitScrollBars(); + + HeaderHeight := 0; + if (hoVisible in TBaseVirtualTree(Control).Header.Options) then + Inc(HeaderHeight, TBaseVirtualTree(Control).Header.Height); + + PaddingSize := TBaseVirtualTreeCracker(Control).BorderWidth; + if TBaseVirtualTreeCracker(Control).BevelKind <> bkNone then + begin + if TBaseVirtualTreeCracker(Control).BevelInner <> bvNone then + Inc(PaddingSize, TBaseVirtualTreeCracker(Control).BevelWidth); + if TBaseVirtualTreeCracker(Control).BevelOuter <> bvNone then + Inc(PaddingSize, TBaseVirtualTreeCracker(Control).BevelWidth); + end; + + BorderSize := 0; + if HasBorder then + Inc(BorderSize, GetSystemMetrics(SM_CYEDGE)); + + if ((VertScrollWnd <> nil) and not VertScrollWnd.HandleAllocated) or + ((HorzScrollWnd <> nil) and not HorzScrollWnd.HandleAllocated) then + begin // Fixes issue #390 + if VertScrollWnd <> nil then + FreeAndNil({$ifdef NOT_USE_VCL_STYLEHOOK}FVertScrollWnd{$else}VertScrollWnd{$ifend}); + if HorzScrollWnd <> nil then + FreeAndNil({$ifdef NOT_USE_VCL_STYLEHOOK}FHorzScrollWnd{$else}HorzScrollWnd{$ifend}); + + InitScrollBars; + end; + + // VertScrollBarWindow + if Control.HandleAllocated then + begin + if VertScrollWnd.Visible then + begin + R := VertScrollRect; + if Control.UseRightToLeftScrollBar then + OffsetRect(R, -R.Left + BorderSize, 0); + + ShowWindow(VertScrollWnd.Handle, SW_SHOW); + SetWindowPos(VertScrollWnd.Handle, HWND_TOP, + Control.Left + R.Left + PaddingSize, + Control.Top + R.Top + HeaderHeight + PaddingSize, + R.Width, + Control.Height - HeaderHeight - ((PaddingSize + BorderSize) * 2), // <> R.Height + SWP_SHOWWINDOW); + end else + ShowWindow(VertScrollWnd.Handle, SW_HIDE); + end;// if FVertScrollWnd + + // HorzScrollBarWindow + if Control.HandleAllocated then + begin + if HorzScrollWnd.Visible then + begin + R := HorzScrollRect; + if Control.UseRightToLeftScrollBar then + OffsetRect(R, VertScrollRect.Width, 0); + + ShowWindow(HorzScrollWnd.Handle, SW_SHOW); + SetWindowPos(HorzScrollWnd.Handle, HWND_TOP, + Control.Left + R.Left + PaddingSize, + Control.Top + R.Top + HeaderHeight + PaddingSize, + R.Width, R.Height, SWP_SHOWWINDOW); + end else + ShowWindow(HorzScrollWnd.Handle, SW_HIDE); + end;// if FHorzScrollWnd + // ScrollBarWindow Visible/Enabled Control + CalcScrollBarsRect; + +end; + +procedure TVclStyleScrollBarsHook.CMUpdateVclStyleScrollbars(var Msg: TMessage); +begin + CalcScrollBarsRect; + PaintScroll; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +{$ifdef NOT_USE_VCL_STYLEHOOK} + +function TVclStyleScrollBarsHook.NCMousePosToClient(const P: TPoint): TPoint; +begin + Result := P; + ScreenToClient(Handle, Result); + if HasBorder then + begin + if HasClientEdge then + Result.Offset(2, 2) + else + Result.Offset(1, 1); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVclStyleScrollBarsHook.PointInTreeHeader(const P: TPoint): Boolean; +begin + Result := TBaseVirtualTree(Control).Header.InHeader(P); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.DrawHorzScrollBar(DC: HDC); +var + B: TBitmap; + Details: TThemedElementDetails; + R: TRect; +begin + if ((Handle = 0) or (DC = 0)) then + Exit; + + if HorzScrollWnd.Visible and StyleServices.Available and (seBorder in Control.StyleElements) then + begin + B := TBitmap.Create; + try + R := HorzScrollRect; + B.Width := R.Width; + B.Height := R.Height; + MoveWindowOrg(B.Canvas.Handle, -R.Left, -R.Top); + + R.Left := HorzUpButtonRect.Right; + R.Right := HorzDownButtonRect.Left; + Details := StyleServices.GetElementDetails(tsUpperTrackHorzNormal); + StyleServices.DrawElement(B.Canvas.Handle, Details, R{$IF CompilerVersion >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND}); + + if HorzScrollWnd.Enabled then + Details := StyleServices.GetElementDetails(HorzSliderState); + StyleServices.DrawElement(B.Canvas.Handle, Details, HorzSliderRect{$IF CompilerVersion >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND}); + + if HorzScrollWnd.Enabled then + Details := StyleServices.GetElementDetails(HorzUpState) + else + Details := StyleServices.GetElementDetails(tsArrowBtnLeftDisabled); + StyleServices.DrawElement(B.Canvas.Handle, Details, HorzUpButtonRect{$IF CompilerVersion >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND}); + + if HorzScrollWnd.Enabled then + Details := StyleServices.GetElementDetails(HorzDownState) + else + Details := StyleServices.GetElementDetails(tsArrowBtnRightDisabled); + StyleServices.DrawElement(B.Canvas.Handle, Details, HorzDownButtonRect{$IF CompilerVersion >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND}); + + R := HorzScrollRect; + MoveWindowOrg(B.Canvas.Handle, R.Left, R.Top); + BitBlt(DC, R.Left, R.Top, B.Width, B.Height, B.Canvas.Handle, 0, 0, SRCCOPY); + finally + B.Free; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.DrawVertScrollBar(DC: HDC); +var + B: TBitmap; + Details: TThemedElementDetails; + R: TRect; +begin + if ((Handle = 0) or (DC = 0)) then + Exit; + + if VertScrollWnd.Visible and StyleServices.Available and (seBorder in Control.StyleElements) then + begin + B := TBitmap.Create; + try + R := VertScrollRect; + B.Width := R.Width; + B.Height := VertScrollWnd.Height; // <> R.Height + MoveWindowOrg(B.Canvas.Handle, -R.Left, -R.Top); + + R.Bottom := B.Height + R.Top; + Details := StyleServices.GetElementDetails(tsUpperTrackVertNormal); + StyleServices.DrawElement(B.Canvas.Handle, Details, R {$IF CompilerVersion >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND}); + + R.Top := VertUpButtonRect.Bottom; + R.Bottom := VertDownButtonRect.Top; + Details := StyleServices.GetElementDetails(tsUpperTrackVertNormal); + StyleServices.DrawElement(B.Canvas.Handle, Details, R{$IF CompilerVersion >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND}); + + if VertScrollWnd.Enabled then + Details := StyleServices.GetElementDetails(VertSliderState); + StyleServices.DrawElement(B.Canvas.Handle, Details, VertSliderRect{$IF CompilerVersion >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND}); + + if VertScrollWnd.Enabled then + Details := StyleServices.GetElementDetails(VertUpState) + else + Details := StyleServices.GetElementDetails(tsArrowBtnUpDisabled); + StyleServices.DrawElement(B.Canvas.Handle, Details, VertUpButtonRect{$IF CompilerVersion >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND}); + + if VertScrollWnd.Enabled then + Details := StyleServices.GetElementDetails(VertDownState) + else + Details := StyleServices.GetElementDetails(tsArrowBtnDownDisabled); + StyleServices.DrawElement(B.Canvas.Handle, Details, VertDownButtonRect{$IF CompilerVersion >= 34}, nil, VertScrollWnd.CurrentPPI{$IFEND}); + + R := VertScrollRect; + MoveWindowOrg(B.Canvas.Handle, R.Left, R.Top); + BitBlt(DC, R.Left, R.Top, B.Width, B.Height, B.Canvas.Handle, 0, 0, SRCCOPY); + finally + B.Free; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.MouseLeave; +begin + inherited; + if VertSliderState = tsThumbBtnVertHot then + VertSliderState := tsThumbBtnVertNormal; + + if HorzSliderState = tsThumbBtnHorzHot then + HorzSliderState := tsThumbBtnHorzNormal; + + if VertUpState = tsArrowBtnUpHot then + VertUpState := tsArrowBtnUpNormal; + + if VertDownState = tsArrowBtnDownHot then + VertDownState := tsArrowBtnDownNormal; + + if HorzUpState = tsArrowBtnLeftHot then + HorzUpState := tsArrowBtnLeftNormal; + + if HorzDownState = tsArrowBtnRightHot then + HorzDownState := tsArrowBtnRightNormal; + + PaintScroll; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMCaptureChanged(var Msg: TMessage); +begin + if VertScrollWnd.Visible and VertScrollWnd.Enabled then + begin + if VertUpState = tsArrowBtnUpPressed then + begin + VertUpState := tsArrowBtnUpNormal; + PaintScroll; + end; + + if VertDownState = tsArrowBtnDownPressed then + begin + VertDownState := tsArrowBtnDownNormal; + PaintScroll; + end; + end; + + if HorzScrollWnd.Visible and HorzScrollWnd.Enabled then + begin + if HorzUpState = tsArrowBtnLeftPressed then + begin + HorzUpState := tsArrowBtnLeftNormal; + PaintScroll; + end; + + if HorzDownState = tsArrowBtnRightPressed then + begin + HorzDownState := tsArrowBtnRightNormal; + PaintScroll; + end; + end; + + CallDefaultProc(TMessage(Msg)); + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +destructor TVclStyleScrollBarsHook.Destroy; +begin + FVertScrollWnd.StyleHook := nil; + FreeAndNil(FVertScrollWnd); + FHorzScrollWnd.StyleHook := nil; + FreeAndNil(FHorzScrollWnd); + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMEraseBkgnd(var Msg: TWMEraseBkgnd); +begin + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.PaintScroll; +begin + if FVertScrollWnd.HandleAllocated then + begin + FVertScrollWnd.Repaint; + RedrawWindow(FVertScrollWnd.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698 + end; + if FHorzScrollWnd.HandleAllocated then + begin + FHorzScrollWnd.Repaint; + RedrawWindow(FHorzScrollWnd.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698 + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMKeyDown(var Msg: TMessage); +begin + CallDefaultProc(TMessage(Msg)); + PaintScroll; + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMKeyUp(var Msg: TMessage); +begin + CallDefaultProc(TMessage(Msg)); + PaintScroll; + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMLButtonDown(var Msg: TWMMouse); +begin + CallDefaultProc(TMessage(Msg)); + UpdateScroll; + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.InitScrollBars; +begin + FVertScrollWnd := TScrollWindow.CreateParented(GetParent(Control.Handle)); + FVertScrollWnd.StyleHook := Self; + FVertScrollWnd.Vertical := True; + + FHorzScrollWnd := TScrollWindow.CreateParented(GetParent(Control.Handle)); + FHorzScrollWnd.StyleHook := Self; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMLButtonUp(var Msg: TWMMouse); +var + P: TPoint; +begin + P := Point(Msg.XPos, Msg.YPos); + ScreenToClient(Handle, P); + if not PointInTreeHeader(P) then + begin + if VertScrollWnd.Visible then + begin + if VertSliderState = tsThumbBtnVertPressed then + begin + PostMessage(Handle, WM_VSCROLL, WPARAM(UInt32(SmallPoint(SB_ENDSCROLL, 0))), 0); + FLeftButtonDown := False; + VertSliderState := tsThumbBtnVertNormal; + PaintScroll; + Handled := True; + Mouse.Capture := 0; + Exit; + end else + if VertUpState = tsArrowBtnUpPressed then + VertUpState := tsArrowBtnUpNormal + else if VertDownState = tsArrowBtnDownPressed then + VertDownState := tsArrowBtnDownNormal; + end; + + if FHorzScrollWnd.Visible then + begin + if HorzSliderState = tsThumbBtnHorzPressed then + begin + PostMessage(Handle, WM_HSCROLL, WPARAM(UInt32(SmallPoint(SB_ENDSCROLL, 0))), 0); + FLeftButtonDown := False; + HorzSliderState := tsThumbBtnHorzNormal; + PaintScroll; + Handled := True; + Mouse.Capture := 0; + Exit; + end else + if HorzUpState = tsArrowBtnLeftPressed then + HorzUpState := tsArrowBtnLeftNormal + else if HorzDownState = tsArrowBtnRightPressed then + HorzDownState := tsArrowBtnRightNormal; + end; + PaintScroll; + end; + FLeftButtonDown := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- +procedure TVclStyleScrollBarsHook.WMNCLButtonDown(var Msg: TWMMouse); +var + P: TPoint; + SF: TScrollInfo; +begin + P := NCMousePosToClient(Point(Msg.XPos, Msg.YPos)); + if not PointInTreeHeader(P) then + begin + if VertScrollWnd.Visible and VertScrollWnd.Enabled then + begin + if PtInRect(VertSliderRect, P) then + begin + FLeftButtonDown := True; + SF.fMask := SIF_ALL; + SF.cbSize := SizeOf(SF); + GetScrollInfo(Handle, SB_VERT, SF); + ListPos := SF.nPos; + ScrollPos := SF.nPos; + PrevScrollPos := Mouse.CursorPos.Y; + VertSliderState := tsThumbBtnVertPressed; + PaintScroll; + Mouse.Capture := Handle; + Handled := True; + Exit; + end else + if PtInRect(VertDownButtonRect, P) then + VertDownState := tsArrowBtnDownPressed + else if PtInRect(VertUpButtonRect, P) then + VertUpState := tsArrowBtnUpPressed; + end; + + if FHorzScrollWnd.Visible and FHorzScrollWnd.Enabled then + begin + if PtInRect(HorzSliderRect, P) then + begin + FLeftButtonDown := True; + SF.fMask := SIF_ALL; + SF.cbSize := SizeOf(SF); + GetScrollInfo(Handle, SB_HORZ, SF); + ListPos := SF.nPos; + ScrollPos := SF.nPos; + PrevScrollPos := Mouse.CursorPos.X; + HorzSliderState := tsThumbBtnHorzPressed; + PaintScroll; + Mouse.Capture := Handle; + Handled := True; + Exit; + end else + if PtInRect(HorzDownButtonRect, P) then + HorzDownState := tsArrowBtnRightPressed + else if PtInRect(HorzUpButtonRect, P) then + HorzUpState := tsArrowBtnLeftPressed; + end; + FLeftButtonDown := True; + PaintScroll; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMNCLButtonUp(var Msg: TWMMouse); +var + P: TPoint; +begin + P := NCMousePosToClient(Point(Msg.XPos, Msg.YPos)); + if not PointInTreeHeader(P) then + begin + if VertScrollWnd.Visible and VertScrollWnd.Enabled then + begin + if VertSliderState = tsThumbBtnVertPressed then + begin + FLeftButtonDown := False; + VertSliderState := tsThumbBtnVertNormal; + PaintScroll; + Handled := True; + Exit; + end; + + if PtInRect(VertDownButtonRect, P) then + VertDownState := tsArrowBtnDownHot + else + VertDownState := tsArrowBtnDownNormal; + + if PtInRect(VertUpButtonRect, P) then + VertUpState := tsArrowBtnUpHot + else + VertUpState := tsArrowBtnUpNormal; + end; + + if FHorzScrollWnd.Visible and FHorzScrollWnd.Enabled then + begin + if HorzSliderState = tsThumbBtnHorzPressed then + begin + FLeftButtonDown := False; + HorzSliderState := tsThumbBtnHorzNormal; + PaintScroll; + Handled := True; + Exit; + end; + + if PtInRect(HorzDownButtonRect, P) then + HorzDownState := tsArrowBtnRightHot + else + HorzDownState := tsArrowBtnRightNormal; + + if PtInRect(HorzUpButtonRect, P) then + HorzUpState := tsArrowBtnLeftHot + else + HorzUpState := tsArrowBtnLeftNormal; + end; + + CallDefaultProc(TMessage(Msg)); + if (FHorzScrollWnd.Visible) or (FVertScrollWnd.Visible) then + PaintScroll; + end; + + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMNCLButtonDblClk(var Msg: TWMMouse); +begin + WMNCLButtonDown(Msg); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMNCPaint(var Msg: TMessage); +begin + //if (tsWindowCreating in TBaseVirtualTree(Control).TreeStates) then + // UpdateScrollBarWindow; + //inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMHScroll(var Msg: TWMHScroll); +begin + CallDefaultProc(TMessage(Msg)); + PaintScroll; + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMMouseWheel(var Msg: TMessage); +begin + CallDefaultProc(TMessage(Msg)); + CalcScrollBarsRect; + PaintScroll; + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMMouseMove(var Msg: TWMMouse); +var + SF: TScrollInfo; + OverrideMax: Integer; +begin + if VertSliderState = tsThumbBtnVertPressed then + begin + SF.fMask := SIF_ALL; + SF.cbSize := SizeOf(SF); + GetScrollInfo(Handle, SB_VERT, SF); + + OverrideMax := SF.nMax; + if 0 < SF.nPage then + OverrideMax := SF.nMax - Integer(SF.nPage) + 1; + ScrollPos := System.Math.EnsureRange(ListPos + (OverrideMax - SF.nMin) * ((Mouse.CursorPos.Y - PrevScrollPos) / (VertTrackRect.Height - VertSliderRect.Height)), + SF.nMin, OverrideMax); + SF.fMask := SIF_POS; + SF.nPos := Round(ScrollPos); + SetScrollInfo(Handle, SB_VERT, SF, False); + PostMessage(Handle, WM_VSCROLL, WPARAM(UInt32(SmallPoint(SB_THUMBPOSITION, Min(SF.nPos, High(SmallInt))))), 0); + + PaintScroll; + Handled := True; + Exit; + end else + if VertSliderState = tsThumbBtnVertHot then + begin + VertSliderState := tsThumbBtnVertNormal; + PaintScroll; + end; + + if HorzSliderState = tsThumbBtnHorzPressed then + begin + SF.fMask := SIF_ALL; + SF.cbSize := SizeOf(SF); + GetScrollInfo(Handle, SB_HORZ, SF); + + OverrideMax := SF.nMax; + if 0 < SF.nPage then + OverrideMax := SF.nMax - Integer(SF.nPage) + 1; + ScrollPos := System.Math.EnsureRange(ListPos + (OverrideMax - SF.nMin) * ((Mouse.CursorPos.X - PrevScrollPos) / (HorzTrackRect.Width - HorzSliderRect.Width)), + SF.nMin, OverrideMax); + SF.fMask := SIF_POS; + SF.nPos := Round(ScrollPos); + SetScrollInfo(Handle, SB_HORZ, SF, False); + PostMessage(Handle, WM_HSCROLL, WPARAM(UInt32(SmallPoint(SB_THUMBPOSITION, Min(SF.nPos, High(SmallInt))))), 0); + + PaintScroll; + Handled := True; + Exit; + end else + if HorzSliderState = tsThumbBtnHorzHot then + begin + HorzSliderState := tsThumbBtnHorzNormal; + PaintScroll; + end; + + if (HorzUpState <> tsArrowBtnLeftPressed) and (HorzUpState = tsArrowBtnLeftHot) then + begin + HorzUpState := tsArrowBtnLeftNormal; + PaintScroll; + end; + + if (HorzDownState <> tsArrowBtnRightPressed) and (HorzDownState = tsArrowBtnRightHot) then + begin + HorzDownState := tsArrowBtnRightNormal; + PaintScroll; + end; + + if (VertUpState <> tsArrowBtnUpPressed) and (VertUpState = tsArrowBtnUpHot) then + begin + VertUpState := tsArrowBtnUpNormal; + PaintScroll; + end; + + if (VertDownState <> tsArrowBtnDownPressed) and (VertDownState = tsArrowBtnDownHot) then + begin + VertDownState := tsArrowBtnDownNormal; + PaintScroll; + end; + + CallDefaultProc(TMessage(Msg)); + if LeftButtonDown then + PaintScroll; + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMNCMouseMove(var Msg: TWMMouse); +var + P: TPoint; + MustUpdateScroll: Boolean; + B: Boolean; +begin + inherited; + P := NCMousePosToClient(Point(Msg.XPos, Msg.YPos)); + if PointInTreeHeader(P) then + begin + CallDefaultProc(TMessage(Msg)); + PaintScroll; + Handled := True; + Exit; + end; + + MustUpdateScroll := False; + if VertScrollWnd.Visible and VertScrollWnd.Enabled then + begin + B := PtInRect(VertSliderRect, P); + if B and (VertSliderState = tsThumbBtnVertNormal) then + begin + VertSliderState := tsThumbBtnVertHot; + MustUpdateScroll := True; + end else + if not B and (VertSliderState = tsThumbBtnVertHot) then + begin + VertSliderState := tsThumbBtnVertNormal; + MustUpdateScroll := True; + end; + + B := PtInRect(VertDownButtonRect, P); + if B and (VertDownState = tsArrowBtnDownNormal) then + begin + VertDownState := tsArrowBtnDownHot; + MustUpdateScroll := True; + end else + if not B and (VertDownState = tsArrowBtnDownHot) then + begin + VertDownState := tsArrowBtnDownNormal; + MustUpdateScroll := True; + end; + + B := PtInRect(VertUpButtonRect, P); + if B and (VertUpState = tsArrowBtnUpNormal) then + begin + VertUpState := tsArrowBtnUpHot; + MustUpdateScroll := True; + end else + if not B and (VertUpState = tsArrowBtnUpHot) then + begin + VertUpState := tsArrowBtnUpNormal; + MustUpdateScroll := True; + end; + end; + + if HorzScrollWnd.Visible and HorzScrollWnd.Enabled then + begin + B := PtInRect(HorzSliderRect, P); + if B and (HorzSliderState = tsThumbBtnHorzNormal) then + begin + HorzSliderState := tsThumbBtnHorzHot; + MustUpdateScroll := True; + end else + if not B and (HorzSliderState = tsThumbBtnHorzHot) then + begin + HorzSliderState := tsThumbBtnHorzNormal; + MustUpdateScroll := True; + end; + + B := PtInRect(HorzDownButtonRect, P); + if B and (HorzDownState = tsArrowBtnRightNormal) then + begin + HorzDownState := tsArrowBtnRightHot; + MustUpdateScroll := True; + end else + if not B and (HorzDownState = tsArrowBtnRightHot) then + begin + HorzDownState := tsArrowBtnRightNormal; + MustUpdateScroll := True; + end; + + B := PtInRect(HorzUpButtonRect, P); + if B and (HorzUpState = tsArrowBtnLeftNormal) then + begin + HorzUpState := tsArrowBtnLeftHot; + MustUpdateScroll := True; + end else + if not B and (HorzUpState = tsArrowBtnLeftHot) then + begin + HorzUpState := tsArrowBtnLeftNormal; + MustUpdateScroll := True; + end; + end; + + if MustUpdateScroll then + PaintScroll; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMSize(var Msg: TMessage); +begin + CallDefaultProc(TMessage(Msg)); + UpdateScroll; + PaintScroll; + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMMove(var Msg: TMessage); +begin + CallDefaultProc(TMessage(Msg)); + if not(tsWindowCreating in TBaseVirtualTree(Control).TreeStates) then + begin + UpdateScroll; + PaintScroll; + end; + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMPosChanged(var Msg: TMessage); +begin + WMMove(Msg); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.WMVScroll(var Msg: TWMVScroll); +begin + CallDefaultProc(TMessage(Msg)); + PaintScroll; + Handled := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +{ TVclStyleScrollBarsHook.TVclStyleScrollBarWindow } + +constructor TVclStyleScrollBarsHook.TScrollWindow.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := ControlStyle + [csOverrideStylePaint]; + FStyleHook := nil; + FVertical := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.TScrollWindow.WMEraseBkgnd(var Msg: TMessage); +begin + Msg.Result := 1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.TScrollWindow.WMNCHitTest(var Msg: TWMNCHitTest); +begin + Msg.Result := HTTRANSPARENT; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVclStyleScrollBarsHook.TScrollWindow.WMPaint(var Msg: TWMPaint); +var + PS: TPaintStruct; + DC: HDC; + R: TRect; +begin + BeginPaint(Handle, PS); + try + if FStyleHook <> nil then + begin + DC := GetWindowDC(Handle); + try + if FVertical then + begin + R := FStyleHook.VertScrollRect; + MoveWindowOrg(DC, -R.Left, -R.Top); + FStyleHook.DrawVertScrollBar(DC); + end else + begin + R := FStyleHook.HorzScrollRect; + MoveWindowOrg(DC, -R.Left, -R.Top); + FStyleHook.DrawHorzScrollBar(DC); + end; + finally + ReleaseDC(Handle, DC); + end; + end; + finally + EndPaint(Handle, PS); + end; +end; +{$ifend} + +end. diff --git a/Source/VirtualTrees.Types.pas b/Source/VirtualTrees.Types.pas new file mode 100644 index 000000000..ddf5c6a66 --- /dev/null +++ b/Source/VirtualTrees.Types.pas @@ -0,0 +1,1757 @@ +unit VirtualTrees.Types; + +interface + +uses + WinApi.ActiveX, + Winapi.Windows, + Winapi.Messages, + System.Types, + System.Classes, + System.SysUtils, + Vcl.Controls, + Vcl.GraphUtil, + Vcl.Themes, + Vcl.Graphics, + Vcl.ImgList, + System.UITypes; // some types moved from Vcl.* to System.UITypes + +{$MINENUMSIZE 1, make enumerations as small as possible} + +const + VTTreeStreamVersion = 3; + VTHeaderStreamVersion = 6; // The header needs an own stream version to indicate changes only relevant to the header. + + CacheThreshold = 2000; // Number of nodes a tree must at least have to start caching and at the same + // time the maximum number of nodes between two cache entries. + FadeAnimationStepCount = 255; // Number of animation steps for hint fading (0..255). + ShadowSize = 5; // Size in pixels of the hint shadow. This value has no influence on Win2K and XP systems + // as those OSes have native shadow support. + cDefaultTextMargin = 4; // The default margin of text + cInitialDefaultNodeHeight= 18; // the default value of the DefualtNodeHeight property + + // Special identifiers for columns. + NoColumn = - 1; + InvalidColumn = - 2; + + // General constants for imagelists + NoImage = -1; // No image is avalable + EmptyImage = -2; // an empty image used as place holder + + // Indices for check state images in the imagelist used for displaying check-marks. + ckEmpty = 0; // an empty image used as place holder + // radio buttons + ckRadioUncheckedNormal = 1; + ckRadioUncheckedHot = 2; + ckRadioUncheckedPressed = 3; + ckRadioUncheckedDisabled = 4; + ckRadioCheckedNormal = 5; + ckRadioCheckedHot = 6; + ckRadioCheckedPressed = 7; + ckRadioCheckedDisabled = 8; + // check boxes + ckCheckUncheckedNormal = 9; + ckCheckUncheckedHot = 10; + ckCheckUncheckedPressed = 11; + ckCheckUncheckedDisabled = 12; + ckCheckCheckedNormal = 13; + ckCheckCheckedHot = 14; + ckCheckCheckedPressed = 15; + ckCheckCheckedDisabled = 16; + ckCheckMixedNormal = 17; + ckCheckMixedHot = 18; + ckCheckMixedPressed = 19; + ckCheckMixedDisabled = 20; + // simple button + ckButtonNormal = 21; + ckButtonHot = 22; + ckButtonPressed = 23; + ckButtonDisabled = 24; + + // Instead using a TTimer class for each of the various events I use Windows timers with messages + // as this is more economical. + ExpandTimer = 1; + EditTimer = 2; + HeaderTimer = 3; + ScrollTimer = 4; + ChangeTimer = 5; + StructureChangeTimer = 6; + SearchTimer = 7; + ThemeChangedTimer = 8; + ChangeCellTimer = 9; + + ThemeChangedTimerDelay = 500; + + // Virtual Treeview does not need to be subclassed by an eventual Theme Manager instance as it handles + // Windows XP theme painting itself. Hence the special message is used to prevent subclassing. + CM_DENYSUBCLASSING = CM_BASE + 2000; + + // Decoupling message for auto-adjusting the internal edit window. + CM_AUTOADJUST = CM_BASE + 2005; + + // Drag image helpers for Windows 2000 and up. + IID_IDropTargetHelper : TGUID = (D1 : $4657278B; D2 : $411B; D3 : $11D2; D4 : ($83, $9A, $00, $C0, $4F, $D9, $18, $D0)); + IID_IDragSourceHelper : TGUID = (D1 : $DE5BF786; D2 : $477A; D3 : $11D2; D4 : ($83, $9D, $00, $C0, $4F, $D9, $18, $D0)); + IID_IDropTarget : TGUID = (D1 : $00000122; D2 : $0000; D3 : $0000; D4 : ($C0, $00, $00, $00, $00, $00, $00, $46)); + + // VT's own clipboard formats, + // Note: The reference format is used internally to allow to link to a tree reference + // 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'; + CFSTR_CSV = 'CSV'; + + // Help identifiers for exceptions. Application developers are responsible to link them with actual help topics. + hcTFEditLinkIsNil = 2000; + hcTFWrongMoveError = 2001; + hcTFWrongStreamFormat = 2002; + hcTFWrongStreamVersion = 2003; + hcTFStreamTooSmall = 2004; + hcTFCorruptStream1 = 2005; + hcTFCorruptStream2 = 2006; + hcTFClipboardFailed = 2007; + hcTFCannotSetUserData = 2008; + + // Header standard split cursor. + crHeaderSplit = crHSplit deprecated 'Use vrHSplit instead'; + + // Height changing cursor. + crVertSplit = crVSplit deprecated 'Use vrVSplit instead'; + + // chunk IDs + NodeChunk = 1; + BaseChunk = 2; // chunk containing node state, check state, child node count etc. + // this chunk is immediately followed by all child nodes + CaptionChunk = 3; // used by the string tree to store a node's caption + UserChunk = 4; // used for data supplied by the application + +type +{$IFDEF VT_FMX} + TDimension = Single; + PDimension = ^Single; + TNodeHeight = Single; + TVTCursor = TCursor; + TVTDragDataObject = TDragObject; + TVTBackground = TBitmap; + TVTPaintContext = TCanvas; + TVTBrush = TBrush; +{$ELSE} + TDimension = Integer; // Introduced for Firemonkey support, see #841 + PDimension = ^Integer; + TNodeHeight = NativeInt; + TVTCursor = HCURSOR; + TVTDragDataObject = WinApi.ActiveX.IDataObject; + TVTBackground = TPicture; + TVTPaintContext = HDC; + TVTBrush = HBRUSH; +{$ENDIF} + TColumnIndex = {$if CompilerVersion < 36} type {$endif} Integer; // See issue #1276 + TColumnPosition = type Cardinal; + PCardinal = ^Cardinal; + + // The exception used by the trees. + EVirtualTreeError = class(Exception); + + // Limits the speed interval which can be used for auto scrolling (milliseconds). + TAutoScrollInterval = 1 .. 1000; + + TVTScrollIncrement = 1 .. 10000; + + // OLE drag'n drop support + 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 + smaUseColumnOption // use coSmartResize of the corresponding column + ); // describes the used column resize behaviour for AutoFitColumns + + TAddPopupItemType = ( + apNormal, + apDisabled, + apHidden + ); + + TCheckType = ( + ctNone, + ctTriStateCheckBox, + ctCheckBox, + ctRadioButton, + ctButton + ); + + // The check states include both, transient and fluent (temporary) states. The only temporary state defined so + // far is the pressed state. + TCheckState = ( + csUncheckedNormal, // unchecked and not pressed + csUncheckedPressed, // unchecked and pressed + csCheckedNormal, // checked and not pressed + csCheckedPressed, // checked and pressed + csMixedNormal, // 3-state check box and not pressed + csMixedPressed, // 3-state check box and pressed + csUncheckedDisabled, // disabled checkbox, not checkable + csCheckedDisabled, // disabled checkbox, not uncheckable + csMixedDisabled // disabled 3-state checkbox + ); + + /// Adds some convenience methods to type TCheckState + TCheckStateHelper = record helper for TCheckState + strict private + const + // Lookup to quickly convert a specific check state into its pressed counterpart and vice versa. + cPressedState : array [TCheckState] of TCheckState = ( + csUncheckedPressed, csUncheckedPressed, csCheckedPressed, csCheckedPressed, csMixedPressed, csMixedPressed, csUncheckedDisabled, csCheckedDisabled, csMixedDisabled); + cUnpressedState : array [TCheckState] of TCheckState = ( + csUncheckedNormal, csUncheckedNormal, csCheckedNormal, csCheckedNormal, csMixedNormal, csMixedNormal, csUncheckedDisabled, csCheckedDisabled, csMixedDisabled); + cEnabledState : array [TCheckState] of TCheckState = ( + csUncheckedNormal, csUncheckedPressed, csCheckedNormal, csCheckedPressed, csMixedNormal, csMixedPressed, csUncheckedNormal, csCheckedNormal, csMixedNormal); + cToggledState : array [TCheckState] of TCheckState = ( + csCheckedNormal, csCheckedPressed, csUncheckedNormal, csUncheckedPressed, csCheckedNormal, csCheckedPressed, csUncheckedDisabled, csCheckedDisabled, csMixedDisabled); + public + function GetPressed() : TCheckState; inline; + function GetUnpressed() : TCheckState; inline; + function GetEnabled() : TCheckState; inline; + function GetToggled() : TCheckState; inline; + function IsDisabled() : Boolean; inline; + function IsChecked() : Boolean; inline; + function IsUnChecked() : Boolean; inline; + function IsMixed() : Boolean; inline; + end; + +type + // Options per column. + TVTColumnOption = ( + coAllowClick, // Column can be clicked (must be enabled too). + coDraggable, // Column can be dragged. + coEnabled, // Column is enabled. + coParentBidiMode, // Column uses the parent's bidi mode. + coParentColor, // Column uses the parent's background color. + coResizable, // Column can be resized. + coShowDropMark, // Column shows the drop mark if it is currently the drop target. + coVisible, // Column is shown. + coAutoSpring, // Column takes part in the auto spring feature of the header (must be resizable too). + coFixed, // Column is fixed and can not be selected or scrolled etc. + coSmartResize, // Column is resized to its largest entry which is in view (instead of its largest + // visible entry). + coAllowFocus, // Column can be focused. + coDisableAnimatedResize, // Column resizing is not animated. + coWrapCaption, // Caption could be wrapped across several header lines to fit columns width. + coUseCaptionAlignment, // Column's caption has its own aligment. + coEditable, // Column can be edited + coStyleColor, // Prefer background color of VCL style over TVirtualTreeColumn.Color + coMulticellSelected // Indicates this column is selected as part of multicell + ); + TVTColumnOptions = set of TVTColumnOption; + + TVirtualTreeColumnStyle = ( + vsText, + vsOwnerDraw + ); + + TSortDirection = ( + sdAscending, + sdDescending + ); + + TSortDirectionHelper = record helper for VirtualTrees.Types.TSortDirection + strict private + const + cSortDirectionToInt : Array [TSortDirection] of Integer = (1, - 1); + public + /// Returns +1 for ascending and -1 for descending sort order. + function ToInt() : Integer; inline; + end; + +// Used during owner draw of the header to indicate which drop mark for the column must be drawn. + TVTDropMarkMode = ( + dmmNone, + dmmLeft, + dmmRight + ); + + // auto scroll directions + TScrollDirections = set of TScrollDirection; +// sdLeft, +// sdUp, +// sdRight, +// sdDown +// ); + + + + // There is a heap of switchable behavior in the tree. Since published properties may never exceed 4 bytes, + // which limits sets to at most 32 members, and because for better overview tree options are splitted + // in various sub-options and are held in a commom options class. + // + // Options to customize tree appearance: + TVTPaintOption = ( + toHideFocusRect, // Avoid drawing the dotted rectangle around the currently focused node. + toHideSelection, // Selected nodes are drawn as unselected nodes if the tree is unfocused. + toHotTrack, // Track which node is under the mouse cursor. + toPopupMode, // Paint tree as would it always have the focus (useful for tree combo boxes etc.) + toShowBackground, // Use the background image if there's one. + toShowButtons, // Display collapse/expand buttons left to a node. + toShowDropmark, // Show the dropmark during drag'n drop operations. + toShowHorzGridLines, // Display horizontal lines to simulate a grid. + toShowRoot, // Show lines also at top level (does not show the hidden/internal root node). + toShowTreeLines, // Display tree lines to show hierarchy of nodes. + toShowVertGridLines, // Display vertical lines (depending on columns) to simulate a grid. + toThemeAware, // Draw UI elements (header, tree buttons etc.) according to the current theme if enabled (Windows XP+ only, application must be themed). + toUseBlendedImages, // Enable alpha blending for ghosted nodes or those which are being cut/copied. + toGhostedIfUnfocused, // Ghosted images are still shown as ghosted if unfocused (otherwise the become non-ghosted images). + toFullVertGridLines, // Display vertical lines over the full client area, not only the space occupied by nodes. + // This option only has an effect if toShowVertGridLines is enabled too. + toAlwaysHideSelection, // Do not draw node selection, regardless of focused state. + toUseBlendedSelection, // Enable alpha blending for node selections. + toStaticBackground, // Show simple static background instead of a tiled one. + toChildrenAbove, // Display child nodes above their parent. + toFixedIndent, // Draw the tree with a fixed indent. + toUseExplorerTheme, // Use the explorer theme if run under Windows Vista (or above). + toHideTreeLinesIfThemed, // Do not show tree lines if theming is used. + toShowFilteredNodes // Draw nodes even if they are filtered out. + ); + TVTPaintOptions = set of TVTPaintOption; + + { Options to toggle animation support: + **Do not use toAnimatedToggle when a background image is used for the tree. + The animation does not look good as the image splits and moves with it. + } + TVTAnimationOption = ( + toAnimatedToggle, // Expanding and collapsing a node is animated (quick window scroll). + // **See note above. + toAdvancedAnimatedToggle // Do some advanced animation effects when toggling a node. + ); + TVTAnimationOptions = set of TVTAnimationOption; + + // Options which toggle automatic handling of certain situations: + TVTAutoOption = ( + toAutoDropExpand, // Expand node if it is the drop target for more than a certain time. + toAutoExpand, // Nodes are expanded (collapsed) when getting (losing) the focus. + toAutoScroll, // Scroll if mouse is near the border while dragging or selecting. + toAutoScrollOnExpand, // Scroll as many child nodes in view as possible after expanding a node. + toAutoSort, // Sort tree when Header.SortColumn or Header.SortDirection change or sort node if + // child nodes are added. Sorting will take place also if SortColum is NoColumn (-1). + + toAutoSpanColumns, // Large entries continue into next column(s) if there's no text in them (no clipping). + toAutoTristateTracking, // Checkstates are automatically propagated for tri state check boxes. + toAutoHideButtons, // Node buttons are hidden when there are child nodes, but all are invisible. + toAutoDeleteMovedNodes, // Delete nodes which where moved in a drag operation (if not directed otherwise). + toDisableAutoscrollOnFocus, // Disable scrolling a node or column into view if it gets focused. + toAutoChangeScale, // Change default node height and header height automatically according to the height of the used font. + // The property DefaultNodeHeight then has no effect. Use the property TextMargin to increase the row height. + toAutoFreeOnCollapse, // Frees any child node after a node has been collapsed (HasChildren flag stays there). + toDisableAutoscrollOnEdit, // Do not center a node horizontally when it is edited. + toAutoBidiColumnOrdering // When set then columns (if any exist) will be reordered from lowest index to highest index + // and vice versa when the tree's bidi mode is changed. + ); + TVTAutoOptions = set of TVTAutoOption; + + // Options which determine the tree's behavior when selecting nodes: + TVTSelectionOption = ( + toDisableDrawSelection, // Prevent user from selecting with the selection rectangle in multiselect mode. + toExtendedFocus, // Entries other than in the main column can be selected, edited etc. + toFullRowSelect, // Hit test as well as selection highlight are not constrained to the text of a node. + toLevelSelectConstraint, // Constrain selection to the same level as the selection anchor. + toMiddleClickSelect, // Allow selection, dragging etc. with the middle mouse button. This and toWheelPanning + // are mutual exclusive. + toMultiSelect, // Allow more than one node/cell to be selected. + toRightClickSelect, // Allow selection, dragging etc. with the right mouse button. + toSiblingSelectConstraint, // Constrain selection to nodes with same parent. + toCenterScrollIntoView, // Center nodes vertically in the client area when scrolling into view. + toSimpleDrawSelection, // Simplifies draw selection, so a node's caption does not need to intersect with the + // selection rectangle. + toAlwaysSelectNode, // If this flag is set to true, the tree view tries to always have a node selected. + // This behavior is closer to the Windows TreeView and useful in Windows Explorer style applications. + toRestoreSelection, // Set to true if upon refill the previously selected nodes should be selected again. + // The nodes will be identified by its caption (text in MainColumn) + // You may use TVTHeader.RestoreSelectiuonColumnIndex to define an other column that should be used for indentification. + toSyncCheckboxesWithSelection, // If checkboxes are shown, they follow the change in selections. When checkboxes are + // changed, the selections follow them and vice-versa. + // **Only supported for ctCheckBox type checkboxes. + toSelectNextNodeOnRemoval, // If the selected node gets deleted, automatically select the next node. + + /// + /// Enable multi-cell selection feature + /// + toMultiCellSelect + ); + TVTSelectionOptions = set of TVTSelectionOption; + + TVTEditOptions = ( + toDefaultEdit, // Standard behaviour for end of editing (after VK_RETURN stay on edited cell). + toVerticalEdit, // After VK_RETURN switch to next column. + toHorizontalEdit // After VK_RETURN switch to next row. + ); + + // Options which do not fit into any of the other groups: + TVTMiscOption = ( + toAcceptOLEDrop, // Register tree as OLE accepting drop target + toCheckSupport, // Show checkboxes/radio buttons. + toEditable, // Node captions can be edited. + toFullRepaintOnResize, // Fully invalidate the tree when its window is resized (CS_HREDRAW/CS_VREDRAW). + toGridExtensions, // Use some special enhancements to simulate and support grid behavior. + toInitOnSave, // Initialize nodes when saving a tree to a stream. + toReportMode, // Tree behaves like TListView in report mode. + toToggleOnDblClick, // Toggle node expansion state when it is double clicked. + toWheelPanning, // Support for mouse panning (wheel mice only). This option and toMiddleClickSelect are + // mutal exclusive, where panning has precedence. + toReadOnly, // The tree does not allow to be modified in any way. No action is executed and + // node editing is not possible. + toVariableNodeHeight, // When set then GetNodeHeight will trigger OnMeasureItem to allow variable node heights. + toFullRowDrag, // Start node dragging by clicking anywhere in it instead only on the caption or image. + // Must be used together with toDisableDrawSelection. + toNodeHeightResize, // Allows changing a node's height via mouse. + toNodeHeightDblClickResize, // Allows to reset a node's height to FDefaultNodeHeight via a double click. + toEditOnClick, // Editing mode can be entered with a single click + toEditOnDblClick, // Editing mode can be entered with a double click + toReverseFullExpandHotKey // Used to define Ctrl+'+' instead of Ctrl+Shift+'+' for full expand (and similar for collapsing) + ); + TVTMiscOptions = set of TVTMiscOption; + + // Options to control data export + TVTExportMode = ( + emAll, // export all records (regardless checked state) + emChecked, // export checked records only + emUnchecked, // export unchecked records only + emVisibleDueToExpansion, // Do not export nodes that are not visible because their parent is not expanded + emSelected // export selected nodes only + ); + + // Describes the type of text to return in the text and draw info retrival events. + TVSTTextType = ( + ttNormal, // normal label of the node, this is also the text which can be edited + ttStatic // static (non-editable) text after the normal text + ); + + // Options regarding strings (useful only for the string tree and descendants): + TVTStringOption = ( + toSaveCaptions, // If set then the caption is automatically saved with the tree node, regardless of what is + // saved in the user data. + toShowStaticText, // Show static text in a caption which can be differently formatted than the caption + // but cannot be edited. + toAutoAcceptEditChange // Automatically accept changes during edit if the user finishes editing other then + // VK_RETURN or ESC. If not set then changes are cancelled. + ); + TVTStringOptions = set of TVTStringOption; + + // Be careful when adding new states as this might change the size of the type which in turn + // changes the alignment in the node record as well as the stream chunks. + // Do not reorder the states and always add new states at the end of this enumeration in order to avoid + // breaking existing code. + TVirtualNodeState = ( + vsInitialized, // Set after the node has been initialized. + vsChecking, // Node's check state is changing, avoid propagation. + vsCutOrCopy, // Node is selected as cut or copy and paste source. + vsDisabled, // Set if node is disabled. + vsDeleting, // Set when the node is about to be freed. + vsExpanded, // Set if the node is expanded. + vsHasChildren, // Indicates the presence of child nodes without actually setting them. + vsVisible, // Indicate whether the node is visible or not (independant of the expand states of its parents). + vsSelected, // Set if the node is in the current selection. + vsOnFreeNodeCallRequired, // Set if user data has been set which requires OnFreeNode. + vsAllChildrenHidden, // Set if vsHasChildren is set and no child node has the vsVisible flag set. + vsReleaseCallOnUserDataRequired, // Indicates that the user data is a reference to an interface which should be released. + vsMultiline, // Node text is wrapped at the cell boundaries instead of being shorted. + vsHeightMeasured, // Node height has been determined and does not need a recalculation. + vsToggling, // Set when a node is expanded/collapsed to prevent recursive calls. + vsFiltered, // Indicates that the node should not be painted (without effecting its children). + vsInitializing // Set when the node is being initialized + ); + TVirtualNodeStates = set of TVirtualNodeState; + + // States used in InitNode to indicate states a node shall initially have. + TVirtualNodeInitState = ( + ivsDisabled, + ivsExpanded, + ivsHasChildren, + ivsMultiline, + ivsSelected, + ivsFiltered, + ivsReInit + ); + TVirtualNodeInitStates = set of TVirtualNodeInitState; + + // Various events must be handled at different places than they were initiated or need + // a persistent storage until they are reset. + TVirtualTreeStates = set of ( + tsChangePending, // A selection change is pending. + tsCheckPropagation, // Set during automatic check state propagation. + tsCollapsing, // A full collapse operation is in progress. + tsToggleFocusedSelection, // Node selection was modifed using Ctrl-click. Change selection state on next mouse up. + tsClearPending, // Need to clear the current selection on next mouse move. + tsClearOnNewSelection, // Need to clear the current selection before selecting a new node + tsClipboardFlushing, // Set during flushing the clipboard to avoid freeing the content. + tsCopyPending, // Indicates a pending copy operation which needs to be finished. + tsCutPending, // Indicates a pending cut operation which needs to be finished. + tsDrawSelPending, // Multiselection only. User held down the left mouse button on a free + // area and might want to start draw selection. + tsDrawSelecting, // Multiselection only. Draw selection has actually started. + tsEditing, // Indicates that an edit operation is currently in progress. + tsEditPending, // An mouse up start edit if dragging has not started. + tsExpanding, // A full expand operation is in progress. + tsNodeHeightTracking, // A node height changing operation is in progress. + tsNodeHeightTrackPending, // left button is down, user might want to start changing a node's height. + tsHint, // Set when our hint is visible or soon will be. + tsInAnimation, // Set if the tree is currently in an animation loop. + tsIncrementalSearching, // Set when the user starts incremental search. + tsIncrementalSearchPending, // Set in WM_KEYDOWN to tell to use the char in WM_CHAR for incremental search. + tsIterating, // Set when IterateSubtree is currently in progress. + tsLeftButtonDown, // Set when the left mouse button is down. + tsLeftDblClick, // Set when the left mouse button was doubly clicked. + tsMiddleButtonDown, // Set when the middle mouse button is down. + tsMiddleDblClick, // Set when the middle mouse button was doubly clicked. + tsNeedRootCountUpdate, // Set if while loading a root node count is set. + tsOLEDragging, // OLE dragging in progress. + tsOLEDragPending, // User has requested to start delayed dragging. + tsPainting, // The tree is currently painting itself. + tsRightButtonDown, // Set when the right mouse button is down. + tsRightDblClick, // Set when the right mouse button was doubly clicked. + tsPopupMenuShown, // The user clicked the right mouse button, which might cause a popup menu to appear. + tsScrolling, // Set when autoscrolling is active. + tsScrollPending, // Set when waiting for the scroll delay time to elapse. + tsSizing, // Set when the tree window is being resized. This is used to prevent recursive calls + // due to setting the scrollbars when sizing. + tsStopValidation, // Cache validation can be stopped (usually because a change has occured meanwhile). + tsStructureChangePending, // The structure of the tree has been changed while the update was locked. + tsSynchMode, // Set when the tree is in synch mode, where no timer events are triggered. + tsThumbTracking, // Stop updating the horizontal scroll bar while dragging the vertical thumb and vice versa. + tsToggling, // A toggle operation (for some node) is in progress. + tsUpdateHiddenChildrenNeeded, // Pending update for the hidden children flag after massive visibility changes. + tsUseCache, // The tree's node caches are validated and non-empty. + tsUserDragObject, // Signals that the application created an own drag object in OnStartDrag. + tsUseThemes, // The tree runs under WinXP+, is theme aware and themes are enabled. + tsValidating, // The tree's node caches are currently validated. + tsPreviouslySelectedLocked,// The member FPreviouslySelected should not be changed + tsValidationNeeded, // Something in the structure of the tree has changed. The cache needs validation. + 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 + 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 + tsChangeCellPending // A cell selection change is pending. + ); + + + TCheckImageKind = ( + ckCustom, // application defined check images + ckSystemDefault // Uses the system check images, theme aware. + ); + + // mode to describe a move action + TVTNodeAttachMode = ( + amNoWhere, // just for simplified tests, means to ignore the Add/Insert command + amInsertBefore, // insert node just before destination (as sibling of destination) + amInsertAfter, // insert node just after destionation (as sibling of destination) + amAddChildFirst, // add node as first child of destination + amAddChildLast // add node as last child of destination + ); + + // modes to determine drop position further + TDropMode = ( + dmNowhere, + dmAbove, + dmOnNode, + dmBelow + ); + + // operations basically allowed during drag'n drop + TDragOperation = ( + doCopy, + doMove, + doLink + ); + TDragOperations = set of TDragOperation; + + TVTImageKind = ( + ikNormal, + ikSelected, + ikState, + ikOverlay + ); + + { + Fine points: Observed when fixing issue #623 + -- hmHint allows multiline hints automatically if provided through OnGetHint event. + This is irresptive of whether node itself is multi-line or not. + + -- hmToolTip shows a hint only when node text is not fully shown. It's meant to + fully show node text when not visible. It will show multi-line hint only if + the node itself is multi-line. If you provide a custom multi-line hint then + you must force linebreak style to hlbForceMultiLine in the OnGetHint event + in order to show the complete hint. + } + TVTHintMode = ( + hmDefault, // show the hint of the control + hmHint, // show node specific hint string returned by the application + hmHintAndDefault, // same as hmHint but show the control's hint if no node is concerned + hmTooltip // show the text of the node if it isn't already fully shown + ); + + // Indicates how to format a tooltip. + TVTTooltipLineBreakStyle = ( + hlbDefault, // Use multi-line style of the node. + hlbForceSingleLine, // Use single line hint. + hlbForceMultiLine // Use multi line hint. + ); + + TMouseButtons = set of TMouseButton; + + // Used to describe the action to do when using the OnBeforeItemErase event. + TItemEraseAction = ( + eaColor, // Use the provided color to erase the background instead the one of the tree. + eaDefault, // The tree should erase the item's background (bitmap or solid). + eaNone // Do nothing. Let the application paint the background. + ); + + + // Kinds of operations + TVTOperationKind = ( + okAutoFitColumns, + okGetMaxColumnWidth, + okSortNode, + okSortTree, + okExport, + okExpand + ); + TVTOperationKinds = set of TVTOperationKind; + + // Indicates in the OnUpdating event what state the tree is currently in. + TVTUpdateState = ( + usBegin, // The tree just entered the update state (BeginUpdate call for the first time). + usBeginSynch, // The tree just entered the synch update state (BeginSynch call for the first time). + usSynch, // Begin/EndSynch has been called but the tree did not change the update state. + usUpdate, // Begin/EndUpdate has been called but the tree did not change the update state. + usEnd, // The tree just left the update state (EndUpdate called for the last level). + usEndSynch // The tree just left the synch update state (EndSynch called for the last level). + ); + + // These elements are used both to query the application, which of them it wants to draw itself and to tell it during + // painting, which elements must be drawn during the advanced custom draw events. + THeaderPaintElements = set of ( + hpeBackground, + hpeDropMark, + hpeHeaderGlyph, + hpeSortGlyph, + hpeText, + // New in 7.0: Use this in FOnHeaderDrawQueryElements and OnAdvancedHeaderDraw + // for additional custom header drawing while keeping the default drawing + hpeOverlay + ); + + // determines whether and how the drag image is to show + TVTDragImageKind = ( + diComplete, // show a complete drag image with all columns, only visible columns are shown + diMainColumnOnly, // show only the main column (the tree column) + diNoImage // don't show a drag image at all + ); + + // Switch for OLE and VCL drag'n drop. Because it is not possible to have both simultanously. + TVTDragType = ( + dtOLE, + dtVCL + ); + + // Determines the look of a tree's lines that show the hierarchy + TVTLineStyle = ( + lsCustomStyle, // application provides a line pattern + lsDotted, // usual dotted lines (default) + lsSolid // simple solid lines + ); + + // TVTLineType is used during painting a tree for its tree lines that show the hierarchy + TVTLineType = ( + ltNone, // no line at all + ltBottomRight, // a line from bottom to the center and from there to the right + ltTopDown, // a line from top to bottom + ltTopDownRight, // a line from top to bottom and from center to the right + ltRight, // a line from center to the right + ltTopRight, // a line from bottom to center and from there to the right + // special styles for alternative drawings of tree lines + ltLeft, // a line from top to bottom at the left + ltLeftBottom // a combination of ltLeft and a line at the bottom from left to right + ); + + // Determines how to draw tree lines. + TVTLineMode = ( + lmNormal, // usual tree lines (as in TTreeview) + lmBands // looks similar to a Nassi-Schneidermann diagram + ); + + // A collection of line type IDs which is used while painting a node. + TLineImage = array of TVTLineType; + + + // Export type + TVTExportType = ( + etNone, // No export, normal displaying on the screen + etRTF, // contentToRTF + etHTML, // contentToHTML + etText, // contentToText + etExcel, // supported by external tools + etWord, // supported by external tools + etPDF, // supported by external tools + etPrinter,// supported by external tools + etCSV, // supported by external tools + etCustom // supported by external tools + ); + + // Options which are used when modifying the scroll offsets. + TScrollUpdateOptions = set of ( + suoRepaintHeader, // if suoUpdateNCArea is also set then invalidate the header + suoRepaintScrollBars, // if suoUpdateNCArea is also set then repaint both scrollbars after updating them + suoScrollClientArea, // scroll and invalidate the proper part of the client area + suoUpdateNCArea // update non-client area (scrollbars, header) + ); + + // Determines the look of a tree's buttons. + TVTButtonStyle = ( + bsRectangle, // traditional Windows look (plus/minus buttons) + bsTriangle // traditional Macintosh look + ); + + // TButtonFillMode is only used when the button style is bsRectangle and determines how to fill the interior. + TVTButtonFillMode = ( + fmTreeColor, // solid color, uses the tree's background color + fmWindowColor, // solid color, uses clWindow + fmShaded, // no longer supported, use toThemeAware for Windows XP and later instead + fmTransparent // transparent color, use the item's background color + ); + + // Method called by the Animate routine for each animation step. + TVTAnimationCallback = function(Step, StepSize: Integer; Data: Pointer): Boolean of object; + + TVTIncrementalSearch = ( + isAll, // search every node in tree, initialize if necessary + isNone, // disable incremental search + isInitializedOnly, // search only initialized nodes, skip others + isVisibleOnly // search only visible nodes, initialize if necessary + ); + + // Determines which direction to use when advancing nodes during an incremental search. + TVTSearchDirection = ( + sdForward, + sdBackward + ); + + // Determines where to start incremental searching for each key press. + TVTSearchStart = ( + ssAlwaysStartOver, // always use the first/last node (depending on direction) to search from + ssLastHit, // use the last found node + ssFocusedNode // use the currently focused node + ); + + // Determines how to use the align member of a node. + TVTNodeAlignment = ( + naFromBottom, // the align member specifies amount of units (usually pixels) from top border of the node + naFromTop, // align is to be measured from bottom + naProportional // align is to be measure in percent of the entire node height and relative to top + ); + + // Determines how to draw the selection rectangle used for draw selection. + TVTDrawSelectionMode = ( + smDottedRectangle, // same as DrawFocusRect + smBlendedRectangle // alpha blending, uses special colors (see TVTColors) + ); + + // Determines for which purpose the cell paint event is called. + TVTCellPaintMode = ( + cpmPaint, // painting the cell + cpmGetContentMargin // getting cell content margin + ); + + // Determines which sides of the cell content margin should be considered. + TVTCellContentMarginType = ( + ccmtAllSides, // consider all sides + ccmtTopLeftOnly, // consider top margin and left margin only + ccmtBottomRightOnly // consider bottom margin and right margin only + ); + + TChangeReason = ( + crIgnore, // used as placeholder + crAccumulated, // used for delayed changes + crChildAdded, // one or more child nodes have been added + crChildDeleted, // one or more child nodes have been deleted + crNodeAdded, // a node has been added + crNodeCopied, // a node has been duplicated + crNodeMoved // a node has been moved to a new place + ); // desribes what made a structure change event happen + + TChunkHeader = record + ChunkType, + ChunkSize: Integer; // contains the size of the chunk excluding the header + end; + +const + DefaultPaintOptions = [toShowButtons, toShowDropmark, toShowTreeLines, toShowRoot, toThemeAware, toUseBlendedImages, toFullVertGridLines]; + DefaultAnimationOptions = []; + DefaultAutoOptions = [toAutoDropExpand, toAutoTristateTracking, toAutoScrollOnExpand, toAutoDeleteMovedNodes, toAutoChangeScale, toAutoSort, toAutoHideButtons]; + DefaultSelectionOptions = [toSelectNextNodeOnRemoval]; + DefaultMiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick]; + + DefaultStringOptions = [toSaveCaptions, toAutoAcceptEditChange]; + +type + TCustomVirtualTreeOptions = class(TPersistent) + private + FOwner : TCustomControl; + FPaintOptions : TVTPaintOptions; + FAnimationOptions : TVTAnimationOptions; + FAutoOptions : TVTAutoOptions; + FSelectionOptions : TVTSelectionOptions; + FMiscOptions : TVTMiscOptions; + FExportMode : TVTExportMode; + FEditOptions : TVTEditOptions; + procedure SetAnimationOptions(const Value : TVTAnimationOptions); + procedure SetAutoOptions(const Value : TVTAutoOptions); + procedure SetMiscOptions(const Value : TVTMiscOptions); + procedure SetPaintOptions(const Value : TVTPaintOptions); + procedure SetSelectionOptions(const Value : TVTSelectionOptions); + protected + // Mitigator function to use the correct style service for this context (either the style assigned to the control for Delphi > 10.4 or the application style) + function StyleServices(AControl : TControl = nil) : TCustomStyleServices; + public + constructor Create(AOwner : TCustomControl); virtual; + //these bypass the side effects in the regular setters. + procedure InternalSetMiscOptions(const Value : TVTMiscOptions); + + procedure AssignTo(Dest : TPersistent); override; + property AnimationOptions : TVTAnimationOptions read FAnimationOptions write SetAnimationOptions default DefaultAnimationOptions; + property AutoOptions : TVTAutoOptions read FAutoOptions write SetAutoOptions default DefaultAutoOptions; + property ExportMode : TVTExportMode read FExportMode write FExportMode default emAll; + property MiscOptions : TVTMiscOptions read FMiscOptions write SetMiscOptions default DefaultMiscOptions; + property PaintOptions : TVTPaintOptions read FPaintOptions write SetPaintOptions default DefaultPaintOptions; + property SelectionOptions : TVTSelectionOptions read FSelectionOptions write SetSelectionOptions default DefaultSelectionOptions; + property EditOptions : TVTEditOptions read FEditOptions write FEditOptions default toDefaultEdit; + + property Owner: TCustomControl read FOwner; + end; + + TTreeOptionsClass = class of TCustomVirtualTreeOptions; + + TVirtualTreeOptions = class(TCustomVirtualTreeOptions) + published + property AnimationOptions; + property AutoOptions; + property ExportMode; + property MiscOptions; + property PaintOptions; + property SelectionOptions; + end; + + TCustomStringTreeOptions = class(TCustomVirtualTreeOptions) + private + FStringOptions : TVTStringOptions; + procedure SetStringOptions(const Value : TVTStringOptions); + protected + public + constructor Create(AOwner : TCustomControl); override; + procedure AssignTo(Dest : TPersistent); override; + property StringOptions : TVTStringOptions read FStringOptions write SetStringOptions default DefaultStringOptions; + end; + + TStringTreeOptions = class(TCustomStringTreeOptions) + published + property AnimationOptions; + property AutoOptions; + property ExportMode; + property MiscOptions; + property PaintOptions; + property SelectionOptions; + property StringOptions; + property EditOptions; + end; + + TScrollBarStyle = ( + sbmRegular, + sbm3D + ); + + // A class to manage scroll bar aspects. + TScrollBarOptions = class(TPersistent) + private + FAlwaysVisible : Boolean; + FOwner : TCustomControl; + FScrollBars : TScrollStyle; // used to hide or show vertical and/or horizontal scrollbar + FScrollBarStyle : TScrollBarStyle; // kind of scrollbars to use + FIncrementX, FIncrementY : TVTScrollIncrement; // number of pixels to scroll in one step (when auto scrolling) + procedure SetAlwaysVisible(Value : Boolean); + procedure SetScrollBars(Value : TScrollStyle); + procedure SetScrollBarStyle(Value : TScrollBarStyle); + protected + function GetOwner : TPersistent; override; + public + constructor Create(AOwner : TCustomControl); + + procedure Assign(Source : TPersistent); override; + published + property AlwaysVisible : Boolean read FAlwaysVisible write SetAlwaysVisible default False; + property HorizontalIncrement : TVTScrollIncrement read FIncrementX write FIncrementX default 20; + property ScrollBars : TScrollStyle read FScrollBars write SetScrollBars default TScrollStyle.ssBoth; + property ScrollBarStyle : TScrollBarStyle read FScrollBarStyle write SetScrollBarStyle default sbmRegular; + property VerticalIncrement : TVTScrollIncrement read FIncrementY write FIncrementY default 20; + end; + + PVirtualNode = ^TVirtualNode; + + TVirtualNode = packed record + private + fIndex: Cardinal; // index of node with regard to its parent + fChildCount: Cardinal; // number of child nodes + fNodeHeight: TNodeHeight; // height in pixels + public + States: TVirtualNodeStates; // states describing various properties of the node (expanded, initialized etc.) + Align: Byte; // line/button alignment + CheckState: TCheckState; // indicates the current check state (e.g. checked, pressed etc.) + 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: 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 + // data) then put them before field Parent. + private + fParent: PVirtualNode; // reference to the node's parent (for the root this contains the treeview) + fPrevSibling: PVirtualNode; // link to the node's previous sibling or nil if it is the first node + fNextSibling: PVirtualNode; // link to the node's next sibling or nil if it is the last node + public // still public as it is used as var parameter in MergeSortAscending() + FirstChild: PVirtualNode; // link to the node's first child... + private + fLastChild: PVirtualNode; // link to the node's last child... + public + procedure SetParent(const pParent: PVirtualNode); inline; //internal method, do not call directly but use Parent[Node] := x on tree control. + procedure SetPrevSibling(const pPrevSibling: PVirtualNode); inline; //internal method, do not call directly + procedure SetNextSibling(const pNextSibling: PVirtualNode); inline; //internal method, do not call directly + procedure SetFirstChild(const pFirstChild: PVirtualNode); inline; //internal method, do not call directly + 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: 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: TNodeHeight read fNodeHeight; + private + Data: record end; // this is a placeholder, each node gets extra data determined by NodeDataSize + public + function IsAssigned(): Boolean; inline; + function GetData(): Pointer; overload; inline; + function GetData(): T; overload; inline; + procedure SetData(pUserData: Pointer); overload; + procedure SetData(pUserData: T); overload; + procedure SetData(const pUserData: IInterface); overload; + end; + + + TVTHeaderColumnLayout = ( + blGlyphLeft, + blGlyphRight, + blGlyphTop, + blGlyphBottom + ); + + // These flags are used to indicate where a click in the header happened. + TVTHeaderHitPosition = ( + hhiNoWhere, // No column is involved (possible only if the tree is smaller than the client area). + hhiOnColumn, // On a column. + hhiOnIcon, // On the bitmap associated with a column. + hhiOnCheckbox // On the checkbox if enabled. + ); + TVTHeaderHitPositions = set of TVTHeaderHitPosition; + + // These flags are returned by the hit test method. + THitPosition = ( + hiAbove, // above the client area (if relative) or the absolute tree area + hiBelow, // below the client area (if relative) or the absolute tree area + hiNowhere, // no node is involved (possible only if the tree is not as tall as the client area) + hiOnItem, // on the bitmaps/buttons or label associated with an item + hiOnItemButton, // on the button associated with an item + hiOnItemButtonExact, // exactly on the button associated with an item + hiOnItemCheckbox, // on the checkbox if enabled + hiOnItemIndent, // in the indentation area in front of a node + hiOnItemLabel, // on the normal text area associated with an item + hiOnItemLeft, // in the area to the left of a node's text area (e.g. when right aligned or centered) + hiOnItemRight, // in the area to the right of a node's text area (e.g. if left aligned or centered) + hiOnNormalIcon, // on the "normal" image + hiOnStateIcon, // on the state image + hiToLeft, // to the left of the client area (if relative) or the absolute tree area + hiToRight, // to the right of the client area (if relative) or the absolute tree area + hiUpperSplitter, // in the upper splitter area of a node + hiLowerSplitter // in the lower splitter area of a node + ); + THitPositions = set of THitPosition; + + // Structure used when info about a certain position in the header is needed. + TVTHeaderHitInfo = record + X, + Y: TDimension; + Button: TMouseButton; + Shift: TShiftState; + Column: TColumnIndex; + HitPosition: TVTHeaderHitPositions; + end; + + // Structure used when info about a certain position in the tree is needed. + THitInfo = record + HitNode: PVirtualNode; + HitPositions: THitPositions; + HitColumn: TColumnIndex; + HitPoint: TPoint; + ShiftState: TShiftState; + end; + + // A representation of a single cell (node + column) + PVTCell = ^TVTCell; + TVTCell = record + Node: PVirtualNode; + Column: TColumnIndex; + constructor Create(ANode: PVirtualNode; AColumn: TColumnIndex); + end; + + TVTCellArray = array of TVTCell; + + TVTHeaderStyle = ( + hsThickButtons, //TButton look and feel + hsFlatButtons, //flatter look than hsThickButton, like an always raised flat TToolButton + hsPlates //flat TToolButton look and feel (raise on hover etc.) + ); + + TVTHeaderOption = ( + hoAutoResize, //Adjust a column so that the header never exceeds the client width of the owner control. + hoColumnResize, //Resizing columns with the mouse is allowed. + hoDblClickResize, //Allows a column to resize itself to its largest entry. + hoDrag, //Dragging columns is allowed. + hoHotTrack, //Header captions are highlighted when mouse is over a particular column. + hoOwnerDraw, //Header items with the owner draw style can be drawn by the application via event. + hoRestrictDrag, //Header can only be dragged horizontally. + hoShowHint, //Show application defined header hint. + hoShowImages, //Show header images. + hoShowSortGlyphs, //Allow visible sort glyphs. + hoVisible, //Header is visible. + hoAutoSpring, //Distribute size changes of the header to all columns, which are sizable and have the coAutoSpring option enabled. + hoFullRepaintOnResize, //Fully invalidate the header (instead of subsequent columns only) when a column is resized. + hoDisableAnimatedResize, //Disable animated resize for all columns. + hoHeightResize, //Allow resizing header height via mouse. + hoHeightDblClickResize, //Allow the header to resize itself to its default height. + hoHeaderClickAutoSort, //Clicks on the header will make the clicked column the SortColumn or toggle sort direction if it already was the sort column + hoAutoColumnPopupMenu, //Show a context menu for activating and deactivating columns on right click + hoAutoResizeInclCaption //Includes the header caption for the auto resizing + ); + TVTHeaderOptions = set of TVTHeaderOption; + + THeaderState = ( + hsAutoSizing, //auto size chain is in progess, do not trigger again on WM_SIZE + hsDragging, //header dragging is in progress (only if enabled) + hsDragPending, //left button is down, user might want to start dragging a column + hsLoading, //The header currently loads from stream, so updates are not necessary. + hsColumnWidthTracking, //column resizing is in progress + hsColumnWidthTrackPending, //left button is down, user might want to start resize a column + hsHeightTracking, //height resizing is in progress + hsHeightTrackPending, //left button is down, user might want to start changing height + hsResizing, //multi column resizing in progress + hsScaling, //the header is scaled after a change of FixedAreaConstraints or client size + hsNeedScaling //the header needs to be scaled + ); + THeaderStates = set of THeaderState; + + // content elements of the control from left to right, used when calculatin left margins. + TVTElement = ( + ofsMargin, // right of the margin + ofsToggleButton, // the exact x-postition of the toggle button + ofsCheckBox, + ofsStateImage, + ofsImage, + ofsLabel, // where drawing a selection begins + ofsText, // includes TextMargin + ofsRightOfText, // Includes NodeWidth and ExtraNodeWidth + ofsEndOfClientArea // The end of the paint area + ); + + /// An array that can be used to calculate the offsets ofthe elements in the tree. + TVTOffsets = array [TVTElement] of TDimension; + + // For painting a node and its columns/cells a lot of information must be passed frequently around. + TVTImageInfo = record + Index: TImageIndex; // Index in the associated image list. + XPos, // Horizontal position in the current target canvas. + YPos: TDimension; // Vertical position in the current target canvas. + Ghosted: Boolean; // Flag to indicate that the image must be drawn slightly lighter. + Images: TCustomImageList; // The image list to be used for painting. + function Equals(const pImageInfo2: TVTImageInfo): Boolean; + end; + + TVTImageInfoIndex = ( + iiNormal, + iiState, + iiCheck, + iiOverlay + ); + + // options which determine what to draw in PaintTree + TVTInternalPaintOption = ( + poBackground, // draw background image if there is any and it is enabled + poColumnColor, // erase node's background with the column's color + poDrawFocusRect, // draw focus rectangle around the focused node + poDrawSelection, // draw selected nodes with the normal selection color + poDrawDropMark, // draw drop mark if a node is currently the drop target + poGridLines, // draw grid lines if enabled + poMainOnly, // draw only the main column + poSelectedOnly, // draw only selected nodes + poUnbuffered // draw directly onto the target canvas; especially useful when printing + ); + TVTInternalPaintOptions = set of TVTInternalPaintOption; + + TVTPaintInfo = record + Canvas: TCanvas; // the canvas to paint on + PaintOptions: TVTInternalPaintOptions; // a copy of the paint options passed to PaintTree + Node: PVirtualNode; // the node to paint + Column: TColumnIndex; // the node's column index to paint + Position: TColumnPosition; // the column position of the node + CellRect: TRect; // the node cell + ContentRect: TRect; // the area of the cell used for the node's content + NodeWidth: TDimension; // the actual node width + Alignment: TAlignment; // how to align within the node rectangle + CaptionAlignment: TAlignment; // how to align text within the caption rectangle + BidiMode: TBidiMode; // directionality to be used for painting + BrushOrigin: TPoint; // the alignment for the brush used to draw dotted lines + ImageInfo: array[TVTImageInfoIndex] of TVTImageInfo; // info about each possible node image + Offsets: TVTOffsets; // The offsets of the various elements of a tree node + VAlign: TDimension; + procedure AdjustImageCoordinates(); + end; + + TNodeArray = array of PVirtualNode; + +implementation + +uses + System.TypInfo, + VirtualTrees.StyleHooks, + VirtualTrees.BaseTree, + VirtualTrees.BaseAncestorVcl{to eliminate H2443 about inline expanding} + ; + +type + TVTCracker = class(TBaseVirtualTree); + + +{ TVirtualNode } + +function TVirtualNode.GetData(): Pointer; + +// Returns the associated data converted to the class given in the generic part of the function. + +begin + Result := @Self.Data; + Include(States, vsOnFreeNodeCallRequired); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualNode.GetData: T; + +// Returns the associated data converted to the class given in the generic part of the function. + +begin + Result := T(Pointer((PByte(@(Self.Data))))^); + Include(States, vsOnFreeNodeCallRequired); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TVirtualNode.IsAssigned: Boolean; + +// Returns False if this node is nil, True otherwise + +begin + Exit(@Self <> nil); +end; + +procedure TVirtualNode.SetNodeHeight(const pNodeHeight: TNodeHeight); +begin + fNodeHeight := pNodeHeight; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualNode.SetData(pUserData: Pointer); + + + // Can be used to set user data of a PVirtualNode with the size of a pointer, useful for setting + // A pointer to a record or a reference to a class instance. +var + NodeData: PPointer; +begin + NodeData := PPointer(@Self.Data); + NodeData^ := pUserData; + Include(Self.States, vsOnFreeNodeCallRequired); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualNode.SetChildCount(const pCount: Cardinal); +begin + fChildCount := pCount; +end; + +procedure TVirtualNode.SetData(const pUserData: IInterface); + + + // Can be used to set user data of a PVirtualNode to a class instance, + // will take care about reference counting. + +begin + pUserData._AddRef(); + SetData(Pointer(pUserData)); + Include(Self.States, vsReleaseCallOnUserDataRequired); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TVirtualNode.SetData(pUserData: T); + +begin + T(Pointer((PByte(@(Self.Data))))^) := pUserData; + if PTypeInfo(TypeInfo(T)).Kind = tkInterface then + Include(Self.States, vsReleaseCallOnUserDataRequired); + Include(Self.States, vsOnFreeNodeCallRequired); +end; + +procedure TVirtualNode.SetFirstChild(const pFirstChild: PVirtualNode); +begin + FirstChild := pFirstChild; +end; + +procedure TVirtualNode.SetLastChild(const pLastChild: PVirtualNode); +begin + fLastChild := pLastChild; +end; + +procedure TVirtualNode.SetIndex(const pIndex: Cardinal); +begin + fIndex := pIndex; +end; + +procedure TVirtualNode.SetParent(const pParent: PVirtualNode); +begin + fParent := pParent; +end; + +procedure TVirtualNode.SetPrevSibling(const pPrevSibling: PVirtualNode); +begin + fPrevSibling := pPrevSibling; +end; + +procedure TVirtualNode.SetNextSibling(const pNextSibling: PVirtualNode); +begin + fNextSibling := pNextSibling; +end; + +//---------------------------------------------------------------------------------------------------------------------- + + +{ TVTImageInfo } + +function TVTImageInfo.Equals(const pImageInfo2: TVTImageInfo): Boolean; + + // Returns true if both images are the same, does not regard Ghosted and position. + +begin + Result := (Self.Index = pImageInfo2.Index) and (Self.Images = pImageInfo2.Images); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +{ TVTPaintInfo } + +procedure TVTPaintInfo.AdjustImageCoordinates(); +// During painting of the main column some coordinates must be adjusted due to the tree lines. +begin + ContentRect := CellRect; + if BidiMode = bdLeftToRight then + begin + ContentRect.Left := CellRect.Left + Offsets[TVTElement.ofsLabel]; + ImageInfo[iiNormal].XPos := CellRect.Left + Offsets[TVTElement.ofsImage]; + ImageInfo[iiState].XPos := CellRect.Left + Offsets[TVTElement.ofsStateImage]; + ImageInfo[iiCheck].XPos := CellRect.Left + Offsets[TVTElement.ofsCheckBox]; + end + else + begin + /// Since images are still drawn from left to right, we need to substract the image sze as well. + ImageInfo[iiNormal].XPos := CellRect.Right - Offsets[TVTElement.ofsImage] - (Offsets[TVTElement.ofsLabel] - Offsets[TVTElement.ofsImage]); + ImageInfo[iiState].XPos := CellRect.Right - Offsets[TVTElement.ofsStateImage] - (Offsets[TVTElement.ofsImage] - Offsets[TVTElement.ofsStateImage]); + ImageInfo[iiCheck].XPos := CellRect.Right - Offsets[TVTElement.ofsCheckBox] - (Offsets[TVTElement.ofsStateImage] - Offsets[TVTElement.ofsCheckBox]); + ContentRect.Right := CellRect.Right - Offsets[TVTElement.ofsLabel]; + end; + if ImageInfo[iiNormal].Index > -1 then + ImageInfo[iiNormal].YPos := CellRect.Top + VAlign - ImageInfo[iiNormal].Images.Height div 2; + if ImageInfo[iiState].Index > -1 then + ImageInfo[iiState].YPos := CellRect.Top + VAlign - ImageInfo[iiState].Images.Height div 2; + if ImageInfo[iiCheck].Index > -1 then + ImageInfo[iiCheck].YPos := CellRect.Top + VAlign - ImageInfo[iiCheck].Images.Height div 2; +end; + + +//----------------- TCustomVirtualTreeOptions -------------------------------------------------------------------------- + +constructor TCustomVirtualTreeOptions.Create(AOwner : TCustomControl); +begin + FOwner := AOwner; + + FPaintOptions := DefaultPaintOptions; + FAnimationOptions := DefaultAnimationOptions; + FAutoOptions := DefaultAutoOptions; + FSelectionOptions := DefaultSelectionOptions; + FMiscOptions := DefaultMiscOptions; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCustomVirtualTreeOptions.SetAnimationOptions(const Value : TVTAnimationOptions); +begin + FAnimationOptions := Value; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCustomVirtualTreeOptions.SetAutoOptions(const Value : TVTAutoOptions); +var + ChangedOptions : TVTAutoOptions; +begin + if FAutoOptions <> Value then + begin + // Exclusive ORing to get all entries wich are in either set but not in both. + ChangedOptions := FAutoOptions + Value - (FAutoOptions * Value); + FAutoOptions := Value; + with FOwner do + if (toAutoSpanColumns in ChangedOptions) and not (csLoading in ComponentState) and HandleAllocated then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCustomVirtualTreeOptions.InternalSetMiscOptions(const Value : TVTMiscOptions); +begin + FMiscOptions := Value; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCustomVirtualTreeOptions.SetMiscOptions(const Value : TVTMiscOptions); +var + ToBeSet, ToBeCleared : TVTMiscOptions; +begin + if FMiscOptions <> Value then + begin + ToBeSet := Value - FMiscOptions; + ToBeCleared := FMiscOptions - Value; + FMiscOptions := Value; + + with TVTCracker(FOwner) do + if not (csLoading in ComponentState) and HandleAllocated then + begin + if toCheckSupport in ToBeSet + ToBeCleared then + Invalidate; + if toEditOnDblClick in ToBeSet then + FMiscOptions := FMiscOptions - [toToggleOnDblClick]; + // In order for toEditOnDblClick to take effect, we need to remove toToggleOnDblClick which is handled with priority. See issue #747 + + if not (csDesigning in ComponentState) then + begin + if toFullRepaintOnResize in ToBeSet + ToBeCleared then + RecreateWnd; + if toVariableNodeHeight in ToBeSet then + begin + BeginUpdate(); + try + ReInitNode(nil, True); + finally + EndUpdate(); + end; //try..finally + end; //if toVariableNodeHeight + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCustomVirtualTreeOptions.SetPaintOptions(const Value : TVTPaintOptions); +var + ToBeSet, ToBeCleared : TVTPaintOptions; + Run : PVirtualNode; + HandleWasAllocated : Boolean; +begin + if FPaintOptions <> Value then + begin + ToBeSet := Value - FPaintOptions; + ToBeCleared := FPaintOptions - Value; + FPaintOptions := Value; + if (toFixedIndent in ToBeSet) then + begin + // Fixes issue #388 + Include(FPaintOptions, toShowRoot); + Include(ToBeSet, toShowRoot); + end; //if + with TVTCracker(FOwner) do + begin + HandleWasAllocated := HandleAllocated; + + if not (csLoading in ComponentState) and (toShowFilteredNodes in ToBeSet + ToBeCleared) then + begin + if HandleWasAllocated then + BeginUpdate; + InterruptValidation; + Run := GetFirstNoInit; + while Assigned(Run) do + begin + if (vsFiltered in Run.States) then + begin + if FullyVisible[Run] then + begin + if toShowFilteredNodes in ToBeSet then + IncVisibleCount + else + DecVisibleCount; + end; + if toShowFilteredNodes in ToBeSet then + AdjustTotalHeight(Run, Run.NodeHeight, True) + else + AdjustTotalHeight(Run, - Run.NodeHeight, True); + end; + Run := GetNextNoInit(Run); + end; + if HandleWasAllocated then + EndUpdate; + end; + + if HandleAllocated then + begin + if ((tsUseThemes in TreeStates) or ((toThemeAware in ToBeSet) and StyleServices.Enabled)) and (toUseExplorerTheme in (ToBeSet + ToBeCleared)) and + not VclStyleEnabled then + begin + if (toUseExplorerTheme in ToBeSet) then + begin + SetWindowTheme('explorer'); + DoStateChange([tsUseExplorerTheme]); + end + else if toUseExplorerTheme in ToBeCleared then + begin + SetWindowTheme(''); + DoStateChange([], [tsUseExplorerTheme]); + end; + end; + + if not (csLoading in ComponentState) then + begin + if ((toThemeAware in ToBeSet + ToBeCleared) or (toUseExplorerTheme in ToBeSet + ToBeCleared) or VclStyleEnabled) then + begin + if ((toThemeAware in ToBeSet) and StyleServices.Enabled) then + DoStateChange([tsUseThemes]) + else if (toThemeAware in ToBeCleared) then + DoStateChange([], [tsUseThemes]); + + PrepareBitmaps(True, False); + RedrawWindow(nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME); + end; + + if toChildrenAbove in ToBeSet + ToBeCleared then + begin + InvalidateCache; + if UpdateCount = 0 then + begin + ValidateCache; + Invalidate; + end; + end; + + Invalidate; + end; + end; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCustomVirtualTreeOptions.SetSelectionOptions(const Value : TVTSelectionOptions); +var + ToBeSet, ToBeCleared : TVTSelectionOptions; +begin + if FSelectionOptions <> Value then + begin + ToBeSet := Value - FSelectionOptions; + ToBeCleared := FSelectionOptions - Value; + FSelectionOptions := Value; + + with TVTCracker(FOwner) do + begin + if (toMultiSelect in (ToBeCleared + ToBeSet)) or ([toLevelSelectConstraint, toSiblingSelectConstraint] * ToBeSet <> []) then + ClearSelection; + + // Clear multicell selection when toFullRowSelect is going to be set or + // when a combination of toExtendedFocus, toMultiSelect, toMultiCellSelect is cleared + if (toFullRowSelect in ToBeSet) or ([toExtendedFocus, toMultiSelect, toMultiCellSelect] * ToBeCleared <> []) then + ClearCellSelection; + + if (toExtendedFocus in ToBeCleared) and (FocusedColumn > 0) and HandleAllocated then + begin + FocusedColumn := Header.MainColumn; + Invalidate; + // Also clear multicell selection when toExtendedFocus is removed + ClearCellSelection; + end; + + if not (toExtendedFocus in FSelectionOptions) then + FocusedColumn := Header.MainColumn; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCustomVirtualTreeOptions.StyleServices(AControl : TControl) : TCustomStyleServices; +begin + Result := VTStyleServices(FOwner); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCustomVirtualTreeOptions.AssignTo(Dest : TPersistent); +begin + if Dest is TCustomVirtualTreeOptions then + begin + with Dest as TCustomVirtualTreeOptions do + begin + PaintOptions := Self.PaintOptions; + AnimationOptions := Self.AnimationOptions; + AutoOptions := Self.AutoOptions; + SelectionOptions := Self.SelectionOptions; + MiscOptions := Self.MiscOptions; + end; + end + else + inherited; +end; + +//----------------- TCustomStringTreeOptions --------------------------------------------------------------------------- + +constructor TCustomStringTreeOptions.Create(AOwner : TCustomControl); +begin + inherited; + FStringOptions := DefaultStringOptions; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCustomStringTreeOptions.SetStringOptions(const Value : TVTStringOptions); +var + ChangedOptions : TVTStringOptions; +begin + if FStringOptions <> Value then + begin + // Exclusive ORing to get all entries wich are in either set but not in both. + ChangedOptions := FStringOptions + Value - (FStringOptions * Value); + FStringOptions := Value; + with FOwner do + if (toShowStaticText in ChangedOptions) and not (csLoading in ComponentState) and HandleAllocated then + Invalidate; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TCustomStringTreeOptions.AssignTo(Dest : TPersistent); +begin + if Dest is TCustomStringTreeOptions then + begin + with Dest as TCustomStringTreeOptions do + begin + StringOptions := Self.StringOptions; + EditOptions := Self.EditOptions; + end; + end; + + // Let ancestors assign their options to the destination class. + inherited; +end; + +//----------------- TScrollBarOptions ---------------------------------------------------------------------------------- + +constructor TScrollBarOptions.Create(AOwner : TCustomControl); +begin + inherited Create; + + FOwner := AOwner; + FAlwaysVisible := False; + FScrollBarStyle := sbmRegular; + FScrollBars := TScrollStyle.ssBoth; + FIncrementX := 20; + FIncrementY := 20; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TScrollBarOptions.SetAlwaysVisible(Value : Boolean); +begin + if FAlwaysVisible <> Value then + begin + FAlwaysVisible := Value; + if not (csLoading in FOwner.ComponentState) and FOwner.HandleAllocated then + TVTCracker(FOwner).RecreateWnd; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TScrollBarOptions.SetScrollBars(Value : TScrollStyle); +begin + if FScrollBars <> Value then + begin + FScrollBars := Value; + if not (csLoading in FOwner.ComponentState) and FOwner.HandleAllocated then + TVTCracker(FOwner).RecreateWnd; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TScrollBarOptions.SetScrollBarStyle(Value : TScrollBarStyle); + +begin + if FScrollBarStyle <> Value then + begin + FScrollBarStyle := Value; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TScrollBarOptions.GetOwner : TPersistent; + +begin + Result := FOwner; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure TScrollBarOptions.Assign(Source : TPersistent); + +begin + if Source is TScrollBarOptions then + begin + AlwaysVisible := TScrollBarOptions(Source).AlwaysVisible; + HorizontalIncrement := TScrollBarOptions(Source).HorizontalIncrement; + ScrollBars := TScrollBarOptions(Source).ScrollBars; + ScrollBarStyle := TScrollBarOptions(Source).ScrollBarStyle; + VerticalIncrement := TScrollBarOptions(Source).VerticalIncrement; + end + else + inherited; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +{ TCheckStateHelper } + +function TCheckStateHelper.IsDisabled: Boolean; +begin + Result := Self >= TCheckState.csUncheckedDisabled; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCheckStateHelper.IsChecked: Boolean; +begin + Result := Self in [csCheckedNormal, csCheckedPressed, csCheckedDisabled]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCheckStateHelper.IsUnChecked: Boolean; +begin + Result := Self in [csUncheckedNormal, csUncheckedPressed, csUncheckedDisabled]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCheckStateHelper.IsMixed: Boolean; +begin + Result := Self in [csMixedNormal, csMixedPressed, csMixedDisabled]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCheckStateHelper.GetEnabled: TCheckState; +begin + Result := cEnabledState[Self]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCheckStateHelper.GetPressed(): TCheckState; +begin + Result := cPressedState[Self]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCheckStateHelper.GetUnpressed(): TCheckState; +begin + Result := cUnpressedState[Self]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TCheckStateHelper.GetToggled(): TCheckState; +begin + Result := cToggledState[Self]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +{ TSortDirectionHelper } + +function TSortDirectionHelper.ToInt() : Integer; +begin + Result := cSortDirectionToInt[Self]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +{ TVTCell } + +constructor TVTCell.Create(ANode: PVirtualNode; AColumn: TColumnIndex); +begin + Node := ANode; + Column := AColumn; +end; + +end. diff --git a/Source/VirtualTrees.Utils.pas b/Source/VirtualTrees.Utils.pas index 0696e2e84..cd276078c 100644 --- a/Source/VirtualTrees.Utils.pas +++ b/Source/VirtualTrees.Utils.pas @@ -1,113 +1,159 @@ -unit VirtualTrees.Utils; - -// The contents of this file are subject to the Mozilla Public License -// Version 1.1 (the "License"); you may not use this file except in compliance -// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ -// -// Alternatively, you may redistribute this library, use and/or modify it under the terms of the -// GNU Lesser General Public License as published by the Free Software Foundation; -// either version 2.1 of the License, or (at your option) any later version. -// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/. -// -// Software distributed under the License is distributed on an "AS IS" basis, -// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the -// specific language governing rights and limitations under the License. -// -// The original code is VirtualTrees.pas, released September 30, 2000. -// -// The initial developer of the original code is digital publishing AG (Munich, Germany, www.digitalpublishing.de), -// written by Mike Lischke (public@soft-gems.net, www.soft-gems.net). -// -// Portions created by digital publishing AG are Copyright -// (C) 1999-2001 digital publishing AG. All Rights Reserved. -//---------------------------------------------------------------------------------------------------------------------- - -interface - -{$WARN UNSAFE_TYPE OFF} -{$WARN UNSAFE_CAST OFF} -{$WARN UNSAFE_CODE OFF} - -uses - Winapi.Windows, - Winapi.ActiveX, - System.Types, - Vcl.Graphics, - Vcl.ImgList, - Vcl.Controls; - - -type - // Describes the mode how to blend pixels. - TBlendMode = ( - bmConstantAlpha, // apply given constant alpha - bmPerPixelAlpha, // use alpha value of the source pixel - bmMasterAlpha, // use alpha value of source pixel and multiply it with the constant alpha value - bmConstantAlphaAndColor // blend the destination color with the given constant color und the constant alpha value - ); - -procedure AlphaBlend(Source, Destination: HDC; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); -function GetRGBColor(Value: TColor): DWORD; -procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap); - -procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer); inline; - - -procedure SetCanvasOrigin(Canvas: TCanvas; X, Y: Integer); inline; - -// Clip a given canvas to ClipRect while transforming the given rect to device coordinates. -procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0); - -procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean); - - -// Adjusts the given string S so that it fits into the given width. EllipsisWidth gives the width of -// the three points to be added to the shorted string. If this value is 0 then it will be determined implicitely. -// For higher speed (and multiple entries to be shorted) specify this value explicitely. -function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: Integer = 0): string; - -// Wrap the given string S so that it fits into a space of given width. -// RTL determines if right-to-left reading is active. -function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; - -// Calculates bounds of a drawing rectangle for the given string -procedure GetStringDrawRect(DC: HDC; const S: string; var Bounds: TRect; DrawFormat: Cardinal); - -// Converts the incoming rectangle so that left and top are always less than or equal to right and bottom. -function OrderRect(const R: TRect): TRect; - -// Fills the given rectangles with values which can be used while dragging around an image -// (used in DragMove of the drag manager and DragTo of the header columns). -procedure FillDragRectangles(DragWidth, DragHeight, DeltaX, DeltaY: Integer; var RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2: TRect); - -// Attaches a bitmap as drag image to an IDataObject, see issue #405 -// Usage: Set property DragImageKind to diNoImage, in your event handler OnCreateDataObject -// call VirtualTrees.Utils.ApplyDragImage() with your `IDataObject` and your bitmap. -procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap); - -/// Returns True if the mouse cursor is currently visible and False in case it is suppressed. -/// Useful when doing hot-tracking on touchscreens, see issue #766 -function IsMouseCursorVisible(): Boolean; - -procedure ScaleImageList(const ImgList: TImageList; M, D: Integer); - -/// Returns True if the high contrast theme is anabled in the system settings, False otherwise. -function IsHighContrastEnabled(): Boolean; - - -implementation - -uses - Winapi.CommCtrl, - Winapi.ShlObj, - System.SysUtils, - System.StrUtils, - System.Math; - -const - WideLF = Char(#10); - -procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap); +unit VirtualTrees.Utils; + +// The contents of this file are subject to the Mozilla Public License +// Version 1.1 (the "License"); you may not use this file except in compliance +// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ +// +// Alternatively, you may redistribute this library, use and/or modify it under the terms of the +// GNU Lesser General Public License as published by the Free Software Foundation; +// either version 2.1 of the License, or (at your option) any later version. +// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/. +// +// Software distributed under the License is distributed on an "AS IS" basis, +// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the +// specific language governing rights and limitations under the License. +// +// The original code is VirtualTrees.pas, released September 30, 2000. +// +// The initial developer of the original code is digital publishing AG (Munich, Germany, www.digitalpublishing.de), +// written by Mike Lischke (public@soft-gems.net, www.soft-gems.net). +// +// Portions created by digital publishing AG are Copyright +// (C) 1999-2001 digital publishing AG. All Rights Reserved. +//---------------------------------------------------------------------------------------------------------------------- + +interface + +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CAST OFF} +{$WARN UNSAFE_CODE OFF} + +uses + Winapi.Windows, + Winapi.ActiveX, + System.Types, + Vcl.Graphics, + Vcl.ImgList, + Vcl.Controls, + VirtualTrees.Types; + +type + /// + /// Describes the mode how to blend pixels. + /// + TBlendMode = ( + bmConstantAlpha, // apply given constant alpha + bmPerPixelAlpha, // use alpha value of the source pixel + bmMasterAlpha, // use alpha value of source pixel and multiply it with the constant alpha value + bmConstantAlphaAndColor // blend the destination color with the given constant color und the constant alpha value + ); + +procedure AlphaBlend(Source, Destination: HDC; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); +function GetRGBColor(Value: TColor): DWORD; +procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap); + +procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer); inline; + + +procedure SetCanvasOrigin(Canvas: TCanvas; X, Y: Integer); inline; + +/// +/// Clip a given canvas to ClipRect while transforming the given rect to device coordinates. +/// +procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0); + +procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean); + +/// +/// Adjusts the given string S so that it fits into the given width. EllipsisWidth gives the width of +/// the three points to be added to the shorted string. If this value is 0 then it will be determined implicitely. +/// For higher speed (and multiple entries to be shorted) specify this value explicitely. +/// +function ShortenString(DC: HDC; const S: string; Width: TDimension; EllipsisWidth: TDimension = 0): string; overload; + +//-------------------------- +// ShortenString similar to VTV's version, except: +// -- Does not assume using three dots or any particular character for ellipsis +// -- Does not add ellipsis to string, so could be added anywhere +// -- Requires EllipsisWidth, and zero does nothing special +// Returns: +// ShortenedString as var param +// True if shortened (ie: add ellipsis somewhere), otherwise false +function ShortenString(TargetCanvasDC: HDC; const StrIn: string; const AllowedWidth_px: Integer; const EllipsisWidth_px: Integer; var ShortenedString: string): boolean; overload; + +/// +/// Wrap the given string S so that it fits into a space of given width. +/// RTL determines if right-to-left reading is active. +/// +function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; + +/// +/// Calculates bounds of a drawing rectangle for the given string +/// +procedure GetStringDrawRect(DC: HDC; const S: string; var Bounds: TRect; DrawFormat: Cardinal); + +/// +/// Converts the incoming rectangle so that left and top are always less than or equal to right and bottom. +/// +function OrderRect(const R: TRect): TRect; + +/// +/// Fills the given rectangles with values which can be used while dragging around an image +/// +/// +/// (used in DragMove of the drag manager and DragTo of the header columns). +/// +procedure FillDragRectangles(DragWidth, DragHeight, DeltaX, DeltaY: Integer; var RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2: TRect); + +/// +/// Attaches a bitmap as drag image to an IDataObject, see issue #405 +/// +/// Usage: Set property DragImageKind to diNoImage, in your event handler OnCreateDataObject +/// call VirtualTrees.Utils.ApplyDragImage() with your `IDataObject` and your bitmap. +/// +/// +procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap); + +/// +/// Returns True if the mouse cursor is currently visible and False in case it is suppressed. +/// Useful when doing hot-tracking on touchscreens, see issue #766 +/// +function IsMouseCursorVisible(): Boolean; + +procedure ScaleImageList(const ImgList: TImageList; M, D: Integer); + +/// +/// Returns True if the high contrast theme is anabled in the system settings, False otherwise. +/// +function IsHighContrastEnabled(): Boolean; + +/// +/// Divide depend of parameter type uses different division operator: +/// Integer uses div +/// Single uses / +/// +function Divide(const Dimension: Integer; const DivideBy: Integer): Integer; overload; inline; + +/// +/// Divide depend of parameter type uses different division operator: +/// Integer uses div +/// Single uses / +/// +function Divide(const Dimension: Single; const DivideBy: Integer): Single; overload; inline; + +implementation + +uses + Winapi.CommCtrl, + Winapi.ShlObj, + System.SysUtils, + System.StrUtils, + System.Math; + +const + WideLF = Char(#10); + +procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap); var DragSourceHelper: IDragSourceHelper; DragInfo: SHDRAGIMAGE; @@ -136,1160 +182,1462 @@ procedure ApplyDragImage(const pDataObject: IDataObject; pBitmap: TBitmap); end;//if not InitializeFromWindow end; end; - - -function OrderRect(const R: TRect): TRect; - -begin - if R.Left < R.Right then - begin - Result.Left := R.Left; - Result.Right := R.Right; - end - else - begin - Result.Left := R.Right; - Result.Right := R.Left; - end; - if R.Top < R.Bottom then - begin - Result.Top := R.Top; - Result.Bottom := R.Bottom; - end - else - begin - Result.Top := R.Bottom; - Result.Bottom := R.Top; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - - -procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer); - -// Set the brush origin of a given canvas. - -//var -// P: TPoint; - -begin - //P := Point(X, Y); - //LPtoDP(Canvas.Handle, P, 1);// No longer used, see issue #608 - //SetBrushOrgEx(Canvas.Handle, P.X, P.Y, nil); - SetBrushOrgEx(Canvas.Handle, X, Y, nil); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure SetCanvasOrigin(Canvas: TCanvas; X, Y: Integer); - -// Set the coordinate space origin of a given canvas. - -var - P: TPoint; - -begin - // Reset origin as otherwise we would accumulate the origin shifts when calling LPtoDP. - SetWindowOrgEx(Canvas.Handle, 0, 0, nil); - - // The shifting is expected in physical points, so we have to transform them accordingly. - P := Point(X, Y); - LPtoDP(Canvas.Handle, P, 1); - - // Do the shift. - SetWindowOrgEx(Canvas.Handle, P.X, P.Y, nil); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0); - -var - ClipRegion: HRGN; - -begin - // Regions expect their coordinates in device coordinates, hence we have to transform the region rectangle. - LPtoDP(Canvas.Handle, ClipRect, 2); - ClipRegion := CreateRectRgnIndirect(ClipRect); - if VisibleRegion <> 0 then - CombineRgn(ClipRegion, ClipRegion, VisibleRegion, RGN_AND); - SelectClipRgn(Canvas.Handle, ClipRegion); - DeleteObject(ClipRegion); -end; - -//---------------------------------------------------------------------------------------------------------------------- - - -procedure GetStringDrawRect(DC: HDC; const S: string; var Bounds: TRect; DrawFormat: Cardinal); - -begin - Bounds.Right := Bounds.Left + 1; - Bounds.Bottom := Bounds.Top + 1; - - Winapi.Windows.DrawTextW(DC, PWideChar(S), Length(S), Bounds, DrawFormat or DT_CALCRECT); -end; - -//---------------------------------------------------------------------------------------------------------------------- - - -function ShortenString(DC: HDC; const S: string; Width: Integer; EllipsisWidth: Integer = 0): string; - -var - Size: TSize; - Len: Integer; - L, H, N, W: Integer; - -begin - Len := Length(S); - if (Len = 0) or (Width <= 0) then - Result := '' - else - begin - // Determine width of triple point using the current DC settings (if not already done). - if EllipsisWidth = 0 then - begin - GetTextExtentPoint32W(DC, '...', 3, Size); - EllipsisWidth := Size.cx; - end; - - begin - // Do a binary search for the optimal string length which fits into the given width. - L := 0; - N := 0; - W := Width; - H := Len; - while L < H do - begin - N := (L + H + 1) shr 1; - GetTextExtentPoint32W(DC, PWideChar(S), N, Size); - W := Size.cx + EllipsisWidth; - if W <= Width then - L := N - else - H := N - 1; - end; - if W <= Width then - L := N; - if L >= Len then - Result := S - else if Width <= EllipsisWidth then - Result := '' - else - Result := Copy(S, 1, L) + '...'; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; - -var - Width, - Len, - WordCounter, - WordsInLine, - I, W: Integer; - Buffer, - Line: string; - Words: array of string; - R: TRect; - -begin - Result := ''; - // Leading and trailing are ignored. - Buffer := Trim(S); - Len := Length(Buffer); - if Len < 1 then - Exit; - - Width := Bounds.Right - Bounds.Left; - R := Rect(0, 0, 0, 0); - - // Count the words in the string. - WordCounter := 1; - for I := 1 to Len do - if Buffer[I] = ' ' then - Inc(WordCounter); - SetLength(Words, WordCounter); - - if RTL then - begin - // At first we split the string into words with the last word being the - // first element in Words. - W := 0; - for I := 1 to Len do - if Buffer[I] = ' ' then - Inc(W) - else - Words[W] := Words[W] + Buffer[I]; - - // Compose Result. - while WordCounter > 0 do - begin - WordsInLine := 0; - Line := ''; - - while WordCounter > 0 do - begin - GetStringDrawRect(DC, Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter - 1], R, DrawFormat); - if R.Right > Width then - begin - // If at least one word fits into this line then continue with the next line. - if WordsInLine > 0 then - Break; - - Buffer := Words[WordCounter - 1]; - if Len > 1 then - begin - for Len := Length(Buffer) - 1 downto 2 do - begin - GetStringDrawRect(DC, RightStr(Buffer, Len), R, DrawFormat); - if R.Right <= Width then - Break; - end; - end - else - Len := Length(Buffer); - - Line := Line + RightStr(Buffer, Max(Len, 1)); - Words[WordCounter - 1] := LeftStr(Buffer, Length(Buffer) - Max(Len, 1)); - if Words[WordCounter - 1] = '' then - Dec(WordCounter); - Break; - end - else - begin - Dec(WordCounter); - Line := Words[WordCounter] + IfThen(WordsInLine > 0, ' ', '') + Line; - Inc(WordsInLine); - end; - end; - - Result := Result + Line + WideLF; - end; - end - else - begin - // At first we split the string into words with the last word being the - // first element in Words. - W := WordCounter - 1; - for I := 1 to Len do - if Buffer[I] = ' ' then - Dec(W) - else - Words[W] := Words[W] + Buffer[I]; - - // Compose Result. - while WordCounter > 0 do - begin - WordsInLine := 0; - Line := ''; - - while WordCounter > 0 do - begin - GetStringDrawRect(DC, Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter - 1], R, DrawFormat); - if R.Right > Width then - begin - // If at least one word fits into this line then continue with the next line. - if WordsInLine > 0 then - Break; - - Buffer := Words[WordCounter - 1]; - if Len > 1 then - begin - for Len := Length(Buffer) - 1 downto 2 do - begin - GetStringDrawRect(DC, LeftStr(Buffer, Len), R, DrawFormat); - if R.Right <= Width then - Break; - end; - end - else - Len := Length(Buffer); - - Line := Line + LeftStr(Buffer, Max(Len, 1)); - Words[WordCounter - 1] := RightStr(Buffer, Length(Buffer) - Max(Len, 1)); - if Words[WordCounter - 1] = '' then - Dec(WordCounter); - Break; - end - else - begin - Dec(WordCounter); - Line := Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter]; - Inc(WordsInLine); - end; - end; - - Result := Result + Line + WideLF; - end; - end; - - Len := Length(Result); - if Result[Len] = WideLF then - SetLength(Result, Len - 1); -end; - -//---------------------------------------------------------------------------------------------------------------------- - - -function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer; - -// Helper function to calculate the start address for the given row. - -begin - if Height > 0 then // bottom-up DIB - Row := Height - Row - 1; - // Return DWORD aligned address of the requested scanline. - Result := PAnsiChar(Bits) + Row * ((Width * 32 + 31) and not 31) div 8; -end; - - - -//---------------------------------------------------------------------------------------------------------------------- - -function GetBitmapBitsFromDeviceContext(DC: HDC; var Width, Height: Integer): Pointer; - -// Helper function used to retrieve the bitmap selected into the given device context. If there is a bitmap then -// the function will return a pointer to its bits otherwise nil is returned. -// Additionally the dimensions of the bitmap are returned. - -var - Bitmap: HBITMAP; - DIB: TDIBSection; - -begin - Result := nil; - Width := 0; - Height := 0; - - Bitmap := GetCurrentObject(DC, OBJ_BITMAP); - if Bitmap <> 0 then - begin - if GetObject(Bitmap, SizeOf(DIB), @DIB) = SizeOf(DIB) then - begin - Assert(DIB.dsBm.bmPlanes * DIB.dsBm.bmBitsPixel = 32, 'Alpha blending error: bitmap must use 32 bpp.'); - Result := DIB.dsBm.bmBits; - Width := DIB.dsBmih.biWidth; - Height := DIB.dsBmih.biHeight; - end; - end; - Assert(Result <> nil, 'Alpha blending DC error: no bitmap available.'); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure AlphaBlendLineConstant(Source, Destination: Pointer; Count: Integer; ConstantAlpha, Bias: Integer); - -// Blends a line of Count pixels from Source to Destination using a constant alpha value. -// The layout of a pixel must be BGRA where A is ignored (but is calculated as the other components). -// ConstantAlpha must be in the range 0..255 where 0 means totally transparent (destination pixel only) -// and 255 totally opaque (source pixel only). -// Bias is an additional value which gets added to every component and must be in the range -128..127 -// -{$ifdef CPUX64} -// RCX contains Source -// RDX contains Destination -// R8D contains Count -// R9D contains ConstantAlpha -// Bias is on the stack - -asm - //.NOFRAME - - // Load XMM3 with the constant alpha value (replicate it for every component). - // Expand it to word size. - MOVD XMM3, R9D // ConstantAlpha - PUNPCKLWD XMM3, XMM3 - PUNPCKLDQ XMM3, XMM3 - - // Load XMM5 with the bias value. - MOVD XMM5, [Bias] - PUNPCKLWD XMM5, XMM5 - PUNPCKLDQ XMM5, XMM5 - - // Load XMM4 with 128 to allow for saturated biasing. - MOV R10D, 128 - MOVD XMM4, R10D - PUNPCKLWD XMM4, XMM4 - PUNPCKLDQ XMM4, XMM4 - -@1: // The pixel loop calculates an entire pixel in one run. - // Note: The pixel byte values are expanded into the higher bytes of a word due - // to the way unpacking works. We compensate for this with an extra shift. - MOVD XMM1, DWORD PTR [RCX] // data is unaligned - MOVD XMM2, DWORD PTR [RDX] // data is unaligned - PXOR XMM0, XMM0 // clear source pixel register for unpacking - PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words - PSRLW XMM0, 8 // move higher bytes to lower bytes - PXOR XMM1, XMM1 // clear target pixel register for unpacking - PUNPCKLBW XMM1, XMM2{[RDX]} // unpack target pixel byte values into words - MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again - PSRLW XMM1, 8 // move higher bytes to lower bytes - - // calculation is: target = (alpha * (source - target) + 256 * target) / 256 - PSUBW XMM0, XMM1 // source - target - PMULLW XMM0, XMM3 // alpha * (source - target) - PADDW XMM0, XMM2 // add target (in shifted form) - PSRLW XMM0, 8 // divide by 256 - - // Bias is accounted for by conversion of range 0..255 to -128..127, - // doing a saturated add and convert back to 0..255. - PSUBW XMM0, XMM4 - PADDSW XMM0, XMM5 - PADDW XMM0, XMM4 - PACKUSWB XMM0, XMM0 // convert words to bytes with saturation - MOVD DWORD PTR [RDX], XMM0 // store the result -@3: - ADD RCX, 4 - ADD RDX, 4 - DEC R8D - JNZ @1 -end; -{$else} -// EAX contains Source -// EDX contains Destination -// ECX contains Count -// ConstantAlpha and Bias are on the stack - -asm - PUSH ESI // save used registers - PUSH EDI - - MOV ESI, EAX // ESI becomes the actual source pointer - MOV EDI, EDX // EDI becomes the actual target pointer - - // Load MM6 with the constant alpha value (replicate it for every component). - // Expand it to word size. - MOV EAX, [ConstantAlpha] - DB $0F, $6E, $F0 /// MOVD MM6, EAX - DB $0F, $61, $F6 /// PUNPCKLWD MM6, MM6 - DB $0F, $62, $F6 /// PUNPCKLDQ MM6, MM6 - - // Load MM5 with the bias value. - MOV EAX, [Bias] - DB $0F, $6E, $E8 /// MOVD MM5, EAX - DB $0F, $61, $ED /// PUNPCKLWD MM5, MM5 - DB $0F, $62, $ED /// PUNPCKLDQ MM5, MM5 - - // Load MM4 with 128 to allow for saturated biasing. - MOV EAX, 128 - DB $0F, $6E, $E0 /// MOVD MM4, EAX - DB $0F, $61, $E4 /// PUNPCKLWD MM4, MM4 - DB $0F, $62, $E4 /// PUNPCKLDQ MM4, MM4 - -@1: // The pixel loop calculates an entire pixel in one run. - // Note: The pixel byte values are expanded into the higher bytes of a word due - // to the way unpacking works. We compensate for this with an extra shift. - DB $0F, $EF, $C0 /// PXOR MM0, MM0, clear source pixel register for unpacking - DB $0F, $60, $06 /// PUNPCKLBW MM0, [ESI], unpack source pixel byte values into words - DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, move higher bytes to lower bytes - DB $0F, $EF, $C9 /// PXOR MM1, MM1, clear target pixel register for unpacking - DB $0F, $60, $0F /// PUNPCKLBW MM1, [EDI], unpack target pixel byte values into words - DB $0F, $6F, $D1 /// MOVQ MM2, MM1, make a copy of the shifted values, we need them again - DB $0F, $71, $D1, $08 /// PSRLW MM1, 8, move higher bytes to lower bytes - - // calculation is: target = (alpha * (source - target) + 256 * target) / 256 - DB $0F, $F9, $C1 /// PSUBW MM0, MM1, source - target - DB $0F, $D5, $C6 /// PMULLW MM0, MM6, alpha * (source - target) - DB $0F, $FD, $C2 /// PADDW MM0, MM2, add target (in shifted form) - DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, divide by 256 - - // Bias is accounted for by conversion of range 0..255 to -128..127, - // doing a saturated add and convert back to 0..255. - DB $0F, $F9, $C4 /// PSUBW MM0, MM4 - DB $0F, $ED, $C5 /// PADDSW MM0, MM5 - DB $0F, $FD, $C4 /// PADDW MM0, MM4 - DB $0F, $67, $C0 /// PACKUSWB MM0, MM0, convert words to bytes with saturation - DB $0F, $7E, $07 /// MOVD [EDI], MM0, store the result -@3: - ADD ESI, 4 - ADD EDI, 4 - DEC ECX - JNZ @1 - POP EDI - POP ESI -end; -{$endif CPUX64} - -//---------------------------------------------------------------------------------------------------------------------- - -procedure AlphaBlendLinePerPixel(Source, Destination: Pointer; Count, Bias: Integer); - -// Blends a line of Count pixels from Source to Destination using the alpha value of the source pixels. -// The layout of a pixel must be BGRA. -// Bias is an additional value which gets added to every component and must be in the range -128..127 -// -{$ifdef CPUX64} -// RCX contains Source -// RDX contains Destination -// R8D contains Count -// R9D contains Bias - -asm - //.NOFRAME - - // Load XMM5 with the bias value. - MOVD XMM5, R9D // Bias - PUNPCKLWD XMM5, XMM5 - PUNPCKLDQ XMM5, XMM5 - - // Load XMM4 with 128 to allow for saturated biasing. - MOV R10D, 128 - MOVD XMM4, R10D - PUNPCKLWD XMM4, XMM4 - PUNPCKLDQ XMM4, XMM4 - -@1: // The pixel loop calculates an entire pixel in one run. - // Note: The pixel byte values are expanded into the higher bytes of a word due - // to the way unpacking works. We compensate for this with an extra shift. - MOVD XMM1, DWORD PTR [RCX] // data is unaligned - MOVD XMM2, DWORD PTR [RDX] // data is unaligned - PXOR XMM0, XMM0 // clear source pixel register for unpacking - PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words - PSRLW XMM0, 8 // move higher bytes to lower bytes - PXOR XMM1, XMM1 // clear target pixel register for unpacking - PUNPCKLBW XMM1, XMM2{[RDX]} // unpack target pixel byte values into words - MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again - PSRLW XMM1, 8 // move higher bytes to lower bytes - - // Load XMM3 with the source alpha value (replicate it for every component). - // Expand it to word size. - MOVQ XMM3, XMM0 - PUNPCKHWD XMM3, XMM3 - PUNPCKHDQ XMM3, XMM3 - - // calculation is: target = (alpha * (source - target) + 256 * target) / 256 - PSUBW XMM0, XMM1 // source - target - PMULLW XMM0, XMM3 // alpha * (source - target) - PADDW XMM0, XMM2 // add target (in shifted form) - PSRLW XMM0, 8 // divide by 256 - - // Bias is accounted for by conversion of range 0..255 to -128..127, - // doing a saturated add and convert back to 0..255. - PSUBW XMM0, XMM4 - PADDSW XMM0, XMM5 - PADDW XMM0, XMM4 - PACKUSWB XMM0, XMM0 // convert words to bytes with saturation - MOVD DWORD PTR [RDX], XMM0 // store the result -@3: - ADD RCX, 4 - ADD RDX, 4 - DEC R8D - JNZ @1 -end; -{$else} -// EAX contains Source -// EDX contains Destination -// ECX contains Count -// Bias is on the stack - -asm - PUSH ESI // save used registers - PUSH EDI - - MOV ESI, EAX // ESI becomes the actual source pointer - MOV EDI, EDX // EDI becomes the actual target pointer - - // Load MM5 with the bias value. - MOV EAX, [Bias] - DB $0F, $6E, $E8 /// MOVD MM5, EAX - DB $0F, $61, $ED /// PUNPCKLWD MM5, MM5 - DB $0F, $62, $ED /// PUNPCKLDQ MM5, MM5 - - // Load MM4 with 128 to allow for saturated biasing. - MOV EAX, 128 - DB $0F, $6E, $E0 /// MOVD MM4, EAX - DB $0F, $61, $E4 /// PUNPCKLWD MM4, MM4 - DB $0F, $62, $E4 /// PUNPCKLDQ MM4, MM4 - -@1: // The pixel loop calculates an entire pixel in one run. - // Note: The pixel byte values are expanded into the higher bytes of a word due - // to the way unpacking works. We compensate for this with an extra shift. - DB $0F, $EF, $C0 /// PXOR MM0, MM0, clear source pixel register for unpacking - DB $0F, $60, $06 /// PUNPCKLBW MM0, [ESI], unpack source pixel byte values into words - DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, move higher bytes to lower bytes - DB $0F, $EF, $C9 /// PXOR MM1, MM1, clear target pixel register for unpacking - DB $0F, $60, $0F /// PUNPCKLBW MM1, [EDI], unpack target pixel byte values into words - DB $0F, $6F, $D1 /// MOVQ MM2, MM1, make a copy of the shifted values, we need them again - DB $0F, $71, $D1, $08 /// PSRLW MM1, 8, move higher bytes to lower bytes - - // Load MM6 with the source alpha value (replicate it for every component). - // Expand it to word size. - DB $0F, $6F, $F0 /// MOVQ MM6, MM0 - DB $0F, $69, $F6 /// PUNPCKHWD MM6, MM6 - DB $0F, $6A, $F6 /// PUNPCKHDQ MM6, MM6 - - // calculation is: target = (alpha * (source - target) + 256 * target) / 256 - DB $0F, $F9, $C1 /// PSUBW MM0, MM1, source - target - DB $0F, $D5, $C6 /// PMULLW MM0, MM6, alpha * (source - target) - DB $0F, $FD, $C2 /// PADDW MM0, MM2, add target (in shifted form) - DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, divide by 256 - - // Bias is accounted for by conversion of range 0..255 to -128..127, - // doing a saturated add and convert back to 0..255. - DB $0F, $F9, $C4 /// PSUBW MM0, MM4 - DB $0F, $ED, $C5 /// PADDSW MM0, MM5 - DB $0F, $FD, $C4 /// PADDW MM0, MM4 - DB $0F, $67, $C0 /// PACKUSWB MM0, MM0, convert words to bytes with saturation - DB $0F, $7E, $07 /// MOVD [EDI], MM0, store the result -@3: - ADD ESI, 4 - ADD EDI, 4 - DEC ECX - JNZ @1 - POP EDI - POP ESI -end; -{$endif CPUX64} - -//---------------------------------------------------------------------------------------------------------------------- - -procedure EMMS; - -// Reset MMX state to use the FPU for other tasks again. - -{$ifdef CPUX64} - inline; -begin -end; -{$else} -asm - DB $0F, $77 /// EMMS -end; -{$endif CPUX64} - -//---------------------------------------------------------------------------------------------------------------------- - -procedure AlphaBlendLineMaster(Source, Destination: Pointer; Count: Integer; ConstantAlpha, Bias: Integer); - -// Blends a line of Count pixels from Source to Destination using the source pixel and a constant alpha value. -// The layout of a pixel must be BGRA. -// ConstantAlpha must be in the range 0..255. -// Bias is an additional value which gets added to every component and must be in the range -128..127 -// -{$ifdef CPUX64} -// RCX contains Source -// RDX contains Destination -// R8D contains Count -// R9D contains ConstantAlpha -// Bias is on the stack - -asm - .SAVENV XMM6 - - // Load XMM3 with the constant alpha value (replicate it for every component). - // Expand it to word size. - MOVD XMM3, R9D // ConstantAlpha - PUNPCKLWD XMM3, XMM3 - PUNPCKLDQ XMM3, XMM3 - - // Load XMM5 with the bias value. - MOV R10D, [Bias] - MOVD XMM5, R10D - PUNPCKLWD XMM5, XMM5 - PUNPCKLDQ XMM5, XMM5 - - // Load XMM4 with 128 to allow for saturated biasing. - MOV R10D, 128 - MOVD XMM4, R10D - PUNPCKLWD XMM4, XMM4 - PUNPCKLDQ XMM4, XMM4 - -@1: // The pixel loop calculates an entire pixel in one run. - // Note: The pixel byte values are expanded into the higher bytes of a word due - // to the way unpacking works. We compensate for this with an extra shift. - MOVD XMM1, DWORD PTR [RCX] // data is unaligned - MOVD XMM2, DWORD PTR [RDX] // data is unaligned - PXOR XMM0, XMM0 // clear source pixel register for unpacking - PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words - PSRLW XMM0, 8 // move higher bytes to lower bytes - PXOR XMM1, XMM1 // clear target pixel register for unpacking - PUNPCKLBW XMM1, XMM2{[RCX]} // unpack target pixel byte values into words - MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again - PSRLW XMM1, 8 // move higher bytes to lower bytes - - // Load XMM6 with the source alpha value (replicate it for every component). - // Expand it to word size. - MOVQ XMM6, XMM0 - PUNPCKHWD XMM6, XMM6 - PUNPCKHDQ XMM6, XMM6 - PMULLW XMM6, XMM3 // source alpha * master alpha - PSRLW XMM6, 8 // divide by 256 - - // calculation is: target = (alpha * master alpha * (source - target) + 256 * target) / 256 - PSUBW XMM0, XMM1 // source - target - PMULLW XMM0, XMM6 // alpha * (source - target) - PADDW XMM0, XMM2 // add target (in shifted form) - PSRLW XMM0, 8 // divide by 256 - - // Bias is accounted for by conversion of range 0..255 to -128..127, - // doing a saturated add and convert back to 0..255. - PSUBW XMM0, XMM4 - PADDSW XMM0, XMM5 - PADDW XMM0, XMM4 - PACKUSWB XMM0, XMM0 // convert words to bytes with saturation - MOVD DWORD PTR [RDX], XMM0 // store the result -@3: - ADD RCX, 4 - ADD RDX, 4 - DEC R8D - JNZ @1 -end; -{$else} -// EAX contains Source -// EDX contains Destination -// ECX contains Count -// ConstantAlpha and Bias are on the stack - -asm - PUSH ESI // save used registers - PUSH EDI - - MOV ESI, EAX // ESI becomes the actual source pointer - MOV EDI, EDX // EDI becomes the actual target pointer - - // Load MM6 with the constant alpha value (replicate it for every component). - // Expand it to word size. - MOV EAX, [ConstantAlpha] - DB $0F, $6E, $F0 /// MOVD MM6, EAX - DB $0F, $61, $F6 /// PUNPCKLWD MM6, MM6 - DB $0F, $62, $F6 /// PUNPCKLDQ MM6, MM6 - - // Load MM5 with the bias value. - MOV EAX, [Bias] - DB $0F, $6E, $E8 /// MOVD MM5, EAX - DB $0F, $61, $ED /// PUNPCKLWD MM5, MM5 - DB $0F, $62, $ED /// PUNPCKLDQ MM5, MM5 - - // Load MM4 with 128 to allow for saturated biasing. - MOV EAX, 128 - DB $0F, $6E, $E0 /// MOVD MM4, EAX - DB $0F, $61, $E4 /// PUNPCKLWD MM4, MM4 - DB $0F, $62, $E4 /// PUNPCKLDQ MM4, MM4 - -@1: // The pixel loop calculates an entire pixel in one run. - // Note: The pixel byte values are expanded into the higher bytes of a word due - // to the way unpacking works. We compensate for this with an extra shift. - DB $0F, $EF, $C0 /// PXOR MM0, MM0, clear source pixel register for unpacking - DB $0F, $60, $06 /// PUNPCKLBW MM0, [ESI], unpack source pixel byte values into words - DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, move higher bytes to lower bytes - DB $0F, $EF, $C9 /// PXOR MM1, MM1, clear target pixel register for unpacking - DB $0F, $60, $0F /// PUNPCKLBW MM1, [EDI], unpack target pixel byte values into words - DB $0F, $6F, $D1 /// MOVQ MM2, MM1, make a copy of the shifted values, we need them again - DB $0F, $71, $D1, $08 /// PSRLW MM1, 8, move higher bytes to lower bytes - - // Load MM7 with the source alpha value (replicate it for every component). - // Expand it to word size. - DB $0F, $6F, $F8 /// MOVQ MM7, MM0 - DB $0F, $69, $FF /// PUNPCKHWD MM7, MM7 - DB $0F, $6A, $FF /// PUNPCKHDQ MM7, MM7 - DB $0F, $D5, $FE /// PMULLW MM7, MM6, source alpha * master alpha - DB $0F, $71, $D7, $08 /// PSRLW MM7, 8, divide by 256 - - // calculation is: target = (alpha * master alpha * (source - target) + 256 * target) / 256 - DB $0F, $F9, $C1 /// PSUBW MM0, MM1, source - target - DB $0F, $D5, $C7 /// PMULLW MM0, MM7, alpha * (source - target) - DB $0F, $FD, $C2 /// PADDW MM0, MM2, add target (in shifted form) - DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, divide by 256 - - // Bias is accounted for by conversion of range 0..255 to -128..127, - // doing a saturated add and convert back to 0..255. - DB $0F, $F9, $C4 /// PSUBW MM0, MM4 - DB $0F, $ED, $C5 /// PADDSW MM0, MM5 - DB $0F, $FD, $C4 /// PADDW MM0, MM4 - DB $0F, $67, $C0 /// PACKUSWB MM0, MM0, convert words to bytes with saturation - DB $0F, $7E, $07 /// MOVD [EDI], MM0, store the result -@3: - ADD ESI, 4 - ADD EDI, 4 - DEC ECX - JNZ @1 - POP EDI - POP ESI -end; -{$endif CPUX64} - -//---------------------------------------------------------------------------------------------------------------------- - -procedure AlphaBlendLineMasterAndColor(Destination: Pointer; Count: Integer; ConstantAlpha, Color: Integer); - -// Blends a line of Count pixels in Destination against the given color using a constant alpha value. -// The layout of a pixel must be BGRA and Color must be rrggbb00 (as stored by a COLORREF). -// ConstantAlpha must be in the range 0..255. -// -{$ifdef CPUX64} -// RCX contains Destination -// EDX contains Count -// R8D contains ConstantAlpha -// R9D contains Color - -asm - //.NOFRAME - - // The used formula is: target = (alpha * color + (256 - alpha) * target) / 256. - // alpha * color (factor 1) and 256 - alpha (factor 2) are constant values which can be calculated in advance. - // The remaining calculation is therefore: target = (F1 + F2 * target) / 256 - - // Load XMM3 with the constant alpha value (replicate it for every component). - // Expand it to word size. (Every calculation here works on word sized operands.) - MOVD XMM3, R8D // ConstantAlpha - PUNPCKLWD XMM3, XMM3 - PUNPCKLDQ XMM3, XMM3 - - // Calculate factor 2. - MOV R10D, $100 - MOVD XMM2, R10D - PUNPCKLWD XMM2, XMM2 - PUNPCKLDQ XMM2, XMM2 - PSUBW XMM2, XMM3 // XMM2 contains now: 255 - alpha = F2 - - // Now calculate factor 1. Alpha is still in XMM3, but the r and b components of Color must be swapped. - BSWAP R9D // Color - ROR R9D, 8 - MOVD XMM1, R9D // Load the color and convert to word sized values. - PXOR XMM4, XMM4 - PUNPCKLBW XMM1, XMM4 - PMULLW XMM1, XMM3 // XMM1 contains now: color * alpha = F1 - -@1: // The pixel loop calculates an entire pixel in one run. - MOVD XMM0, DWORD PTR [RCX] - PUNPCKLBW XMM0, XMM4 - - PMULLW XMM0, XMM2 // calculate F1 + F2 * target - PADDW XMM0, XMM1 - PSRLW XMM0, 8 // divide by 256 - - PACKUSWB XMM0, XMM0 // convert words to bytes with saturation - MOVD DWORD PTR [RCX], XMM0 // store the result - - ADD RCX, 4 - DEC EDX - JNZ @1 -end; -{$else} -// EAX contains Destination -// EDX contains Count -// ECX contains ConstantAlpha -// Color is passed on the stack - -asm - // The used formula is: target = (alpha * color + (256 - alpha) * target) / 256. - // alpha * color (factor 1) and 256 - alpha (factor 2) are constant values which can be calculated in advance. - // The remaining calculation is therefore: target = (F1 + F2 * target) / 256 - - // Load MM3 with the constant alpha value (replicate it for every component). - // Expand it to word size. (Every calculation here works on word sized operands.) - DB $0F, $6E, $D9 /// MOVD MM3, ECX - DB $0F, $61, $DB /// PUNPCKLWD MM3, MM3 - DB $0F, $62, $DB /// PUNPCKLDQ MM3, MM3 - - // Calculate factor 2. - MOV ECX, $100 - DB $0F, $6E, $D1 /// MOVD MM2, ECX - DB $0F, $61, $D2 /// PUNPCKLWD MM2, MM2 - DB $0F, $62, $D2 /// PUNPCKLDQ MM2, MM2 - DB $0F, $F9, $D3 /// PSUBW MM2, MM3 // MM2 contains now: 255 - alpha = F2 - - // Now calculate factor 1. Alpha is still in MM3, but the r and b components of Color must be swapped. - MOV ECX, [Color] - BSWAP ECX - ROR ECX, 8 - DB $0F, $6E, $C9 /// MOVD MM1, ECX // Load the color and convert to word sized values. - DB $0F, $EF, $E4 /// PXOR MM4, MM4 - DB $0F, $60, $CC /// PUNPCKLBW MM1, MM4 - DB $0F, $D5, $CB /// PMULLW MM1, MM3 // MM1 contains now: color * alpha = F1 - -@1: // The pixel loop calculates an entire pixel in one run. - DB $0F, $6E, $00 /// MOVD MM0, [EAX] - DB $0F, $60, $C4 /// PUNPCKLBW MM0, MM4 - - DB $0F, $D5, $C2 /// PMULLW MM0, MM2 // calculate F1 + F2 * target - DB $0F, $FD, $C1 /// PADDW MM0, MM1 - DB $0F, $71, $D0, $08 /// PSRLW MM0, 8 // divide by 256 - - DB $0F, $67, $C0 /// PACKUSWB MM0, MM0 // convert words to bytes with saturation - DB $0F, $7E, $00 /// MOVD [EAX], MM0 // store the result - - ADD EAX, 4 - DEC EDX - JNZ @1 -end; -{$endif CPUX64} - -//---------------------------------------------------------------------------------------------------------------------- - -procedure AlphaBlend(Source, Destination: HDC; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); - -// Optimized alpha blend procedure using MMX instructions to perform as quick as possible. -// For this procedure to work properly it is important that both source and target bitmap use the 32 bit color format. -// R describes the source rectangle to work on. -// Target is the place (upper left corner) in the target bitmap where to blend to. Note that source width + X offset -// must be less or equal to the target width. Similar for the height. -// If Mode is bmConstantAlpha then the blend operation uses the given ConstantAlpha value for all pixels. -// If Mode is bmPerPixelAlpha then each pixel is blended using its individual alpha value (the alpha value of the source). -// If Mode is bmMasterAlpha then each pixel is blended using its individual alpha value multiplied by ConstantAlpha. -// If Mode is bmConstantAlphaAndColor then each destination pixel is blended using ConstantAlpha but also a constant -// color which will be obtained from Bias. In this case no offset value is added, otherwise Bias is used as offset. -// Blending of a color into target only (bmConstantAlphaAndColor) ignores Source (the DC) and Target (the position). -// CAUTION: This procedure does not check whether MMX instructions are actually available! Call it only if MMX is really -// usable. - -var - Y: Integer; - SourceRun, - TargetRun: PByte; - - SourceBits, - DestBits: Pointer; - SourceWidth, - SourceHeight, - DestWidth, - DestHeight: Integer; - -begin - if not IsRectEmpty(R) then - begin - // Note: it is tempting to optimize the special cases for constant alpha 0 and 255 by just ignoring soure - // (alpha = 0) or simply do a blit (alpha = 255). But this does not take the bias into account. - case Mode of - bmConstantAlpha: - begin - // Get a pointer to the bitmap bits for the source and target device contexts. - // Note: this supposes that both contexts do actually have bitmaps assigned! - SourceBits := GetBitmapBitsFromDeviceContext(Source, SourceWidth, SourceHeight); - DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight); - if Assigned(SourceBits) and Assigned(DestBits) then - begin - for Y := 0 to R.Bottom - R.Top - 1 do - begin - SourceRun := CalculateScanline(SourceBits, SourceWidth, SourceHeight, Y + R.Top); - Inc(SourceRun, 4 * R.Left); - TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + Target.Y); - Inc(TargetRun, 4 * Target.X); - AlphaBlendLineConstant(SourceRun, TargetRun, R.Right - R.Left, ConstantAlpha, Bias); - end; - end; - EMMS; - end; - bmPerPixelAlpha: - begin - SourceBits := GetBitmapBitsFromDeviceContext(Source, SourceWidth, SourceHeight); - DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight); - if Assigned(SourceBits) and Assigned(DestBits) then - begin - for Y := 0 to R.Bottom - R.Top - 1 do - begin - SourceRun := CalculateScanline(SourceBits, SourceWidth, SourceHeight, Y + R.Top); - Inc(SourceRun, 4 * R.Left); - TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + Target.Y); - Inc(TargetRun, 4 * Target.X); - AlphaBlendLinePerPixel(SourceRun, TargetRun, R.Right - R.Left, Bias); - end; - end; - EMMS; - end; - bmMasterAlpha: - begin - SourceBits := GetBitmapBitsFromDeviceContext(Source, SourceWidth, SourceHeight); - DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight); - if Assigned(SourceBits) and Assigned(DestBits) then - begin - for Y := 0 to R.Bottom - R.Top - 1 do - begin - SourceRun := CalculateScanline(SourceBits, SourceWidth, SourceHeight, Y + R.Top); - Inc(SourceRun, 4 * Target.X); - TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + Target.Y); - AlphaBlendLineMaster(SourceRun, TargetRun, R.Right - R.Left, ConstantAlpha, Bias); - end; - end; - EMMS; - end; - bmConstantAlphaAndColor: - begin - // Source is ignored since there is a constant color value. - DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight); - if Assigned(DestBits) then - begin - for Y := 0 to R.Bottom - R.Top - 1 do - begin - TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + R.Top); - Inc(TargetRun, 4 * R.Left); - AlphaBlendLineMasterAndColor(TargetRun, R.Right - R.Left, ConstantAlpha, Bias); - end; - end; - EMMS; - end; - end; - end; -end; - -function GetRGBColor(Value: TColor): DWORD; - -// Little helper to convert a Delphi color to an image list color. - -begin - Result := ColorToRGB(Value); - case Result of - clNone: - Result := CLR_NONE; - clDefault: - Result := CLR_DEFAULT; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap); - -// Stretch draw on to the new canvas. - -var - Header, - Bits: Pointer; - HeaderSize, - BitsSize: Cardinal; - -begin - GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize); - - GetMem(Header, HeaderSize); - GetMem(Bits, BitsSize); - try - GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^); - StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - - DestRect.Top, 0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^), DIB_RGB_COLORS, SRCCOPY); - finally - FreeMem(Header); - FreeMem(Bits); - end; -end; - - -//---------------------------------------------------------------------------------------------------------------------- - - -procedure FillDragRectangles(DragWidth, DragHeight, DeltaX, DeltaY: Integer; var RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2: TRect); - -begin - // ScrollDC limits - RClip := Rect(0, 0, DragWidth, DragHeight); - if DeltaX > 0 then - begin - // move to the left - if DeltaY = 0 then - begin - // move only to the left - // background movement - RScroll := Rect(0, 0, DragWidth - DeltaX, DragHeight); - RSamp1 := Rect(0, 0, DeltaX, DragHeight); - RDraw1 := Rect(DragWidth - DeltaX, 0, DeltaX, DragHeight); - end - else - if DeltaY < 0 then - begin - // move to bottom left - RScroll := Rect(0, -DeltaY, DragWidth - DeltaX, DragHeight); - RSamp1 := Rect(0, 0, DeltaX, DragHeight); - RSamp2 := Rect(DeltaX, DragHeight + DeltaY, DragWidth - DeltaX, -DeltaY); - RDraw1 := Rect(0, 0, DragWidth - DeltaX, -DeltaY); - RDraw2 := Rect(DragWidth - DeltaX, 0, DeltaX, DragHeight); - end - else - begin - // move to upper left - RScroll := Rect(0, 0, DragWidth - DeltaX, DragHeight - DeltaY); - RSamp1 := Rect(0, 0, DeltaX, DragHeight); - RSamp2 := Rect(DeltaX, 0, DragWidth - DeltaX, DeltaY); - RDraw1 := Rect(0, DragHeight - DeltaY, DragWidth - DeltaX, DeltaY); - RDraw2 := Rect(DragWidth - DeltaX, 0, DeltaX, DragHeight); - end; - end - else - if DeltaX = 0 then - begin - // vertical movement only - if DeltaY < 0 then - begin - // move downwards - RScroll := Rect(0, -DeltaY, DragWidth, DragHeight); - RSamp2 := Rect(0, DragHeight + DeltaY, DragWidth, -DeltaY); - RDraw2 := Rect(0, 0, DragWidth, -DeltaY); - end - else - begin - // move upwards - RScroll := Rect(0, 0, DragWidth, DragHeight - DeltaY); - RSamp2 := Rect(0, 0, DragWidth, DeltaY); - RDraw2 := Rect(0, DragHeight - DeltaY, DragWidth, DeltaY); - end; - end - else - begin - // move to the right - if DeltaY > 0 then - begin - // move up right - RScroll := Rect(-DeltaX, 0, DragWidth, DragHeight); - RSamp1 := Rect(0, 0, DragWidth + DeltaX, DeltaY); - RSamp2 := Rect(DragWidth + DeltaX, 0, -DeltaX, DragHeight); - RDraw1 := Rect(0, 0, -DeltaX, DragHeight); - RDraw2 := Rect(-DeltaX, DragHeight - DeltaY, DragWidth + DeltaX, DeltaY); - end - else - if DeltaY = 0 then - begin - // to the right only - RScroll := Rect(-DeltaX, 0, DragWidth, DragHeight); - RSamp1 := Rect(DragWidth + DeltaX, 0, -DeltaX, DragHeight); - RDraw1 := Rect(0, 0, -DeltaX, DragHeight); - end - else - begin - // move down right - RScroll := Rect(-DeltaX, -DeltaY, DragWidth, DragHeight); - RSamp1 := Rect(0, DragHeight + DeltaY, DragWidth + DeltaX, -DeltaY); - RSamp2 := Rect(DragWidth + DeltaX, 0, -DeltaX, DragHeight); - RDraw1 := Rect(0, 0, -DeltaX, DragHeight); - RDraw2 := Rect(-DeltaX, 0, DragWidth + DeltaX, -DeltaY); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -type - TCustomImageListCast = class(TCustomImageList); - -procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean); - - procedure DrawDisabledImage(ImageList: TCustomImageList; Canvas: TCanvas; X, Y, Index: Integer); - var - Params: TImageListDrawParams; - begin - FillChar(Params, SizeOf(Params), 0); - Params.cbSize := SizeOf(Params); - Params.himl := ImageList.Handle; - Params.i := Index; - Params.hdcDst := Canvas.Handle; - Params.x := X; - Params.y := Y; - Params.fState := ILS_SATURATE; - ImageList_DrawIndirect(@Params); - end; - -begin - if Enabled then - TCustomImageListCast(ImageList).DoDraw(Index, Canvas, X, Y, Style, Enabled) - else - DrawDisabledImage(ImageList, Canvas, X, Y, Index); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function IsMouseCursorVisible(): Boolean; + + +function OrderRect(const R: TRect): TRect; + +begin + if R.Left < R.Right then + begin + Result.Left := R.Left; + Result.Right := R.Right; + end + else + begin + Result.Left := R.Right; + Result.Right := R.Left; + end; + if R.Top < R.Bottom then + begin + Result.Top := R.Top; + Result.Bottom := R.Bottom; + end + else + begin + Result.Top := R.Bottom; + Result.Bottom := R.Top; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + + +procedure SetBrushOrigin(Canvas: TCanvas; X, Y: Integer); + +// Set the brush origin of a given canvas. + +//var +// P: TPoint; + +begin + //P := Point(X, Y); + //LPtoDP(Canvas.Handle, P, 1);// No longer used, see issue #608 + //SetBrushOrgEx(Canvas.Handle, P.X, P.Y, nil); + SetBrushOrgEx(Canvas.Handle, X, Y, nil); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure SetCanvasOrigin(Canvas: TCanvas; X, Y: Integer); + +// Set the coordinate space origin of a given canvas. + +var + P: TPoint; + +begin + // Reset origin as otherwise we would accumulate the origin shifts when calling LPtoDP. + SetWindowOrgEx(Canvas.Handle, 0, 0, nil); + + // The shifting is expected in physical points, so we have to transform them accordingly. + P := Point(X, Y); + LPtoDP(Canvas.Handle, P, 1); + + // Do the shift. + SetWindowOrgEx(Canvas.Handle, P.X, P.Y, nil); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure ClipCanvas(Canvas: TCanvas; ClipRect: TRect; VisibleRegion: HRGN = 0); + +var + ClipRegion: HRGN; + +begin + // Regions expect their coordinates in device coordinates, hence we have to transform the region rectangle. + LPtoDP(Canvas.Handle, ClipRect, 2); + ClipRegion := CreateRectRgnIndirect(ClipRect); + if VisibleRegion <> 0 then + CombineRgn(ClipRegion, ClipRegion, VisibleRegion, RGN_AND); + SelectClipRgn(Canvas.Handle, ClipRegion); + DeleteObject(ClipRegion); +end; + +//---------------------------------------------------------------------------------------------------------------------- + + +procedure GetStringDrawRect(DC: HDC; const S: string; var Bounds: TRect; DrawFormat: Cardinal); + +begin + Bounds.Right := Bounds.Left + 1; + Bounds.Bottom := Bounds.Top + 1; + + Winapi.Windows.DrawTextW(DC, PWideChar(S), Length(S), Bounds, DrawFormat or DT_CALCRECT); +end; + +//---------------------------------------------------------------------------------------------------------------------- + + +function ShortenString(DC: HDC; const S: string; Width: TDimension; EllipsisWidth: TDimension = 0): string; + +var + Size: TSize; + Len: Integer; + L, H, N: Integer; + W: TDimension; + +begin + Len := Length(S); + if (Len = 0) or (Width <= 0) then + Result := '' + else + begin + // Determine width of triple point using the current DC settings (if not already done). + if EllipsisWidth = 0 then + begin + GetTextExtentPoint32W(DC, '...', 3, Size); + EllipsisWidth := Size.cx; + end; + + begin + // Do a binary search for the optimal string length which fits into the given width. + L := 0; + N := 0; + W := Width; + H := Len; + while L < H do + begin + N := (L + H + 1) shr 1; + GetTextExtentPoint32W(DC, PWideChar(S), N, Size); + W := Size.cx + EllipsisWidth; + if W <= Width then + L := N + else + H := N - 1; + end; + if W <= Width then + L := N; + if L >= Len then + Result := S + else if Width <= EllipsisWidth then + Result := '' + else + Result := Copy(S, 1, L) + '...'; + end; + end; +end; + + +//-------------------------- +function ShortenString(TargetCanvasDC: HDC; const StrIn: string; const AllowedWidth_px: Integer; const EllipsisWidth_px: Integer; var ShortenedString: string): boolean; +//-------------------------- +var + Size_px_x_px: TSize; // cx, cy + StrInLen: Integer; + LoLen, HiLen, TestLen, TestWidth_px: Integer; + +begin + StrInLen := Length(StrIn); + if (StrInLen = 0) then + Begin + ShortenedString := ''; + Result := False; // No ellipsis needed since original was empty + End else + if (AllowedWidth_px <= 0) then + Begin + ShortenedString := ''; + Result := True; // Ellipsis needed, since non-empty string replaced. + // But likely will get clipped if AllowedWidth is really zero + End else + begin + // Do a binary search for the optimal string length which fits into the given width. + LoLen := 0; + TestLen := 0; + TestWidth_px := AllowedWidth_px; + HiLen := StrInLen; + + while LoLen < HiLen do + begin + TestLen := (LoLen + HiLen + 1) shr 1; // Test average of Lo and Hi + + GetTextExtentPoint32W(TargetCanvasDC, PWideChar(StrIn), TestLen, Size_px_x_px); + TestWidth_px := Size_px_x_px.cx + EllipsisWidth_px; + + if TestWidth_px <= AllowedWidth_px then + Begin + LoLen := TestLen // Low bound must be at least as much as TestLen + End else + Begin + HiLen := TestLen - 1; // Continue until Hi bound string produces width below AllowedWidth_px + End; + end; + + if TestWidth_px <= AllowedWidth_px then + Begin + LoLen := TestLen; + End; + if LoLen >= StrInLen then + Begin + ShortenedString := StrIn; + Result := False; + End else if AllowedWidth_px <= EllipsisWidth_px then + Begin + ShortenedString := ''; + Result := True; // Even though Ellipsis won't fit in AllowedWidth, + // let clipping decide how much of ellipsis to show + End else + Begin + ShortenedString := Copy(StrIn, 1, LoLen); + Result := True; + End; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + + +function WrapString(DC: HDC; const S: string; const Bounds: TRect; RTL: Boolean; DrawFormat: Cardinal): string; + +var + Width, + Len, + WordCounter, + WordsInLine, + I, W: Integer; + Buffer, + Line: string; + Words: array of string; + R: TRect; + +begin + Result := ''; + // Leading and trailing are ignored. + Buffer := Trim(S); + Len := Length(Buffer); + if Len < 1 then + Exit; + + Width := Bounds.Right - Bounds.Left; + R := Rect(0, 0, 0, 0); + + // Count the words in the string. + WordCounter := 1; + for I := 1 to Len do + if Buffer[I] = ' ' then + Inc(WordCounter); + SetLength(Words, WordCounter); + + if RTL then + begin + // At first we split the string into words with the last word being the + // first element in Words. + W := 0; + for I := 1 to Len do + if Buffer[I] = ' ' then + Inc(W) + else + Words[W] := Words[W] + Buffer[I]; + + // Compose Result. + while WordCounter > 0 do + begin + WordsInLine := 0; + Line := ''; + + while WordCounter > 0 do + begin + GetStringDrawRect(DC, Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter - 1], R, DrawFormat); + if R.Right > Width then + begin + // If at least one word fits into this line then continue with the next line. + if WordsInLine > 0 then + Break; + + Buffer := Words[WordCounter - 1]; + if Len > 1 then + begin + for Len := Length(Buffer) - 1 downto 2 do + begin + GetStringDrawRect(DC, RightStr(Buffer, Len), R, DrawFormat); + if R.Right <= Width then + Break; + end; + end + else + Len := Length(Buffer); + + Line := Line + RightStr(Buffer, Max(Len, 1)); + Words[WordCounter - 1] := LeftStr(Buffer, Length(Buffer) - Max(Len, 1)); + if Words[WordCounter - 1] = '' then + Dec(WordCounter); + Break; + end + else + begin + Dec(WordCounter); + Line := Words[WordCounter] + IfThen(WordsInLine > 0, ' ', '') + Line; + Inc(WordsInLine); + end; + end; + + Result := Result + Line + WideLF; + end; + end + else + begin + // At first we split the string into words with the last word being the + // first element in Words. + W := WordCounter - 1; + for I := 1 to Len do + if Buffer[I] = ' ' then + Dec(W) + else + Words[W] := Words[W] + Buffer[I]; + + // Compose Result. + while WordCounter > 0 do + begin + WordsInLine := 0; + Line := ''; + + while WordCounter > 0 do + begin + GetStringDrawRect(DC, Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter - 1], R, DrawFormat); + if R.Right > Width then + begin + // If at least one word fits into this line then continue with the next line. + if WordsInLine > 0 then + Break; + + Buffer := Words[WordCounter - 1]; + if Len > 1 then + begin + for Len := Length(Buffer) - 1 downto 2 do + begin + GetStringDrawRect(DC, LeftStr(Buffer, Len), R, DrawFormat); + if R.Right <= Width then + Break; + end; + end + else + Len := Length(Buffer); + + Line := Line + LeftStr(Buffer, Max(Len, 1)); + Words[WordCounter - 1] := RightStr(Buffer, Length(Buffer) - Max(Len, 1)); + if Words[WordCounter - 1] = '' then + Dec(WordCounter); + Break; + end + else + begin + Dec(WordCounter); + Line := Line + IfThen(WordsInLine > 0, ' ', '') + Words[WordCounter]; + Inc(WordsInLine); + end; + end; + + Result := Result + Line + WideLF; + end; + end; + + Len := Length(Result); + if Result[Len] = WideLF then + SetLength(Result, Len - 1); +end; + +//---------------------------------------------------------------------------------------------------------------------- + + +function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer; + +// Helper function to calculate the start address for the given row. + +begin + if Height > 0 then // bottom-up DIB + Row := Height - Row - 1; + // Return DWORD aligned address of the requested scanline. + Result := PAnsiChar(Bits) + Row * ((Width * 32 + 31) and not 31) div 8; +end; + + + +//---------------------------------------------------------------------------------------------------------------------- + +function GetBitmapBitsFromDeviceContext(DC: HDC; var Width, Height: Integer): Pointer; + +// Helper function used to retrieve the bitmap selected into the given device context. If there is a bitmap then +// the function will return a pointer to its bits otherwise nil is returned. +// Additionally the dimensions of the bitmap are returned. + +var + Bitmap: HBITMAP; + DIB: TDIBSection; + +begin + Result := nil; + Width := 0; + Height := 0; + + Bitmap := GetCurrentObject(DC, OBJ_BITMAP); + if Bitmap <> 0 then + begin + if GetObject(Bitmap, SizeOf(DIB), @DIB) = SizeOf(DIB) then + begin + Assert(DIB.dsBm.bmPlanes * DIB.dsBm.bmBitsPixel = 32, 'Alpha blending error: bitmap must use 32 bpp.'); + Result := DIB.dsBm.bmBits; + Width := DIB.dsBmih.biWidth; + Height := DIB.dsBmih.biHeight; + end; + end; + Assert(Result <> nil, 'Alpha blending DC error: no bitmap available.'); +end; + + +procedure AlphaBlendLineConstant(Source, Destination: Pointer; Count: Integer; ConstantAlpha, Bias: Integer); + +// Blends a line of Count pixels from Source to Destination using a constant alpha value. +// The layout of a pixel must be BGRA where A is ignored (but is calculated as the other components). +// ConstantAlpha must be in the range 0..255 where 0 means totally transparent (destination pixel only) +// and 255 totally opaque (source pixel only). +// Bias is an additional value which gets added to every component and must be in the range -128..127 +// + +{$IFNDEF ASSEMBLER} //new +var + Src, Dst: PCardinal; + i: Integer; + + S, D: Cardinal; + sB, sG, sR: Integer; + dB, dG, dR: Integer; + rB, rG, rR: Integer; +begin + Src := PCardinal(Source); + Dst := PCardinal(Destination); + + for i := 0 to Count - 1 do + begin + S := Src^; + D := Dst^; + + // Extract source components (BGRA) + sB := S and $FF; + sG := (S shr 8) and $FF; + sR := (S shr 16) and $FF; + + // Extract destination components (BGRA) + dB := D and $FF; + dG := (D shr 8) and $FF; + dR := (D shr 16) and $FF; + + // Blend: (alpha * (source - target) + 256 * target) / 256 + rB := (ConstantAlpha * (sB - dB) + (dB shl 8)) shr 8; + rG := (ConstantAlpha * (sG - dG) + (dG shl 8)) shr 8; + rR := (ConstantAlpha * (sR - dR) + (dR shl 8)) shr 8; + + // Bias handling: 0..255 -> -128..127 -> bias (saturated) -> 0..255 + rB := rB - 128 + Bias; + if rB < -128 then rB := -128 else + if rB > 127 then rB := 127; + rB := rB + 128; + + rG := rG - 128 + Bias; + if rG < -128 then rG := -128 else + if rG > 127 then rG := 127; + rG := rG + 128; + + rR := rR - 128 + Bias; + if rR < -128 then rR := -128 else + if rR > 127 then rR := 127; + rR := rR + 128; + + // Store result (preserve destination alpha) + Dst^ := + (D and $FF000000) or + (Cardinal(rR) shl 16) or + (Cardinal(rG) shl 8) or + Cardinal(rB); + + Inc(Src); + Inc(Dst); + end; +end; + {$ELSE} + {$IF defined(CPUX64)} + +// RCX contains Source +// RDX contains Destination +// R8D contains Count +// R9D contains ConstantAlpha +// Bias is on the stack + +asm + //.NOFRAME + + // Load XMM3 with the constant alpha value (replicate it for every component). + // Expand it to word size. + MOVD XMM3, R9D // ConstantAlpha + PUNPCKLWD XMM3, XMM3 + PUNPCKLDQ XMM3, XMM3 + + // Load XMM5 with the bias value. + MOVD XMM5, [Bias] + PUNPCKLWD XMM5, XMM5 + PUNPCKLDQ XMM5, XMM5 + + // Load XMM4 with 128 to allow for saturated biasing. + MOV R10D, 128 + MOVD XMM4, R10D + PUNPCKLWD XMM4, XMM4 + PUNPCKLDQ XMM4, XMM4 + +@1: // The pixel loop calculates an entire pixel in one run. + // Note: The pixel byte values are expanded into the higher bytes of a word due + // to the way unpacking works. We compensate for this with an extra shift. + MOVD XMM1, DWORD PTR [RCX] // data is unaligned + MOVD XMM2, DWORD PTR [RDX] // data is unaligned + PXOR XMM0, XMM0 // clear source pixel register for unpacking + PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words + PSRLW XMM0, 8 // move higher bytes to lower bytes + PXOR XMM1, XMM1 // clear target pixel register for unpacking + PUNPCKLBW XMM1, XMM2{[RDX]} // unpack target pixel byte values into words + MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again + PSRLW XMM1, 8 // move higher bytes to lower bytes + + // calculation is: target = (alpha * (source - target) + 256 * target) / 256 + PSUBW XMM0, XMM1 // source - target + PMULLW XMM0, XMM3 // alpha * (source - target) + PADDW XMM0, XMM2 // add target (in shifted form) + PSRLW XMM0, 8 // divide by 256 + + // Bias is accounted for by conversion of range 0..255 to -128..127, + // doing a saturated add and convert back to 0..255. + PSUBW XMM0, XMM4 + PADDSW XMM0, XMM5 + PADDW XMM0, XMM4 + PACKUSWB XMM0, XMM0 // convert words to bytes with saturation + MOVD DWORD PTR [RDX], XMM0 // store the result +@3: + ADD RCX, 4 + ADD RDX, 4 + DEC R8D + JNZ @1 +end; +{$else} +// EAX contains Source +// EDX contains Destination +// ECX contains Count +// ConstantAlpha and Bias are on the stack + +asm + PUSH ESI // save used registers + PUSH EDI + + MOV ESI, EAX // ESI becomes the actual source pointer + MOV EDI, EDX // EDI becomes the actual target pointer + + // Load MM6 with the constant alpha value (replicate it for every component). + // Expand it to word size. + MOV EAX, [ConstantAlpha] + DB $0F, $6E, $F0 /// MOVD MM6, EAX + DB $0F, $61, $F6 /// PUNPCKLWD MM6, MM6 + DB $0F, $62, $F6 /// PUNPCKLDQ MM6, MM6 + + // Load MM5 with the bias value. + MOV EAX, [Bias] + DB $0F, $6E, $E8 /// MOVD MM5, EAX + DB $0F, $61, $ED /// PUNPCKLWD MM5, MM5 + DB $0F, $62, $ED /// PUNPCKLDQ MM5, MM5 + + // Load MM4 with 128 to allow for saturated biasing. + MOV EAX, 128 + DB $0F, $6E, $E0 /// MOVD MM4, EAX + DB $0F, $61, $E4 /// PUNPCKLWD MM4, MM4 + DB $0F, $62, $E4 /// PUNPCKLDQ MM4, MM4 + +@1: // The pixel loop calculates an entire pixel in one run. + // Note: The pixel byte values are expanded into the higher bytes of a word due + // to the way unpacking works. We compensate for this with an extra shift. + DB $0F, $EF, $C0 /// PXOR MM0, MM0, clear source pixel register for unpacking + DB $0F, $60, $06 /// PUNPCKLBW MM0, [ESI], unpack source pixel byte values into words + DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, move higher bytes to lower bytes + DB $0F, $EF, $C9 /// PXOR MM1, MM1, clear target pixel register for unpacking + DB $0F, $60, $0F /// PUNPCKLBW MM1, [EDI], unpack target pixel byte values into words + DB $0F, $6F, $D1 /// MOVQ MM2, MM1, make a copy of the shifted values, we need them again + DB $0F, $71, $D1, $08 /// PSRLW MM1, 8, move higher bytes to lower bytes + + // calculation is: target = (alpha * (source - target) + 256 * target) / 256 + DB $0F, $F9, $C1 /// PSUBW MM0, MM1, source - target + DB $0F, $D5, $C6 /// PMULLW MM0, MM6, alpha * (source - target) + DB $0F, $FD, $C2 /// PADDW MM0, MM2, add target (in shifted form) + DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, divide by 256 + + // Bias is accounted for by conversion of range 0..255 to -128..127, + // doing a saturated add and convert back to 0..255. + DB $0F, $F9, $C4 /// PSUBW MM0, MM4 + DB $0F, $ED, $C5 /// PADDSW MM0, MM5 + DB $0F, $FD, $C4 /// PADDW MM0, MM4 + DB $0F, $67, $C0 /// PACKUSWB MM0, MM0, convert words to bytes with saturation + DB $0F, $7E, $07 /// MOVD [EDI], MM0, store the result +@3: + ADD ESI, 4 + ADD EDI, 4 + DEC ECX + JNZ @1 + POP EDI + POP ESI +end; + {$ENDIF} +{$ENDIF !ASSEMBLER} + + +//---------------------------------------------------------------------------------------------------------------------- + +procedure AlphaBlendLinePerPixel(Source, Destination: Pointer; Count, Bias: Integer); + +// Blends a line of Count pixels from Source to Destination using the alpha value of the source pixels. +// The layout of a pixel must be BGRA. +// Bias is an additional value which gets added to every component and must be in the range -128..127 +// +{$IFNDEF ASSMEBLER} //new +var + Src, Dst: PCardinal; + i: Integer; + + S, D: Cardinal; + sB, sG, sR, sA: Integer; + dB, dG, dR: Integer; + a: Integer; + + rB, rG, rR: Integer; +begin + Src := PCardinal(Source); + Dst := PCardinal(Destination); + + for i := 0 to Count - 1 do + begin + S := Src^; + D := Dst^; + + // Extract source BGRA + sB := S and $FF; + sG := (S shr 8) and $FF; + sR := (S shr 16) and $FF; + sA := (S shr 24) and $FF; + + // Extract destination BGR (alpha preserved) + dB := D and $FF; + dG := (D shr 8) and $FF; + dR := (D shr 16) and $FF; + + // Use source alpha per pixel + a := sA; // 0..255 + + // Blend formula: target = (alpha * (source - target) + 256 * target) / 256 + rB := (a * (sB - dB) + (dB shl 8)) shr 8; + rG := (a * (sG - dG) + (dG shl 8)) shr 8; + rR := (a * (sR - dR) + (dR shl 8)) shr 8; + + // Bias + clamp (branching) + rB := rB - 128 + Bias; + if rB < -128 then rB := -128 else if rB > 127 then rB := 127; + rB := rB + 128; + + rG := rG - 128 + Bias; + if rG < -128 then rG := -128 else if rG > 127 then rG := 127; + rG := rG + 128; + + rR := rR - 128 + Bias; + if rR < -128 then rR := -128 else if rR > 127 then rR := 127; + rR := rR + 128; + + // Store result (preserve destination alpha) + Dst^ := + (D and $FF000000) or + (Cardinal(rR) shl 16) or + (Cardinal(rG) shl 8) or + Cardinal(rB); + + Inc(Src); + Inc(Dst); + end; +end; + + {$ELSE} + {$IF defined(CPUX64)} +// RCX contains Source +// RDX contains Destination +// R8D contains Count +// R9D contains Bias + +asm + //.NOFRAME + + // Load XMM5 with the bias value. + MOVD XMM5, R9D // Bias + PUNPCKLWD XMM5, XMM5 + PUNPCKLDQ XMM5, XMM5 + + // Load XMM4 with 128 to allow for saturated biasing. + MOV R10D, 128 + MOVD XMM4, R10D + PUNPCKLWD XMM4, XMM4 + PUNPCKLDQ XMM4, XMM4 + +@1: // The pixel loop calculates an entire pixel in one run. + // Note: The pixel byte values are expanded into the higher bytes of a word due + // to the way unpacking works. We compensate for this with an extra shift. + MOVD XMM1, DWORD PTR [RCX] // data is unaligned + MOVD XMM2, DWORD PTR [RDX] // data is unaligned + PXOR XMM0, XMM0 // clear source pixel register for unpacking + PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words + PSRLW XMM0, 8 // move higher bytes to lower bytes + PXOR XMM1, XMM1 // clear target pixel register for unpacking + PUNPCKLBW XMM1, XMM2{[RDX]} // unpack target pixel byte values into words + MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again + PSRLW XMM1, 8 // move higher bytes to lower bytes + + // Load XMM3 with the source alpha value (replicate it for every component). + // Expand it to word size. + MOVQ XMM3, XMM0 + PUNPCKHWD XMM3, XMM3 + PUNPCKHDQ XMM3, XMM3 + + // calculation is: target = (alpha * (source - target) + 256 * target) / 256 + PSUBW XMM0, XMM1 // source - target + PMULLW XMM0, XMM3 // alpha * (source - target) + PADDW XMM0, XMM2 // add target (in shifted form) + PSRLW XMM0, 8 // divide by 256 + + // Bias is accounted for by conversion of range 0..255 to -128..127, + // doing a saturated add and convert back to 0..255. + PSUBW XMM0, XMM4 + PADDSW XMM0, XMM5 + PADDW XMM0, XMM4 + PACKUSWB XMM0, XMM0 // convert words to bytes with saturation + MOVD DWORD PTR [RDX], XMM0 // store the result +@3: + ADD RCX, 4 + ADD RDX, 4 + DEC R8D + JNZ @1 +end; +{$else} +// EAX contains Source +// EDX contains Destination +// ECX contains Count +// Bias is on the stack + +asm + PUSH ESI // save used registers + PUSH EDI + + MOV ESI, EAX // ESI becomes the actual source pointer + MOV EDI, EDX // EDI becomes the actual target pointer + + // Load MM5 with the bias value. + MOV EAX, [Bias] + DB $0F, $6E, $E8 /// MOVD MM5, EAX + DB $0F, $61, $ED /// PUNPCKLWD MM5, MM5 + DB $0F, $62, $ED /// PUNPCKLDQ MM5, MM5 + + // Load MM4 with 128 to allow for saturated biasing. + MOV EAX, 128 + DB $0F, $6E, $E0 /// MOVD MM4, EAX + DB $0F, $61, $E4 /// PUNPCKLWD MM4, MM4 + DB $0F, $62, $E4 /// PUNPCKLDQ MM4, MM4 + +@1: // The pixel loop calculates an entire pixel in one run. + // Note: The pixel byte values are expanded into the higher bytes of a word due + // to the way unpacking works. We compensate for this with an extra shift. + DB $0F, $EF, $C0 /// PXOR MM0, MM0, clear source pixel register for unpacking + DB $0F, $60, $06 /// PUNPCKLBW MM0, [ESI], unpack source pixel byte values into words + DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, move higher bytes to lower bytes + DB $0F, $EF, $C9 /// PXOR MM1, MM1, clear target pixel register for unpacking + DB $0F, $60, $0F /// PUNPCKLBW MM1, [EDI], unpack target pixel byte values into words + DB $0F, $6F, $D1 /// MOVQ MM2, MM1, make a copy of the shifted values, we need them again + DB $0F, $71, $D1, $08 /// PSRLW MM1, 8, move higher bytes to lower bytes + + // Load MM6 with the source alpha value (replicate it for every component). + // Expand it to word size. + DB $0F, $6F, $F0 /// MOVQ MM6, MM0 + DB $0F, $69, $F6 /// PUNPCKHWD MM6, MM6 + DB $0F, $6A, $F6 /// PUNPCKHDQ MM6, MM6 + + // calculation is: target = (alpha * (source - target) + 256 * target) / 256 + DB $0F, $F9, $C1 /// PSUBW MM0, MM1, source - target + DB $0F, $D5, $C6 /// PMULLW MM0, MM6, alpha * (source - target) + DB $0F, $FD, $C2 /// PADDW MM0, MM2, add target (in shifted form) + DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, divide by 256 + + // Bias is accounted for by conversion of range 0..255 to -128..127, + // doing a saturated add and convert back to 0..255. + DB $0F, $F9, $C4 /// PSUBW MM0, MM4 + DB $0F, $ED, $C5 /// PADDSW MM0, MM5 + DB $0F, $FD, $C4 /// PADDW MM0, MM4 + DB $0F, $67, $C0 /// PACKUSWB MM0, MM0, convert words to bytes with saturation + DB $0F, $7E, $07 /// MOVD [EDI], MM0, store the result +@3: + ADD ESI, 4 + ADD EDI, 4 + DEC ECX + JNZ @1 + POP EDI + POP ESI +end; + {$ENDIF} + {$ENDIF !ASSEMBLER} +//---------------------------------------------------------------------------------------------------------------------- + +procedure EMMS; + +// Reset MMX state to use the FPU for other tasks again. + +{$ifdef CPUX86} +asm + DB $0F, $77 /// EMMS +end; +{$else} +inline; +begin + +end; +{$endif} + +//---------------------------------------------------------------------------------------------------------------------- + +procedure AlphaBlendLineMaster(Source, Destination: Pointer; Count: Integer; ConstantAlpha, Bias: Integer); + +// Blends a line of Count pixels from Source to Destination using the source pixel and a constant alpha value. +// The layout of a pixel must be BGRA. +// ConstantAlpha must be in the range 0..255. +// Bias is an additional value which gets added to every component and must be in the range -128..127 + +{$IFNDEF ASSEMBLER} +var + Src, Dst: PCardinal; + i: Integer; + + S, D: Cardinal; + sB, sG, sR, sA: Integer; + dB, dG, dR: Integer; + a: Integer; + + rB, rG, rR: Integer; +begin + Src := PCardinal(Source); + Dst := PCardinal(Destination); + + for i := 0 to Count - 1 do + begin + S := Src^; + D := Dst^; + + // Extract source BGRA + sB := S and $FF; + sG := (S shr 8) and $FF; + sR := (S shr 16) and $FF; + sA := (S shr 24) and $FF; + + // Extract destination BGR (alpha preserved) + dB := D and $FF; + dG := (D shr 8) and $FF; + dR := (D shr 16) and $FF; + + // Effective alpha = source alpha * master alpha / 256 + a := (sA * ConstantAlpha) shr 8; + + // Blend + rB := (a * (sB - dB) + (dB shl 8)) shr 8; + rG := (a * (sG - dG) + (dG shl 8)) shr 8; + rR := (a * (sR - dR) + (dR shl 8)) shr 8; + + // Bias + clamp (branching, fastest on Win32) + rB := rB - 128 + Bias; + if rB < -128 then rB := -128 else + if rB > 127 then rB := 127; + rB := rB + 128; + + rG := rG - 128 + Bias; + if rG < -128 then rG := -128 else + if rG > 127 then rG := 127; + rG := rG + 128; + + rR := rR - 128 + Bias; + if rR < -128 then rR := -128 else + if rR > 127 then rR := 127; + rR := rR + 128; + + // Store result, preserve destination alpha + Dst^ := + (D and $FF000000) or + (Cardinal(rR) shl 16) or + (Cardinal(rG) shl 8) or + Cardinal(rB); + + Inc(Src); + Inc(Dst); + end; +end; + {$ELSE} + {$IF defined(CPUX64)} +// RCX contains Source +// RDX contains Destination +// R8D contains Count +// R9D contains ConstantAlpha +// Bias is on the stack + +asm + .SAVENV XMM6 + + // Load XMM3 with the constant alpha value (replicate it for every component). + // Expand it to word size. + MOVD XMM3, R9D // ConstantAlpha + PUNPCKLWD XMM3, XMM3 + PUNPCKLDQ XMM3, XMM3 + + // Load XMM5 with the bias value. + MOV R10D, [Bias] + MOVD XMM5, R10D + PUNPCKLWD XMM5, XMM5 + PUNPCKLDQ XMM5, XMM5 + + // Load XMM4 with 128 to allow for saturated biasing. + MOV R10D, 128 + MOVD XMM4, R10D + PUNPCKLWD XMM4, XMM4 + PUNPCKLDQ XMM4, XMM4 + +@1: // The pixel loop calculates an entire pixel in one run. + // Note: The pixel byte values are expanded into the higher bytes of a word due + // to the way unpacking works. We compensate for this with an extra shift. + MOVD XMM1, DWORD PTR [RCX] // data is unaligned + MOVD XMM2, DWORD PTR [RDX] // data is unaligned + PXOR XMM0, XMM0 // clear source pixel register for unpacking + PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words + PSRLW XMM0, 8 // move higher bytes to lower bytes + PXOR XMM1, XMM1 // clear target pixel register for unpacking + PUNPCKLBW XMM1, XMM2{[RCX]} // unpack target pixel byte values into words + MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again + PSRLW XMM1, 8 // move higher bytes to lower bytes + + // Load XMM6 with the source alpha value (replicate it for every component). + // Expand it to word size. + MOVQ XMM6, XMM0 + PUNPCKHWD XMM6, XMM6 + PUNPCKHDQ XMM6, XMM6 + PMULLW XMM6, XMM3 // source alpha * master alpha + PSRLW XMM6, 8 // divide by 256 + + // calculation is: target = (alpha * master alpha * (source - target) + 256 * target) / 256 + PSUBW XMM0, XMM1 // source - target + PMULLW XMM0, XMM6 // alpha * (source - target) + PADDW XMM0, XMM2 // add target (in shifted form) + PSRLW XMM0, 8 // divide by 256 + + // Bias is accounted for by conversion of range 0..255 to -128..127, + // doing a saturated add and convert back to 0..255. + PSUBW XMM0, XMM4 + PADDSW XMM0, XMM5 + PADDW XMM0, XMM4 + PACKUSWB XMM0, XMM0 // convert words to bytes with saturation + MOVD DWORD PTR [RDX], XMM0 // store the result +@3: + ADD RCX, 4 + ADD RDX, 4 + DEC R8D + JNZ @1 +end; +{$else} +// EAX contains Source +// EDX contains Destination +// ECX contains Count +// ConstantAlpha and Bias are on the stack + +asm + PUSH ESI // save used registers + PUSH EDI + + MOV ESI, EAX // ESI becomes the actual source pointer + MOV EDI, EDX // EDI becomes the actual target pointer + + // Load MM6 with the constant alpha value (replicate it for every component). + // Expand it to word size. + MOV EAX, [ConstantAlpha] + DB $0F, $6E, $F0 /// MOVD MM6, EAX + DB $0F, $61, $F6 /// PUNPCKLWD MM6, MM6 + DB $0F, $62, $F6 /// PUNPCKLDQ MM6, MM6 + + // Load MM5 with the bias value. + MOV EAX, [Bias] + DB $0F, $6E, $E8 /// MOVD MM5, EAX + DB $0F, $61, $ED /// PUNPCKLWD MM5, MM5 + DB $0F, $62, $ED /// PUNPCKLDQ MM5, MM5 + + // Load MM4 with 128 to allow for saturated biasing. + MOV EAX, 128 + DB $0F, $6E, $E0 /// MOVD MM4, EAX + DB $0F, $61, $E4 /// PUNPCKLWD MM4, MM4 + DB $0F, $62, $E4 /// PUNPCKLDQ MM4, MM4 + +@1: // The pixel loop calculates an entire pixel in one run. + // Note: The pixel byte values are expanded into the higher bytes of a word due + // to the way unpacking works. We compensate for this with an extra shift. + DB $0F, $EF, $C0 /// PXOR MM0, MM0, clear source pixel register for unpacking + DB $0F, $60, $06 /// PUNPCKLBW MM0, [ESI], unpack source pixel byte values into words + DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, move higher bytes to lower bytes + DB $0F, $EF, $C9 /// PXOR MM1, MM1, clear target pixel register for unpacking + DB $0F, $60, $0F /// PUNPCKLBW MM1, [EDI], unpack target pixel byte values into words + DB $0F, $6F, $D1 /// MOVQ MM2, MM1, make a copy of the shifted values, we need them again + DB $0F, $71, $D1, $08 /// PSRLW MM1, 8, move higher bytes to lower bytes + + // Load MM7 with the source alpha value (replicate it for every component). + // Expand it to word size. + DB $0F, $6F, $F8 /// MOVQ MM7, MM0 + DB $0F, $69, $FF /// PUNPCKHWD MM7, MM7 + DB $0F, $6A, $FF /// PUNPCKHDQ MM7, MM7 + DB $0F, $D5, $FE /// PMULLW MM7, MM6, source alpha * master alpha + DB $0F, $71, $D7, $08 /// PSRLW MM7, 8, divide by 256 + + // calculation is: target = (alpha * master alpha * (source - target) + 256 * target) / 256 + DB $0F, $F9, $C1 /// PSUBW MM0, MM1, source - target + DB $0F, $D5, $C7 /// PMULLW MM0, MM7, alpha * (source - target) + DB $0F, $FD, $C2 /// PADDW MM0, MM2, add target (in shifted form) + DB $0F, $71, $D0, $08 /// PSRLW MM0, 8, divide by 256 + + // Bias is accounted for by conversion of range 0..255 to -128..127, + // doing a saturated add and convert back to 0..255. + DB $0F, $F9, $C4 /// PSUBW MM0, MM4 + DB $0F, $ED, $C5 /// PADDSW MM0, MM5 + DB $0F, $FD, $C4 /// PADDW MM0, MM4 + DB $0F, $67, $C0 /// PACKUSWB MM0, MM0, convert words to bytes with saturation + DB $0F, $7E, $07 /// MOVD [EDI], MM0, store the result +@3: + ADD ESI, 4 + ADD EDI, 4 + DEC ECX + JNZ @1 + POP EDI + POP ESI +end; + {$ENDIF} + {$ENDIF !ASSEMBLER} + +//---------------------------------------------------------------------------------------------------------------------- + +procedure AlphaBlendLineMasterAndColor(Destination: Pointer; Count: Integer; ConstantAlpha, Color: Integer); + +// Blends a line of Count pixels in Destination against the given color using a constant alpha value. +// The layout of a pixel must be BGRA and Color must be rrggbb00 (as stored by a COLORREF). +// ConstantAlpha must be in the range 0..255. + +{$IFNDEF ASSEMBLER} +var + Dst: PCardinal; + i: Integer; + + dB, dG, dR: Integer; + rB, rG, rR: Integer; + + alpha: Integer; + F1B, F1G, F1R: Integer; // color * alpha + F2: Integer; // 256 - alpha + cR, cG, cB: Integer; +begin + Dst := PCardinal(Destination); + + // Extract color components (BGRA layout, Color in rrggbb00 format) + cR := (Color shr 16) and $FF; + cG := (Color shr 8) and $FF; + cB := Color and $FF; + + // Precompute alpha factors + alpha := ConstantAlpha; // 0..255 + F2 := 256 - alpha; // factor for destination + F1R := cR * alpha; // factor for color + F1G := cG * alpha; + F1B := cB * alpha; + + for i := 0 to Count - 1 do + begin + // Load destination + dB := Dst^ and $FF; + dG := (Dst^ shr 8) and $FF; + dR := (Dst^ shr 16) and $FF; + + // Blend formula: target = (F1 + F2 * target) / 256 + rB := (F1B + F2 * dB) shr 8; + rG := (F1G + F2 * dG) shr 8; + rR := (F1R + F2 * dR) shr 8; + + // Branching clamp (safe) + if rB < 0 then rB := 0 else if rB > 255 then rB := 255; + if rG < 0 then rG := 0 else if rG > 255 then rG := 255; + if rR < 0 then rR := 0 else if rR > 255 then rR := 255; + + // Store back, preserve alpha (destination alpha unchanged) + Dst^ := (Dst^ and $FF000000) or + (Cardinal(rR) shl 16) or + (Cardinal(rG) shl 8) or + Cardinal(rB); + + Inc(Dst); + end; +end; + {$ELSE} + {$IF defined(CPUX64)} +// RCX contains Destination +// EDX contains Count +// R8D contains ConstantAlpha +// R9D contains Color + +asm + //.NOFRAME + + // The used formula is: target = (alpha * color + (256 - alpha) * target) / 256. + // alpha * color (factor 1) and 256 - alpha (factor 2) are constant values which can be calculated in advance. + // The remaining calculation is therefore: target = (F1 + F2 * target) / 256 + + // Load XMM3 with the constant alpha value (replicate it for every component). + // Expand it to word size. (Every calculation here works on word sized operands.) + MOVD XMM3, R8D // ConstantAlpha + PUNPCKLWD XMM3, XMM3 + PUNPCKLDQ XMM3, XMM3 + + // Calculate factor 2. + MOV R10D, $100 + MOVD XMM2, R10D + PUNPCKLWD XMM2, XMM2 + PUNPCKLDQ XMM2, XMM2 + PSUBW XMM2, XMM3 // XMM2 contains now: 255 - alpha = F2 + + // Now calculate factor 1. Alpha is still in XMM3, but the r and b components of Color must be swapped. + BSWAP R9D // Color + ROR R9D, 8 + MOVD XMM1, R9D // Load the color and convert to word sized values. + PXOR XMM4, XMM4 + PUNPCKLBW XMM1, XMM4 + PMULLW XMM1, XMM3 // XMM1 contains now: color * alpha = F1 + +@1: // The pixel loop calculates an entire pixel in one run. + MOVD XMM0, DWORD PTR [RCX] + PUNPCKLBW XMM0, XMM4 + + PMULLW XMM0, XMM2 // calculate F1 + F2 * target + PADDW XMM0, XMM1 + PSRLW XMM0, 8 // divide by 256 + + PACKUSWB XMM0, XMM0 // convert words to bytes with saturation + MOVD DWORD PTR [RCX], XMM0 // store the result + + ADD RCX, 4 + DEC EDX + JNZ @1 +end; +{$else} +// EAX contains Destination +// EDX contains Count +// ECX contains ConstantAlpha +// Color is passed on the stack + +asm + // The used formula is: target = (alpha * color + (256 - alpha) * target) / 256. + // alpha * color (factor 1) and 256 - alpha (factor 2) are constant values which can be calculated in advance. + // The remaining calculation is therefore: target = (F1 + F2 * target) / 256 + + // Load MM3 with the constant alpha value (replicate it for every component). + // Expand it to word size. (Every calculation here works on word sized operands.) + DB $0F, $6E, $D9 /// MOVD MM3, ECX + DB $0F, $61, $DB /// PUNPCKLWD MM3, MM3 + DB $0F, $62, $DB /// PUNPCKLDQ MM3, MM3 + + // Calculate factor 2. + MOV ECX, $100 + DB $0F, $6E, $D1 /// MOVD MM2, ECX + DB $0F, $61, $D2 /// PUNPCKLWD MM2, MM2 + DB $0F, $62, $D2 /// PUNPCKLDQ MM2, MM2 + DB $0F, $F9, $D3 /// PSUBW MM2, MM3 // MM2 contains now: 255 - alpha = F2 + + // Now calculate factor 1. Alpha is still in MM3, but the r and b components of Color must be swapped. + MOV ECX, [Color] + BSWAP ECX + ROR ECX, 8 + DB $0F, $6E, $C9 /// MOVD MM1, ECX // Load the color and convert to word sized values. + DB $0F, $EF, $E4 /// PXOR MM4, MM4 + DB $0F, $60, $CC /// PUNPCKLBW MM1, MM4 + DB $0F, $D5, $CB /// PMULLW MM1, MM3 // MM1 contains now: color * alpha = F1 + +@1: // The pixel loop calculates an entire pixel in one run. + DB $0F, $6E, $00 /// MOVD MM0, [EAX] + DB $0F, $60, $C4 /// PUNPCKLBW MM0, MM4 + + DB $0F, $D5, $C2 /// PMULLW MM0, MM2 // calculate F1 + F2 * target + DB $0F, $FD, $C1 /// PADDW MM0, MM1 + DB $0F, $71, $D0, $08 /// PSRLW MM0, 8 // divide by 256 + + DB $0F, $67, $C0 /// PACKUSWB MM0, MM0 // convert words to bytes with saturation + DB $0F, $7E, $00 /// MOVD [EAX], MM0 // store the result + + ADD EAX, 4 + DEC EDX + JNZ @1 +end; + {$ENDIF} + {$ENDIF !ASSEMBLER} + +//---------------------------------------------------------------------------------------------------------------------- + +procedure AlphaBlend(Source, Destination: HDC; R: TRect; Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer); + +// Optimized alpha blend procedure using MMX instructions to perform as quick as possible. +// For this procedure to work properly it is important that both source and target bitmap use the 32 bit color format. +// R describes the source rectangle to work on. +// Target is the place (upper left corner) in the target bitmap where to blend to. Note that source width + X offset +// must be less or equal to the target width. Similar for the height. +// If Mode is bmConstantAlpha then the blend operation uses the given ConstantAlpha value for all pixels. +// If Mode is bmPerPixelAlpha then each pixel is blended using its individual alpha value (the alpha value of the source). +// If Mode is bmMasterAlpha then each pixel is blended using its individual alpha value multiplied by ConstantAlpha. +// If Mode is bmConstantAlphaAndColor then each destination pixel is blended using ConstantAlpha but also a constant +// color which will be obtained from Bias. In this case no offset value is added, otherwise Bias is used as offset. +// Blending of a color into target only (bmConstantAlphaAndColor) ignores Source (the DC) and Target (the position). +// CAUTION: This procedure does not check whether MMX instructions are actually available! Call it only if MMX is really +// usable. + +var + Y: Integer; + SourceRun, + TargetRun: PByte; + + SourceBits, + DestBits: Pointer; + SourceWidth, + SourceHeight, + DestWidth, + DestHeight: Integer; + +begin + if not IsRectEmpty(R) then + begin + // Note: it is tempting to optimize the special cases for constant alpha 0 and 255 by just ignoring soure + // (alpha = 0) or simply do a blit (alpha = 255). But this does not take the bias into account. + case Mode of + bmConstantAlpha: + begin + // Get a pointer to the bitmap bits for the source and target device contexts. + // Note: this supposes that both contexts do actually have bitmaps assigned! + SourceBits := GetBitmapBitsFromDeviceContext(Source, SourceWidth, SourceHeight); + DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight); + if Assigned(SourceBits) and Assigned(DestBits) then + begin + for Y := 0 to R.Bottom - R.Top - 1 do + begin + SourceRun := CalculateScanline(SourceBits, SourceWidth, SourceHeight, Y + R.Top); + Inc(SourceRun, 4 * R.Left); + TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + Target.Y); + Inc(TargetRun, 4 * Target.X); + AlphaBlendLineConstant(SourceRun, TargetRun, R.Right - R.Left, ConstantAlpha, Bias); + end; + end; + EMMS; + end; + bmPerPixelAlpha: + begin + SourceBits := GetBitmapBitsFromDeviceContext(Source, SourceWidth, SourceHeight); + DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight); + if Assigned(SourceBits) and Assigned(DestBits) then + begin + for Y := 0 to R.Bottom - R.Top - 1 do + begin + SourceRun := CalculateScanline(SourceBits, SourceWidth, SourceHeight, Y + R.Top); + Inc(SourceRun, 4 * R.Left); + TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + Target.Y); + Inc(TargetRun, 4 * Target.X); + AlphaBlendLinePerPixel(SourceRun, TargetRun, R.Right - R.Left, Bias); + end; + end; + EMMS; + end; + bmMasterAlpha: + begin + SourceBits := GetBitmapBitsFromDeviceContext(Source, SourceWidth, SourceHeight); + DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight); + if Assigned(SourceBits) and Assigned(DestBits) then + begin + for Y := 0 to R.Bottom - R.Top - 1 do + begin + SourceRun := CalculateScanline(SourceBits, SourceWidth, SourceHeight, Y + R.Top); + Inc(SourceRun, 4 * Target.X); + TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + Target.Y); + AlphaBlendLineMaster(SourceRun, TargetRun, R.Right - R.Left, ConstantAlpha, Bias); + end; + end; + EMMS; + end; + bmConstantAlphaAndColor: + begin + // Source is ignored since there is a constant color value. + DestBits := GetBitmapBitsFromDeviceContext(Destination, DestWidth, DestHeight); + if Assigned(DestBits) then + begin + for Y := 0 to R.Bottom - R.Top - 1 do + begin + TargetRun := CalculateScanline(DestBits, DestWidth, DestHeight, Y + R.Top); + Inc(TargetRun, 4 * R.Left); + AlphaBlendLineMasterAndColor(TargetRun, R.Right - R.Left, ConstantAlpha, Bias); + end; + end; + EMMS; + end; + end; + end; +end; + +function GetRGBColor(Value: TColor): DWORD; + +// Little helper to convert a Delphi color to an image list color. + +begin + Result := ColorToRGB(Value); + case Result of + clNone: + Result := CLR_NONE; + clDefault: + Result := CLR_DEFAULT; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure PrtStretchDrawDIB(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap); + +// Stretch draw on to the new canvas. + +var + Header, + Bits: Pointer; + HeaderSize, + BitsSize: Cardinal; + +begin + GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize); + + GetMem(Header, HeaderSize); + GetMem(Bits, BitsSize); + try + GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^); + StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - + DestRect.Top, 0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^), DIB_RGB_COLORS, SRCCOPY); + finally + FreeMem(Header); + FreeMem(Bits); + end; +end; + + +//---------------------------------------------------------------------------------------------------------------------- + + +procedure FillDragRectangles(DragWidth, DragHeight, DeltaX, DeltaY: Integer; var RClip, RScroll, RSamp1, RSamp2, RDraw1, RDraw2: TRect); + +begin + // ScrollDC limits + RClip := Rect(0, 0, DragWidth, DragHeight); + if DeltaX > 0 then + begin + // move to the left + if DeltaY = 0 then + begin + // move only to the left + // background movement + RScroll := Rect(0, 0, DragWidth - DeltaX, DragHeight); + RSamp1 := Rect(0, 0, DeltaX, DragHeight); + RDraw1 := Rect(DragWidth - DeltaX, 0, DeltaX, DragHeight); + end + else + if DeltaY < 0 then + begin + // move to bottom left + RScroll := Rect(0, -DeltaY, DragWidth - DeltaX, DragHeight); + RSamp1 := Rect(0, 0, DeltaX, DragHeight); + RSamp2 := Rect(DeltaX, DragHeight + DeltaY, DragWidth - DeltaX, -DeltaY); + RDraw1 := Rect(0, 0, DragWidth - DeltaX, -DeltaY); + RDraw2 := Rect(DragWidth - DeltaX, 0, DeltaX, DragHeight); + end + else + begin + // move to upper left + RScroll := Rect(0, 0, DragWidth - DeltaX, DragHeight - DeltaY); + RSamp1 := Rect(0, 0, DeltaX, DragHeight); + RSamp2 := Rect(DeltaX, 0, DragWidth - DeltaX, DeltaY); + RDraw1 := Rect(0, DragHeight - DeltaY, DragWidth - DeltaX, DeltaY); + RDraw2 := Rect(DragWidth - DeltaX, 0, DeltaX, DragHeight); + end; + end + else + if DeltaX = 0 then + begin + // vertical movement only + if DeltaY < 0 then + begin + // move downwards + RScroll := Rect(0, -DeltaY, DragWidth, DragHeight); + RSamp2 := Rect(0, DragHeight + DeltaY, DragWidth, -DeltaY); + RDraw2 := Rect(0, 0, DragWidth, -DeltaY); + end + else + begin + // move upwards + RScroll := Rect(0, 0, DragWidth, DragHeight - DeltaY); + RSamp2 := Rect(0, 0, DragWidth, DeltaY); + RDraw2 := Rect(0, DragHeight - DeltaY, DragWidth, DeltaY); + end; + end + else + begin + // move to the right + if DeltaY > 0 then + begin + // move up right + RScroll := Rect(-DeltaX, 0, DragWidth, DragHeight); + RSamp1 := Rect(0, 0, DragWidth + DeltaX, DeltaY); + RSamp2 := Rect(DragWidth + DeltaX, 0, -DeltaX, DragHeight); + RDraw1 := Rect(0, 0, -DeltaX, DragHeight); + RDraw2 := Rect(-DeltaX, DragHeight - DeltaY, DragWidth + DeltaX, DeltaY); + end + else + if DeltaY = 0 then + begin + // to the right only + RScroll := Rect(-DeltaX, 0, DragWidth, DragHeight); + RSamp1 := Rect(DragWidth + DeltaX, 0, -DeltaX, DragHeight); + RDraw1 := Rect(0, 0, -DeltaX, DragHeight); + end + else + begin + // move down right + RScroll := Rect(-DeltaX, -DeltaY, DragWidth, DragHeight); + RSamp1 := Rect(0, DragHeight + DeltaY, DragWidth + DeltaX, -DeltaY); + RSamp2 := Rect(DragWidth + DeltaX, 0, -DeltaX, DragHeight); + RDraw1 := Rect(0, 0, -DeltaX, DragHeight); + RDraw2 := Rect(-DeltaX, 0, DragWidth + DeltaX, -DeltaY); + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +type + TCustomImageListCast = class(TCustomImageList); + +procedure DrawImage(ImageList: TCustomImageList; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean); +begin + TCustomImageListCast(ImageList).DoDraw(Index, Canvas, X, Y, Style, Enabled) +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function IsMouseCursorVisible(): Boolean; var CI: TCursorInfo; begin @@ -1299,11 +1647,11 @@ function IsMouseCursorVisible(): Boolean; // CURSOR_SHOWING (1) Visible // CURSOR_SUPPRESSED (2) Touch/Pen Input (Windows 8+) // https://msdn.microsoft.com/en-us/library/windows/desktop/ms648381(v=vs.85).aspx -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure ScaleImageList(const ImgList: TImageList; M, D: Integer); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure ScaleImageList(const ImgList: TImageList; M, D: Integer); var ii : integer; mb, ib, sib, smb : TBitmap; @@ -1365,15 +1713,29 @@ procedure ScaleImageList(const ImgList: TImageList; M, D: Integer); finally TmpImgList.Free; end; -end; - -function IsHighContrastEnabled(): Boolean; -var - l: HIGHCONTRAST; -begin +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function IsHighContrastEnabled(): Boolean; +var + l: HIGHCONTRAST; +begin l.cbSize := SizeOf(l); Result := SystemParametersInfo(SPI_GETHIGHCONTRAST, 0, @l, 0) and ((l.dwFlags and HCF_HIGHCONTRASTON) <> 0); -end; - - -end. +end; + +//---------------------------------------------------------------------------------------------------------------------- +function Divide(const Dimension: Single; const DivideBy: Integer): Single; +begin + Result:= Dimension / DivideBy; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Divide(const Dimension: Integer; const DivideBy: Integer): Integer; +begin + Result:= Dimension div DivideBy; +end; + +end. diff --git a/Source/VirtualTrees.WorkerThread.pas b/Source/VirtualTrees.WorkerThread.pas index 0359da533..4e74d70ce 100644 --- a/Source/VirtualTrees.WorkerThread.pas +++ b/Source/VirtualTrees.WorkerThread.pas @@ -1,10 +1,11 @@ -unit VirtualTrees.WorkerThread; +unit VirtualTrees.WorkerThread; interface uses System.Classes, - VirtualTrees; + VirtualTrees.Types, + VirtualTrees.BaseTree; type // internal worker thread @@ -13,6 +14,7 @@ TWorkerThread = class(TThread) FCurrentTree: TBaseVirtualTree; FWaiterList: TThreadList; FRefCount: Integer; + FWorkEvent: THandle; class procedure EnsureCreated(); class procedure Dispose(CanBlock: Boolean); procedure WaitForValidationTermination(Tree: TBaseVirtualTree); @@ -27,9 +29,7 @@ TWorkerThread = class(TThread) class procedure ReleaseThreadReference(ACanBlock: Boolean = False); class procedure AddTree(Tree: TBaseVirtualTree); - class procedure RemoveTree(Tree: TBaseVirtualTree); - - property CurrentTree: TBaseVirtualTree read FCurrentTree; + class procedure RemoveTree(pTree: TBaseVirtualTree; pWaitForValidationTermination: Boolean); end; @@ -49,37 +49,32 @@ TBaseVirtualTreeCracker = class(TBaseVirtualTree) var WorkerThread: TWorkerThread = nil; - WorkEvent: THandle; + //----------------- TWorkerThread -------------------------------------------------------------------------------------- class procedure TWorkerThread.EnsureCreated(); begin if not Assigned(WorkerThread) then - begin - // Create an event used to trigger our worker thread when something is to do. - WorkEvent := CreateEvent(nil, False, False, nil); - if WorkEvent = 0 then - RaiseLastOSError; - // Create worker thread, initialize it and send it to its wait loop. WorkerThread := TWorkerThread.Create(); - end; end; -class procedure TWorkerThread.Dispose; +//---------------------------------------------------------------------------------------------------------------------- + +class procedure TWorkerThread.Dispose(CanBlock: Boolean); var LRef: TThread; begin WorkerThread.FreeOnTerminate := not CanBlock; WorkerThread.Terminate(); - SetEvent(WorkEvent); + SetEvent(WorkerThread.FWorkEvent); LRef := WorkerThread; - WorkerThread := nil; //Will be freed usinf TThreaf.FreeOnTerminate - CloseHandle(WorkEvent); + WorkerThread := nil; //Will be freed usinf TThread.FreeOnTerminate if CanBlock then LRef.Free; end; +//---------------------------------------------------------------------------------------------------------------------- class procedure TWorkerThread.AddThreadReference; begin @@ -105,9 +100,13 @@ class procedure TWorkerThread.ReleaseThreadReference(ACanBlock: Boolean); constructor TWorkerThread.Create(); begin + FWaiterList := TThreadList.Create; + // Create an event used to trigger our worker thread when something is to do. + FWorkEvent := CreateEvent(nil, False, False, nil); + if FWorkEvent = 0 then + RaiseLastOSError; inherited Create(False); FreeOnTerminate := True; - FWaiterList := TThreadList.Create; end; //---------------------------------------------------------------------------------------------------------------------- @@ -117,6 +116,7 @@ destructor TWorkerThread.Destroy; begin // First let the ancestor stop the thread before freeing our resources. inherited; + CloseHandle(FWorkEvent); FWaiterList.Free; end; @@ -127,9 +127,8 @@ procedure TWorkerThread.WaitForValidationTermination(Tree: TBaseVirtualTree); // Wait for any references to this tree to be released. while FCurrentTree = Tree do begin - Sleep(1); - if (toVariableNodeHeight in TBaseVirtualTreeCracker(Tree).TreeOptions.MiscOptions) then - CheckSynchronize(); // We need to call CheckSynchronize here because we are using TThread.Synchronize in TBaseVirtualTree.MeasureItemHeight() + Sleep(1); // Don't do busy waiting, let the OS scheduler give other threads a time slice + CheckSynchronize(); // We need to call CheckSynchronize here because we are using TThread.Synchronize in TBaseVirtualTree.MeasureItemHeight() and ChangeTreeStatesAsync() end; end; @@ -141,13 +140,14 @@ procedure TWorkerThread.Execute(); var EnterStates: TVirtualTreeStates; + lExceptAddr: Pointer; + lException: TObject; lCurrentTree: TBaseVirtualTree; - begin TThread.NameThreadForDebugging('VirtualTrees.TWorkerThread'); while not Terminated do - begin - WaitForSingleObject(WorkEvent, INFINITE); + try + WaitForSingleObject(FWorkEvent, INFINITE); if Terminated then exit; @@ -161,7 +161,7 @@ procedure TWorkerThread.Execute(); Delete(0); // If there is yet another tree to work on then set the work event to keep looping. if Count > 0 then - SetEvent(WorkEvent); + SetEvent(FWorkEvent); end else lCurrentTree := nil; @@ -178,13 +178,22 @@ procedure TWorkerThread.Execute(); EnterStates := []; if not (tsStopValidation in FCurrentTree.TreeStates) and TBaseVirtualTreeCracker(FCurrentTree).DoValidateCache then EnterStates := [tsUseCache]; - finally - FCurrentTree := nil; //Clear variable to prevent deadlock in CancelValidation. See #434 + FCurrentTree := nil; // Important: Clear variable before calling ChangeTreeStatesAsync() to prevent deadlock in WaitForValidationTermination(). See issue #1001 TBaseVirtualTreeCracker(lCurrentTree).ChangeTreeStatesAsync(EnterStates, [tsValidating, tsStopValidation]); - Queue(TBaseVirtualTreeCracker(lCurrentTree).UpdateEditBounds); end; end; + except + on Exception do + begin + lExceptAddr := ExceptAddr; + lException := AcquireExceptionObject; + TThread.Synchronize(nil, procedure + begin + raise lException at lExceptAddr; + end); + Continue; //the thread should continue to run + end; end;//while end; @@ -206,25 +215,25 @@ class procedure TWorkerThread.AddTree(Tree: TBaseVirtualTree); WorkerThread.FWaiterList.UnlockList; end; - SetEvent(WorkEvent); + SetEvent(WorkerThread.FWorkEvent); end; //---------------------------------------------------------------------------------------------------------------------- -class procedure TWorkerThread.RemoveTree(Tree: TBaseVirtualTree); - +class procedure TWorkerThread.RemoveTree(pTree: TBaseVirtualTree; pWaitForValidationTermination: Boolean); begin if not Assigned(WorkerThread) then exit; - Assert(Assigned(Tree), 'Tree must not be nil.'); + Assert(Assigned(pTree), 'pTree must not be nil.'); with WorkerThread.FWaiterList.LockList do try - Remove(Tree); + Remove(pTree); finally WorkerThread.FWaiterList.UnlockList; // Seen several AVs in this line, was called from TWorkerThrea.Destroy. Joachim Marder. end; - WorkerThread.WaitForValidationTermination(Tree); + if pWaitForValidationTermination then + WorkerThread.WaitForValidationTermination(pTree); end; diff --git a/Source/VirtualTrees.dtx b/Source/VirtualTrees.dtx index acc249d9c..d014da365 100644 --- a/Source/VirtualTrees.dtx +++ b/Source/VirtualTrees.dtx @@ -105,13 +105,13 @@ If Reverse is True then a right-to-left column is being drawn, hence horizontal X and Y describe the left upper corner of the line image rectangle, while H denotes its height (and width). @@TBaseVirtualTree.FAlignment - + @@TBaseVirtualTree.FAnimationDuration - + @@TBaseVirtualTree.FAnimationType - + @@TBaseVirtualTree.FAutoExpandDelay amount of milliseconds to wait until a node is expanded if it is the @@ -821,7 +821,7 @@ true size of the font @@TEnumFormatEtc - + @@ -908,7 +908,7 @@ Do nothing. Let the application paint the background. @@TScrollBarOptions - + @@TScrollBarOptions.FScrollBars used to hide or show vertical and/or horizontal scrollbar @@ -1129,7 +1129,7 @@ Description If this column is allowed to be clicked then it is also kept for later use. Summary -Determines the column from the given position and returns it. +Determines the column from the given position and returns it. @@TVirtualTreeColumns.AdjustHoverColumn@TPoint Summary @@ -2055,13 +2055,13 @@ Version 4.0.0 For full document history see help file. Credits for their valuable assistance and code donations go to: - Freddy Ertl, Marian Aldenhövel, Thomas Bogenrieder, Jim Kuenemann, Werner Lehmann, Jens Treichler, - Paul Gallagher (IBO tree), Ondrej Kelle, Ronaldo Melo Ferraz, Heri Bender, Roland Bedürftig (BCB) + Freddy Ertl, Marian Aldenh�vel, Thomas Bogenrieder, Jim Kuenemann, Werner Lehmann, Jens Treichler, + Paul Gallagher (IBO tree), Ondrej Kelle, Ronaldo Melo Ferraz, Heri Bender, Roland Bed�rftig (BCB) Anthony Mills, Alexander Egorushkin (BCB), Mathias Torell (BCB), Frank van den Bergh, Vadim Sedulin, Peter Evans, Milan Vandrovec (BCB), Steve Moss (system check images), Joe White, David Clark (local node memory manager), Anders Thomsen, Igor Afanasyev, Eugene Programmer Beta testers: - Freddy Ertl, Hans-Jürgen Schnorrenberg, Werner Lehmann, Jim Kueneman, Vadim Sedulin, Moritz Franckenstein, + Freddy Ertl, Hans-J�rgen Schnorrenberg, Werner Lehmann, Jim Kueneman, Vadim Sedulin, Moritz Franckenstein, Wim van der Vegt, Franc v/d Westelaken Indirect contribution (via publicly accessible work of those persons): Alex Denissov, Hiroyuki Hori (MMXAsm expert) @@ -2084,7 +2084,7 @@ Version 4.0.0 @@Check button image indices - + @@ckButtonHot @@ -4712,7 +4712,7 @@ written again and silently disappear. Another task of this method is to work around the problem that TCollection is not streamed correctly when using Visual -Form Inheritance (VFI). +Form Inheritance (VFI). @@TBaseVirtualTree.Destroy Summary @@ -5687,7 +5687,7 @@ Occasionally you may want to shorten the node text at a different position, for and not the last folder or filename should be cut off but rather some mid level folders if possible. In the handler S must be processed (shortened) and returned in Result. If Done is set to true (default value is false) -the tree view takes over the shortening. This is useful if not all nodes or columns need +the tree view takes over the shortening. This is useful if not all nodes or columns need @@TCustomVirtualStringTree.AdjustPaintCellRect@TVTPaintInfo@TColumnIndex Summary @@ -5732,7 +5732,7 @@ Summary Options related to automatic actions. Description -These options can be used to switch certain actions in a tree which happen automatically under certain circumstances. +These options can be used to switch certain actions in a tree which happen automatically under certain circumstances. @@TCustomVirtualTreeOptions.MiscOptions Summary @@ -5753,7 +5753,7 @@ Summary Options related to painting. Description -These options can be used to switch visual aspects of a tree. +These options can be used to switch visual aspects of a tree. @@TCustomVirtualTreeOptions.SelectionOptions Summary @@ -6456,14 +6456,15 @@ a method resolution clause to avoid a name clash. The clause can look similar to procedure EditLinkSetBounds(R: TRect); stdcall; procedure IVTEditLink.SetBounds = EditLinkSetBounds; - + @@TCheckImageKind.ckSystemDefault System defined check images. - @@THeaderState.hsResizing + +@@THeaderState.hsResizing multi column resizing in progress - + @@THeaderState.hsColumnWidthTrackPending left button is down, user might want to start resize a column - + @@THeaderState.hsColumnWidthTracking column resizing is in progress diff --git a/Source/VirtualTrees.pas b/Source/VirtualTrees.pas index dd740f984..b6be12751 100644 --- a/Source/VirtualTrees.pas +++ b/Source/VirtualTrees.pas @@ -1,5 +1,4 @@ - -unit VirtualTrees; +unit VirtualTrees; // The contents of this file are subject to the Mozilla Public License // Version 1.1 (the "License"); you may not use this file except in compliance @@ -23,15 +22,13 @@ // (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) // Anthony Mills, Alexander Egorushkin (BCB), Mathias Torell (BCB), Frank van den Bergh, Vadim Sedulin, Peter Evans, // Milan Vandrovec (BCB), Steve Moss, Joe White, David Clark, Anders Thomsen, Igor Afanasyev, Eugene Programmer, // Corbin Dunn, Richard Pringle, Uli Gerhardt, Azza, Igor Savkic, Daniel Bauten, Timo Tegtmeier, Dmitry Zegebart, -// Andreas Hausladen, Joachim Marder, Roman Kassebaum, Vincent Parret, Dietmar Roesler, Sanjay Kanade, +// Andreas Hausladen, Joachim Marder, Roman Kassebaum, Vincent Parrett, Dietmar Roesler, Sanjay Kanade, // and everyone that sent pull requests: https://github.com/Virtual-TreeView/Virtual-TreeView/pulls?q= // Beta testers: // Freddy Ertl, Hans-Juergen Schnorrenberg, Werner Lehmann, Jim Kueneman, Vadim Sedulin, Moritz Franckenstein, @@ -63,3519 +60,384 @@ 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")'} - uses - Winapi.Windows, Winapi.oleacc, Winapi.Messages, System.SysUtils, Vcl.Graphics, - Vcl.Controls, Vcl.Forms, Vcl.ImgList, Winapi.ActiveX, Vcl.StdCtrls, System.Classes, - Vcl.Menus, Vcl.Printers, System.Types, Winapi.CommCtrl, Vcl.Themes, Winapi.UxTheme, - Winapi.ShlObj, System.UITypes, System.Generics.Collections; -type + Winapi.Windows, Winapi.Messages, Winapi.ActiveX, + System.Classes, System.SysUtils, + Vcl.Graphics, Vcl.Controls, Vcl.ImgList, Vcl.Menus, Vcl.Themes, + VirtualTrees.Types, + VirtualTrees.Header, + VirtualTrees.BaseTree, {$IFDEF VT_FMX} - TDimension = Single; + VirtualTrees.AncestorFMX, {$ELSE} - TDimension = Integer; // For Firemonkey support, see #841 + VirtualTrees.AncestorVCL {$ENDIF} - -const - VTVersion = '7.2.1'; - -const - VTTreeStreamVersion = 3; - VTHeaderStreamVersion = 6; // The header needs an own stream version to indicate changes only relevant to the header. - - CacheThreshold = 2000; // Number of nodes a tree must at least have to start caching and at the same - // time the maximum number of nodes between two cache entries. - FadeAnimationStepCount = 255; // Number of animation steps for hint fading (0..255). - ShadowSize = 5; // Size in pixels of the hint shadow. This value has no influence on Win2K and XP systems - // as those OSes have native shadow support. - - // Special identifiers for columns. - NoColumn = -1; - InvalidColumn = -2; - - // Indices for check state images used for checking. - ckEmpty = 0; // an empty image used as place holder - // radio buttons - ckRadioUncheckedNormal = 1; - ckRadioUncheckedHot = 2; - ckRadioUncheckedPressed = 3; - ckRadioUncheckedDisabled = 4; - ckRadioCheckedNormal = 5; - ckRadioCheckedHot = 6; - ckRadioCheckedPressed = 7; - ckRadioCheckedDisabled = 8; - // check boxes - ckCheckUncheckedNormal = 9; - ckCheckUncheckedHot = 10; - ckCheckUncheckedPressed = 11; - ckCheckUncheckedDisabled = 12; - ckCheckCheckedNormal = 13; - ckCheckCheckedHot = 14; - ckCheckCheckedPressed = 15; - ckCheckCheckedDisabled = 16; - ckCheckMixedNormal = 17; - ckCheckMixedHot = 18; - ckCheckMixedPressed = 19; - ckCheckMixedDisabled = 20; - // simple button - ckButtonNormal = 21; - ckButtonHot = 22; - ckButtonPressed = 23; - ckButtonDisabled = 24; - - // Instead using a TTimer class for each of the various events I use Windows timers with messages - // as this is more economical. - ExpandTimer = 1; - EditTimer = 2; - HeaderTimer = 3; - ScrollTimer = 4; - ChangeTimer = 5; - StructureChangeTimer = 6; - SearchTimer = 7; - ThemeChangedTimer = 8; - - ThemeChangedTimerDelay = 500; - - // Virtual Treeview does not need to be subclassed by an eventual Theme Manager instance as it handles - // Windows XP theme painting itself. Hence the special message is used to prevent subclassing. - CM_DENYSUBCLASSING = CM_BASE + 2000; - - // Decoupling message for auto-adjusting the internal edit window. - CM_AUTOADJUST = CM_BASE + 2005; - - // VT's own clipboard formats, - // Note: The reference format is used internally to allow to link to a tree reference - // to implement optimized moves and other back references. - CFSTR_VIRTUALTREE = 'Virtual Tree Data'; - CFSTR_VTREFERENCE = 'Virtual Tree Reference'; - CFSTR_HTML = 'HTML Format'; - CFSTR_RTF = 'Rich Text Format'; - CFSTR_RTFNOOBJS = 'Rich Text Format Without Objects'; - CFSTR_CSV = 'CSV'; - - // Drag image helpers for Windows 2000 and up. - IID_IDropTargetHelper: TGUID = (D1: $4657278B; D2: $411B; D3: $11D2; D4: ($83, $9A, $00, $C0, $4F, $D9, $18, $D0)); - IID_IDragSourceHelper: TGUID = (D1: $DE5BF786; D2: $477A; D3: $11D2; D4: ($83, $9D, $00, $C0, $4F, $D9, $18, $D0)); - IID_IDropTarget: TGUID = (D1: $00000122; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); - - // Help identifiers for exceptions. Application developers are responsible to link them with actual help topics. - hcTFEditLinkIsNil = 2000; - hcTFWrongMoveError = 2001; - hcTFWrongStreamFormat = 2002; - hcTFWrongStreamVersion = 2003; - hcTFStreamTooSmall = 2004; - hcTFCorruptStream1 = 2005; - hcTFCorruptStream2 = 2006; - hcTFClipboardFailed = 2007; - hcTFCannotSetUserData = 2008; - - // Header standard split cursor. - crHeaderSplit = TCursor(63); - - // Height changing cursor. - crVertSplit = TCursor(62); - -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, - CF_CSV: Word; - - IsWinVistaOrAbove: Boolean; + ; + {$MinEnumSize 1, make enumerations as small as possible} - - type - // Alias defintions for convenience - TImageIndex = System.UITypes.TImageIndex; - TCanvas = Vcl.Graphics.TCanvas; - - - // The exception used by the trees. - EVirtualTreeError = class(Exception); - - PCardinal = ^Cardinal; - - // Limits the speed interval which can be used for auto scrolling (milliseconds). - TAutoScrollInterval = 1..1000; - - // Be careful when adding new states as this might change the size of the type which in turn - // changes the alignment in the node record as well as the stream chunks. - // Do not reorder the states and always add new states at the end of this enumeration in order to avoid - // breaking existing code. - TVirtualNodeState = ( - vsInitialized, // Set after the node has been initialized. - vsChecking, // Node's check state is changing, avoid propagation. - vsCutOrCopy, // Node is selected as cut or copy and paste source. - vsDisabled, // Set if node is disabled. - vsDeleting, // Set when the node is about to be freed. - vsExpanded, // Set if the node is expanded. - vsHasChildren, // Indicates the presence of child nodes without actually setting them. - vsVisible, // Indicate whether the node is visible or not (independant of the expand states of its parents). - vsSelected, // Set if the node is in the current selection. - vsOnFreeNodeCallRequired, // Set if user data has been set which requires OnFreeNode. - vsAllChildrenHidden, // Set if vsHasChildren is set and no child node has the vsVisible flag set. - vsReleaseCallOnUserDataRequired, // Indicates that the user data is a reference to an interface which should be released. - vsMultiline, // Node text is wrapped at the cell boundaries instead of being shorted. - vsHeightMeasured, // Node height has been determined and does not need a recalculation. - vsToggling, // Set when a node is expanded/collapsed to prevent recursive calls. - vsFiltered, // Indicates that the node should not be painted (without effecting its children). - vsInitializing // Set when the node is being initialized - ); - TVirtualNodeStates = set of TVirtualNodeState; - - // States used in InitNode to indicate states a node shall initially have. - TVirtualNodeInitState = ( - ivsDisabled, - ivsExpanded, - ivsHasChildren, - ivsMultiline, - ivsSelected, - ivsFiltered, - ivsReInit - ); - TVirtualNodeInitStates = set of TVirtualNodeInitState; - - TScrollBarStyle = ( - sbmRegular, - sbm3D - ); - - // Options per column. - TVTColumnOption = ( - coAllowClick, // Column can be clicked (must be enabled too). - coDraggable, // Column can be dragged. - coEnabled, // Column is enabled. - coParentBidiMode, // Column uses the parent's bidi mode. - coParentColor, // Column uses the parent's background color. - coResizable, // Column can be resized. - coShowDropMark, // Column shows the drop mark if it is currently the drop target. - coVisible, // Column is shown. - coAutoSpring, // Column takes part in the auto spring feature of the header (must be resizable too). - coFixed, // Column is fixed and can not be selected or scrolled etc. - coSmartResize, // Column is resized to its largest entry which is in view (instead of its largest - // visible entry). - coAllowFocus, // Column can be focused. - coDisableAnimatedResize, // Column resizing is not animated. - coWrapCaption, // Caption could be wrapped across several header lines to fit columns width. - coUseCaptionAlignment, // Column's caption has its own aligment. - coEditable, // Column can be edited - coStyleColor // Prefer background color of VCL style over TVirtualTreeColumn.Color - ); - TVTColumnOptions = set of TVTColumnOption; - - // These flags are used to indicate where a click in the header happened. - TVTHeaderHitPosition = ( - hhiNoWhere, // No column is involved (possible only if the tree is smaller than the client area). - hhiOnColumn, // On a column. - hhiOnIcon, // On the bitmap associated with a column. - hhiOnCheckbox // On the checkbox if enabled. - ); - TVTHeaderHitPositions = set of TVTHeaderHitPosition; - - // These flags are returned by the hit test method. - THitPosition = ( - hiAbove, // above the client area (if relative) or the absolute tree area - hiBelow, // below the client area (if relative) or the absolute tree area - hiNowhere, // no node is involved (possible only if the tree is not as tall as the client area) - hiOnItem, // on the bitmaps/buttons or label associated with an item - hiOnItemButton, // on the button associated with an item - hiOnItemButtonExact, // exactly on the button associated with an item - hiOnItemCheckbox, // on the checkbox if enabled - hiOnItemIndent, // in the indentation area in front of a node - hiOnItemLabel, // on the normal text area associated with an item - hiOnItemLeft, // in the area to the left of a node's text area (e.g. when right aligned or centered) - hiOnItemRight, // in the area to the right of a node's text area (e.g. if left aligned or centered) - hiOnNormalIcon, // on the "normal" image - hiOnStateIcon, // on the state image - hiToLeft, // to the left of the client area (if relative) or the absolute tree area - hiToRight, // to the right of the client area (if relative) or the absolute tree area - hiUpperSplitter, // in the upper splitter area of a node - hiLowerSplitter // in the lower splitter area of a node - ); - THitPositions = set of THitPosition; - - TCheckType = ( - ctNone, - ctTriStateCheckBox, - ctCheckBox, - ctRadioButton, - ctButton - ); - - // The check states include both, transient and fluent (temporary) states. The only temporary state defined so - // far is the pressed state. - TCheckState = ( - csUncheckedNormal, // unchecked and not pressed - csUncheckedPressed, // unchecked and pressed - csCheckedNormal, // checked and not pressed - csCheckedPressed, // checked and pressed - csMixedNormal, // 3-state check box and not pressed - csMixedPressed, // 3-state check box and pressed - csUncheckedDisabled,// disabled checkbox, not checkable - csCheckedDisabled, // disabled checkbox, not uncheckable - csMixedDisabled // disabled 3-state checkbox - ); - - /// Adds some convenience methods to type TCheckState - TCheckStateHelper = record helper for TCheckState - strict private - const - // Lookup to quickly convert a specific check state into its pressed counterpart and vice versa. - cPressedState: array[TCheckState] of TCheckState = ( - csUncheckedPressed, csUncheckedPressed, csCheckedPressed, csCheckedPressed, csMixedPressed, csMixedPressed, csUncheckedDisabled, csCheckedDisabled, csMixedDisabled); - cUnpressedState: array[TCheckState] of TCheckState = ( - csUncheckedNormal, csUncheckedNormal, csCheckedNormal, csCheckedNormal, csMixedNormal, csMixedNormal, csUncheckedDisabled, csCheckedDisabled, csMixedDisabled); - cEnabledState: array[TCheckState] of TCheckState = ( - csUncheckedNormal, csUncheckedPressed, csCheckedNormal, csCheckedPressed, csMixedNormal, csMixedPressed, csUncheckedNormal, csCheckedNormal, csMixedNormal); - cToggledState: array[TCheckState] of TCheckState = ( - csCheckedNormal, csCheckedPressed, csUnCheckedNormal, csUnCheckedPressed, csCheckedNormal, csCheckedPressed, csUncheckedDisabled, csCheckedDisabled, csMixedDisabled); - public - function GetPressed(): TCheckState; inline; - function GetUnpressed(): TCheckState; inline; - function GetEnabled(): TCheckState; inline; - function GetToggled(): TCheckState; inline; - function IsDisabled(): Boolean; inline; - function IsChecked(): Boolean; inline; - function IsUnChecked(): Boolean; inline; - function IsMixed(): Boolean; inline; - end; - - TCheckImageKind = ( - ckCustom, // application defined check images - ckSystemDefault // Uses the system check images, theme aware. - ); - - // mode to describe a move action - TVTNodeAttachMode = ( - amNoWhere, // just for simplified tests, means to ignore the Add/Insert command - amInsertBefore, // insert node just before destination (as sibling of destination) - amInsertAfter, // insert node just after destionation (as sibling of destination) - amAddChildFirst, // add node as first child of destination - amAddChildLast // add node as last child of destination - ); - - // modes to determine drop position further - TDropMode = ( - dmNowhere, - dmAbove, - dmOnNode, - dmBelow - ); - - // operations basically allowed during drag'n drop - TDragOperation = ( - doCopy, - doMove, - doLink - ); - TDragOperations = set of TDragOperation; - - TVTImageKind = ( - ikNormal, - ikSelected, - ikState, - ikOverlay - ); - - { - Fine points: Observed when fixing issue #623 - -- hmHint allows multiline hints automatically if provided through OnGetHint event. - This is irresptive of whether node itself is multi-line or not. - - -- hmToolTip shows a hint only when node text is not fully shown. It's meant to - fully show node text when not visible. It will show multi-line hint only if - the node itself is multi-line. If you provide a custom multi-line hint then - you must force linebreak style to hlbForceMultiLine in the OnGetHint event - in order to show the complete hint. - } - TVTHintMode = ( - hmDefault, // show the hint of the control - hmHint, // show node specific hint string returned by the application - hmHintAndDefault, // same as hmHint but show the control's hint if no node is concerned - hmTooltip // show the text of the node if it isn't already fully shown - ); - - // Indicates how to format a tooltip. - TVTTooltipLineBreakStyle = ( - hlbDefault, // Use multi-line style of the node. - hlbForceSingleLine, // Use single line hint. - hlbForceMultiLine // Use multi line hint. - ); - - TMouseButtons = set of TMouseButton; - - // Used to describe the action to do when using the OnBeforeItemErase event. - TItemEraseAction = ( - eaColor, // Use the provided color to erase the background instead the one of the tree. - eaDefault, // The tree should erase the item's background (bitmap or solid). - eaNone // Do nothing. Let the application paint the background. - ); - - - // There is a heap of switchable behavior in the tree. Since published properties may never exceed 4 bytes, - // which limits sets to at most 32 members, and because for better overview tree options are splitted - // in various sub-options and are held in a commom options class. - // - // Options to customize tree appearance: - TVTPaintOption = ( - toHideFocusRect, // Avoid drawing the dotted rectangle around the currently focused node. - toHideSelection, // Selected nodes are drawn as unselected nodes if the tree is unfocused. - toHotTrack, // Track which node is under the mouse cursor. - toPopupMode, // Paint tree as would it always have the focus (useful for tree combo boxes etc.) - toShowBackground, // Use the background image if there's one. - toShowButtons, // Display collapse/expand buttons left to a node. - toShowDropmark, // Show the dropmark during drag'n drop operations. - toShowHorzGridLines, // Display horizontal lines to simulate a grid. - toShowRoot, // Show lines also at top level (does not show the hidden/internal root node). - toShowTreeLines, // Display tree lines to show hierarchy of nodes. - toShowVertGridLines, // Display vertical lines (depending on columns) to simulate a grid. - toThemeAware, // Draw UI elements (header, tree buttons etc.) according to the current theme if - // enabled (Windows XP+ only, application must be themed). - toUseBlendedImages, // Enable alpha blending for ghosted nodes or those which are being cut/copied. - toGhostedIfUnfocused, // Ghosted images are still shown as ghosted if unfocused (otherwise the become non-ghosted - // images). - toFullVertGridLines, // Display vertical lines over the full client area, not only the space occupied by nodes. - // This option only has an effect if toShowVertGridLines is enabled too. - toAlwaysHideSelection, // Do not draw node selection, regardless of focused state. - toUseBlendedSelection, // Enable alpha blending for node selections. - toStaticBackground, // Show simple static background instead of a tiled one. - toChildrenAbove, // Display child nodes above their parent. - toFixedIndent, // Draw the tree with a fixed indent. - toUseExplorerTheme, // Use the explorer theme if run under Windows Vista (or above). - toHideTreeLinesIfThemed, // Do not show tree lines if theming is used. - toShowFilteredNodes // Draw nodes even if they are filtered out. - ); - TVTPaintOptions = set of TVTPaintOption; - - { Options to toggle animation support: - **Do not use toAnimatedToggle when a background image is used for the tree. - The animation does not look good as the image splits and moves with it. - } - TVTAnimationOption = ( - toAnimatedToggle, // Expanding and collapsing a node is animated (quick window scroll). - // **See note above. - toAdvancedAnimatedToggle // Do some advanced animation effects when toggling a node. - ); - TVTAnimationOptions = set of TVTAnimationOption; - - // Options which toggle automatic handling of certain situations: - TVTAutoOption = ( - toAutoDropExpand, // Expand node if it is the drop target for more than a certain time. - toAutoExpand, // Nodes are expanded (collapsed) when getting (losing) the focus. - toAutoScroll, // Scroll if mouse is near the border while dragging or selecting. - toAutoScrollOnExpand, // Scroll as many child nodes in view as possible after expanding a node. - toAutoSort, // Sort tree when Header.SortColumn or Header.SortDirection change or sort node if - // child nodes are added. Sorting will take place also if SortColum is NoColumn (-1). - toAutoSpanColumns, // Large entries continue into next column(s) if there's no text in them (no clipping). - toAutoTristateTracking, // Checkstates are automatically propagated for tri state check boxes. - toAutoHideButtons, // Node buttons are hidden when there are child nodes, but all are invisible. - toAutoDeleteMovedNodes, // Delete nodes which where moved in a drag operation (if not directed otherwise). - toDisableAutoscrollOnFocus, // Disable scrolling a node or column into view if it gets focused. - toAutoChangeScale, // Change default node height automatically if the system's font scale is set to big fonts. - toAutoFreeOnCollapse, // Frees any child node after a node has been collapsed (HasChildren flag stays there). - toDisableAutoscrollOnEdit, // Do not center a node horizontally when it is edited. - toAutoBidiColumnOrdering // When set then columns (if any exist) will be reordered from lowest index to highest index - // and vice versa when the tree's bidi mode is changed. - ); - TVTAutoOptions = set of TVTAutoOption; - - // Options which determine the tree's behavior when selecting nodes: - TVTSelectionOption = ( - toDisableDrawSelection, // Prevent user from selecting with the selection rectangle in multiselect mode. - toExtendedFocus, // Entries other than in the main column can be selected, edited etc. - toFullRowSelect, // Hit test as well as selection highlight are not constrained to the text of a node. - toLevelSelectConstraint, // Constrain selection to the same level as the selection anchor. - toMiddleClickSelect, // Allow selection, dragging etc. with the middle mouse button. This and toWheelPanning - // are mutual exclusive. - toMultiSelect, // Allow more than one node to be selected. - toRightClickSelect, // Allow selection, dragging etc. with the right mouse button. - toSiblingSelectConstraint, // Constrain selection to nodes with same parent. - toCenterScrollIntoView, // Center nodes vertically in the client area when scrolling into view. - toSimpleDrawSelection, // Simplifies draw selection, so a node's caption does not need to intersect with the - // selection rectangle. - toAlwaysSelectNode, // If this flag is set to true, the tree view tries to always have a node selected. - // This behavior is closer to the Windows TreeView and useful in Windows Explorer style applications. - toRestoreSelection, // Set to true if upon refill the previously selected nodes should be selected again. - // The nodes will be identified by its caption only. - toSyncCheckboxesWithSelection // If checkboxes are shown, they follow the change in selections. When checkboxes are - // changed, the selections follow them and vice-versa. - // **Only supported for ctCheckBox type checkboxes. - ); - TVTSelectionOptions = set of TVTSelectionOption; - - TVTEditOptions = ( - toDefaultEdit, // Standard behaviour for end of editing (after VK_RETURN stay on edited cell). - toVerticalEdit, // After VK_RETURN switch to next column. - toHorizontalEdit // After VK_RETURN switch to next row. - ); - - // Options which do not fit into any of the other groups: - TVTMiscOption = ( - toAcceptOLEDrop, // Register tree as OLE accepting drop target - toCheckSupport, // Show checkboxes/radio buttons. - toEditable, // Node captions can be edited. - toFullRepaintOnResize, // Fully invalidate the tree when its window is resized (CS_HREDRAW/CS_VREDRAW). - toGridExtensions, // Use some special enhancements to simulate and support grid behavior. - toInitOnSave, // Initialize nodes when saving a tree to a stream. - toReportMode, // Tree behaves like TListView in report mode. - toToggleOnDblClick, // Toggle node expansion state when it is double clicked. - toWheelPanning, // Support for mouse panning (wheel mice only). This option and toMiddleClickSelect are - // mutal exclusive, where panning has precedence. - toReadOnly, // The tree does not allow to be modified in any way. No action is executed and - // node editing is not possible. - toVariableNodeHeight, // When set then GetNodeHeight will trigger OnMeasureItem to allow variable node heights. - toFullRowDrag, // Start node dragging by clicking anywhere in it instead only on the caption or image. - // Must be used together with toDisableDrawSelection. - toNodeHeightResize, // Allows changing a node's height via mouse. - toNodeHeightDblClickResize, // Allows to reset a node's height to FDefaultNodeHeight via a double click. - toEditOnClick, // Editing mode can be entered with a single click - toEditOnDblClick, // Editing mode can be entered with a double click - toReverseFullExpandHotKey // Used to define Ctrl+'+' instead of Ctrl+Shift+'+' for full expand (and similar for collapsing) - ); - TVTMiscOptions = set of TVTMiscOption; - - // Options to control data export - TVTExportMode = ( - emAll, // export all records (regardless checked state) - emChecked, // export checked records only - emUnchecked, // export unchecked records only - emVisibleDueToExpansion, //Do not export nodes that are not visible because their parent is not expanded - emSelected // export selected nodes only - ); - - // Kinds of operations - TVTOperationKind = ( - okAutoFitColumns, - okGetMaxColumnWidth, - okSortNode, - okSortTree, - okExport, - okExpand - ); - TVTOperationKinds = set of TVTOperationKind; - - // content elements of the control from left to right, used when calculatin left margins. - TVTElement = ( - ofsMargin, // right of the margin - ofsToggleButton, // the exact x-postition of the toggle button - ofsCheckBox, - ofsStateImage, - ofsImage, - ofsLabel, // where drawing a selection begins - ofsText, // includes TextMargin - ofsRightOfText, // Includes NodeWidth and ExtraNodeWidth - ofsEndOfClientArea // The end of the paint area - ); - - /// An array that can be used to calculate the offsets ofthe elements in the tree. - TVTOffsets = array [TVTElement] of TDimension; - - TAddPopupItemType = ( - apNormal, - apDisabled, - apHidden - ); + // Some aliases for backward compatiblity + PVirtualNode = VirtualTrees.Types.PVirtualNode; + TVirtualNode = VirtualTrees.Types.TVirtualNode; + TVTHeaderColumnLayout = VirtualTrees.Types.TVTHeaderColumnLayout; + TSmartAutoFitType = VirtualTrees.Types.TSmartAutoFitType; + TVirtualTreeStates = VirtualTrees.Types.TVirtualTreeStates; + TCheckState = VirtualTrees.Types.TCheckState; + TCheckType = VirtualTrees.Types.TCheckType; + TSortDirection = VirtualTrees.Types.TSortDirection; + TColumnIndex = VirtualTrees.Types.TColumnIndex; + TVTColumnOption = VirtualTrees.Types.TVTColumnOption; + TVTHeaderHitInfo = VirtualTrees.Types.TVTHeaderHitInfo; + TVTHeaderHitPosition = VirtualTrees.Types.TVTHeaderHitPosition; + TVTHeaderHitPositions = VirtualTrees.Types.TVTHeaderHitPositions; + THeaderState = VirtualTrees.Types.THeaderState; + THeaderStates = VirtualTrees.Types.THeaderStates; + TDropMode = VirtualTrees.Types.TDropMode; + TFormatArray = VirtualTrees.Types.TFormatArray; + TVTHeaderOption = VirtualTrees.Types.TVTHeaderOption; + TVTHeaderOptions = VirtualTrees.Types.TVTHeaderOptions; + TVTHeaderStyle = VirtualTrees.Types.TVTHeaderStyle; + TVTExportType = VirtualTrees.Types.TVTExportType; + TVTImageKind = VirtualTrees.Types.TVTImageKind; + TVTExportMode = VirtualTrees.Types.TVTExportMode; + TVTOperationKind = VirtualTrees.Types.TVTOperationKind; + TVTUpdateState = VirtualTrees.Types.TVTUpdateState; + TVTCellPaintMode = VirtualTrees.Types.TVTCellPaintMode; + TVTCell = VirtualTrees.Types.TVTCell; + TVTCellArray = VirtualTrees.Types.TVTCellArray; + TVirtualNodeState = VirtualTrees.Types.TVirtualNodeState; + TVirtualNodeInitState = VirtualTrees.Types.TVirtualNodeInitState; + TVirtualNodeInitStates = VirtualTrees.Types.TVirtualNodeInitStates; + TVTTooltipLineBreakStyle = VirtualTrees.Types.TVTTooltipLineBreakStyle; + TVTNodeAttachMode = VirtualTrees.Types.TVTNodeAttachMode; + TNodeArray = VirtualTrees.Types.TNodeArray; + THitInfo = VirtualTrees.Types.THitInfo; + THitPosition = VirtualTrees.Types.THitPosition; + TVTPaintOption = VirtualTrees.Types.TVTPaintOption; + TVTAutoOption = VirtualTrees.Types.TVTAutoOption; + TVTAutoOptions = VirtualTrees.Types.TVTAutoOptions; + TVTSelectionOption = VirtualTrees.Types.TVTSelectionOption; + TVSTTextType = VirtualTrees.Types.TVSTTextType; + TVTHintMode = VirtualTrees.Types.TVTHintMode; + TBaseVirtualTree = VirtualTrees.BaseTree.TBaseVirtualTree; + IVTEditLink = VirtualTrees.BaseTree.IVTEditLink; + TVTHeaderNotifyEvent = VirtualTrees.BaseTree.TVTHeaderNotifyEvent; + TVTCompareEvent = VirtualTrees.BaseTree.TVTCompareEvent; + TVirtualTreeColumn = VirtualTrees.Header.TVirtualTreeColumn; + TVirtualTreeColumns = VirtualTrees.Header.TVirtualTreeColumns; + TVTHeader = VirtualTrees.Header.TVTHeader; + TVTHeaderClass = VirtualTrees.Header.TVTHeaderClass; + THeaderPaintInfo = VirtualTrees.Header.THeaderPaintInfo; + TVTConstraintPercent = VirtualTrees.Header.TVTConstraintPercent; + TVTFixedAreaConstraints = VirtualTrees.Header.TVTFixedAreaConstraints; + TColumnsArray = VirtualTrees.Header.TColumnsArray; + TCanvas = Vcl.Graphics.TCanvas; const - DefaultPaintOptions = [toShowButtons, toShowDropmark, toShowTreeLines, toShowRoot, toThemeAware, toUseBlendedImages]; - DefaultAnimationOptions = []; - DefaultAutoOptions = [toAutoDropExpand, toAutoTristateTracking, toAutoScrollOnExpand, toAutoDeleteMovedNodes, toAutoChangeScale, toAutoSort]; - DefaultSelectionOptions = []; - DefaultMiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, - toEditOnClick]; - DefaultColumnOptions = [coAllowClick, coDraggable, coEnabled, coParentColor, coParentBidiMode, coResizable, - coShowDropmark, coVisible, coAllowFocus, coEditable, coStyleColor]; + // Aliases for increased compatibility with V7, feel free to extend by pull requests + NoColumn = VirtualTrees.Types.NoColumn; + InvalidColumn = VirtualTrees.Types.InvalidColumn; + sdAscending = VirtualTrees.Types.TSortDirection.sdAscending; + sdDescending = VirtualTrees.Types.TSortDirection.sdDescending; + toAutoSort = VirtualTrees.Types.TVTAutoOption.toAutoSort; + toCheckSupport = VirtualTrees.Types.TVTMiscOption.toCheckSupport; + toEditable = VirtualTrees.Types.TVTMiscOption.toEditable; + toShowRoot = VirtualTrees.Types.TVTPaintOption.toShowRoot; + ctNone = VirtualTrees.Types.TCheckType.ctNone; + ctTriStateCheckBox = VirtualTrees.Types.TCheckType.ctTriStateCheckBox; + ctCheckBox = VirtualTrees.Types.TCheckType.ctCheckBox; + ctRadioButton = VirtualTrees.Types.TCheckType.ctRadioButton; + ctButton = VirtualTrees.Types.TCheckType.ctButton; + + csUncheckedNormal = VirtualTrees.Types.TCheckState.csUncheckedNormal; + csUncheckedPressed = VirtualTrees.Types.TCheckState.csUncheckedPressed; + csCheckedNormal = VirtualTrees.Types.TCheckState.csCheckedNormal; + csCheckedPressed = VirtualTrees.Types.TCheckState.csCheckedPressed; + csMixedNormal = VirtualTrees.Types.TCheckState.csMixedNormal; + csMixedPressed = VirtualTrees.Types.TCheckState.csMixedPressed; + csUncheckedDisabled = VirtualTrees.Types.TCheckState.csUncheckedDisabled; + csCheckedDisabled = VirtualTrees.Types.TCheckState.csCheckedDisabled; + csMixedDisable = VirtualTrees.Types.TCheckState.csMixedDisabled; + + coVisible = VirtualTrees.Types.TVTColumnOption.coVisible; + vsDisabled = VirtualTrees.Types.TVirtualNodeState.vsDisabled; + etHTML = VirtualTrees.Types.TVTExportType.etHTML; + hiOnItemButton = VirtualTrees.Types.THitPosition.hiOnItemButton; + dmOnNode = VirtualTrees.Types.TDropMode.dmOnNode; + hlbForceMultiLine = VirtualTrees.Types.TVTTooltipLineBreakStyle.hlbForceMultiLine; + hmHintAndDefault = VirtualTrees.Types.TVTHintMode.hmHintAndDefault; + hmTooltip = VirtualTrees.Types.TVTHintMode.hmTooltip; type - TBaseVirtualTree = class; - TVirtualTreeClass = class of TBaseVirtualTree; - - PVirtualNode = ^TVirtualNode; - - TColumnIndex = type Integer; - TColumnPosition = type Cardinal; - - // This record must already be defined here and not later because otherwise BCB users will not be able - // to compile (conversion done by BCB is wrong). - TCacheEntry = record - Node: PVirtualNode; - AbsoluteTop: Cardinal; - end; - - TCache = array of TCacheEntry; - TNodeArray = array of PVirtualNode; - - TCustomVirtualTreeOptions = class(TPersistent) - private - FOwner: TBaseVirtualTree; - FPaintOptions: TVTPaintOptions; - FAnimationOptions: TVTAnimationOptions; - FAutoOptions: TVTAutoOptions; - FSelectionOptions: TVTSelectionOptions; - FMiscOptions: TVTMiscOptions; - FExportMode: TVTExportMode; - FEditOptions: TVTEditOptions; - procedure SetAnimationOptions(const Value: TVTAnimationOptions); - procedure SetAutoOptions(const Value: TVTAutoOptions); - procedure SetMiscOptions(const Value: TVTMiscOptions); - procedure SetPaintOptions(const Value: TVTPaintOptions); - procedure SetSelectionOptions(const Value: TVTSelectionOptions); - protected - public - constructor Create(AOwner: TBaseVirtualTree); virtual; - procedure AssignTo(Dest: TPersistent); override; - property AnimationOptions: TVTAnimationOptions read FAnimationOptions write SetAnimationOptions default DefaultAnimationOptions; - property AutoOptions: TVTAutoOptions read FAutoOptions write SetAutoOptions default DefaultAutoOptions; - property ExportMode: TVTExportMode read FExportMode write FExportMode default emAll; - property MiscOptions: TVTMiscOptions read FMiscOptions write SetMiscOptions default DefaultMiscOptions; - property PaintOptions: TVTPaintOptions read FPaintOptions write SetPaintOptions default DefaultPaintOptions; - property SelectionOptions: TVTSelectionOptions read FSelectionOptions write SetSelectionOptions default DefaultSelectionOptions; - property EditOptions: TVTEditOptions read FEditOptions write FEditOptions default toDefaultEdit; - - property Owner: TBaseVirtualTree read FOwner; - end; - - TTreeOptionsClass = class of TCustomVirtualTreeOptions; - - TVirtualTreeOptions = class(TCustomVirtualTreeOptions) - published - property AnimationOptions; - property AutoOptions; - property ExportMode; - property MiscOptions; - property PaintOptions; - property SelectionOptions; - end; - - // Used in the CF_VTREFERENCE clipboard format. - PVTReference = ^TVTReference; - TVTReference = record - Process: Cardinal; - Tree: TBaseVirtualTree; - end; - - TVirtualNode = packed record - Index, // index of node with regard to its parent - ChildCount: Cardinal; // number of child nodes - NodeHeight: Word; // height in pixels - States: TVirtualNodeStates; // states describing various properties of the node (expanded, initialized etc.) - Align: Byte; // line/button alignment - CheckState: TCheckState; // indicates the current check state (e.g. checked, pressed etc.) - CheckType: TCheckType; // indicates which check type shall be used for this node - Dummy: Byte; // dummy value to fill DWORD boundary TODO: Is this still necessary? - TotalCount, // sum of this node, all of its child nodes and their child nodes etc. - TotalHeight: Cardinal; // height in pixels this node covers on screen including the height of all of its - // children - // 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 - // data) then put them before field Parent. - Parent, // reference to the node's parent (for the root this contains the treeview) - PrevSibling, // link to the node's previous sibling or nil if it is the first node - NextSibling, // link to the node's next sibling or nil if it is the last node - FirstChild, // link to the node's first child... - LastChild: PVirtualNode; // link to the node's last child... - private - Data: record end; // this is a placeholder, each node gets extra data determined by NodeDataSize - public - function IsAssigned(): Boolean; inline; - function GetData(): Pointer; overload; inline; - function GetData(): T; overload; inline; - procedure SetData(pUserData: Pointer); overload; - procedure SetData(pUserData: T); overload; - procedure SetData(const pUserData: IInterface); overload; - end; - - - // Structure used when info about a certain position in the header is needed. - TVTHeaderHitInfo = record - X, - Y: TDimension; - Button: TMouseButton; - Shift: TShiftState; - Column: TColumnIndex; - HitPosition: TVTHeaderHitPositions; - end; + TCustomVirtualStringTree = class; - // Structure used when info about a certain position in the tree is needed. - THitInfo = record - HitNode: PVirtualNode; - HitPositions: THitPositions; - HitColumn: TColumnIndex; - HitPoint: TPoint; - end; +{$IFDEF VT_FMX} + TVTAncestor = TVTAncestorFMX; +{$ELSE} + TVTAncestor = TVTAncestorVcl; +{$ENDIF} - // auto scroll directions - TScrollDirections = set of ( - sdLeft, - sdUp, - sdRight, - sdDown + // Describes the source to use when converting a string tree into a string for clipboard etc. + TVSTTextSourceType = ( + tstAll, // All nodes are rendered. Initialization is done on the fly. + tstInitialized, // Only initialized nodes are rendered. + tstSelected, // Only selected nodes are rendered. + tstCutCopySet, // Only nodes currently marked as being in the cut/copy clipboard set are rendered. + tstVisible, // Only visible nodes are rendered. + tstChecked // Only checked nodes are rendered ); - // OLE drag'n drop support - TFormatEtcArray = array of TFormatEtc; - TFormatArray = array of Word; - - // IDataObject.SetData support - TInternalStgMedium = packed record - Format: TClipFormat; - Medium: TStgMedium; - end; - TInternalStgMediumArray = array of TInternalStgMedium; - - TEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc) - private - FTree: TBaseVirtualTree; - FFormatEtcArray: TFormatEtcArray; - FCurrentIndex: Integer; - public - constructor Create(Tree: TBaseVirtualTree; const AFormatEtcArray: TFormatEtcArray); - - function Clone(out Enum: IEnumFormatEtc): HResult; stdcall; - function Next(celt: Integer; out elt; pceltFetched: PLongint): HResult; stdcall; - function Reset: HResult; stdcall; - function Skip(celt: Integer): HResult; stdcall; - end; - - // ----- OLE drag'n drop handling - - IVTDragManager = interface(IUnknown) - ['{C4B25559-14DA-446B-8901-0C879000EB16}'] - procedure ForceDragLeave; stdcall; - function GetDataObject: IDataObject; stdcall; - function GetDragSource: TBaseVirtualTree; stdcall; - function GetDropTargetHelperSupported: Boolean; stdcall; - function GetIsDropTarget: Boolean; stdcall; - - property DataObject: IDataObject read GetDataObject; - property DragSource: TBaseVirtualTree read GetDragSource; - property DropTargetHelperSupported: Boolean read GetDropTargetHelperSupported; - property IsDropTarget: Boolean read GetIsDropTarget; - end; - - // This data object is used in two different places. One is for clipboard operations and the other while dragging. - TVTDataObject = class(TInterfacedObject, IDataObject) - private - FOwner: TBaseVirtualTree; // 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 - FAdviseHolder: IDataAdviseHolder; // Reference to an OLE supplied implementation for advising. - protected - function CanonicalIUnknown(const TestUnknown: IUnknown): IUnknown; - function EqualFormatEtc(FormatEtc1, FormatEtc2: TFormatEtc): Boolean; - function FindFormatEtc(TestFormatEtc: TFormatEtc; const FormatEtcArray: TFormatEtcArray): integer; - function FindInternalStgMedium(Format: TClipFormat): PStgMedium; - function HGlobalClone(HGlobal: THandle): THandle; - function RenderInternalOLEData(const FormatEtcIn: TFormatEtc; var Medium: TStgMedium; var OLEResult: HResult): Boolean; - function StgMediumIncRef(const InStgMedium: TStgMedium; var OutStgMedium: TStgMedium; - CopyInMedium: Boolean; const DataObject: IDataObject): HRESULT; - - property ForClipboard: Boolean read FForClipboard; - property FormatEtcArray: TFormatEtcArray read FFormatEtcArray write FFormatEtcArray; - property InternalStgMediumArray: TInternalStgMediumArray read FInternalStgMediumArray write FInternalStgMediumArray; - property Owner: TBaseVirtualTree read FOwner; - public - constructor Create(AOwner: TBaseVirtualTree; ForClipboard: Boolean); virtual; - destructor Destroy; override; - - function DAdvise(const FormatEtc: TFormatEtc; advf: Integer; const advSink: IAdviseSink; out dwConnection: Integer): - HResult; virtual; stdcall; - function DUnadvise(dwConnection: Integer): HResult; virtual; stdcall; - function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; virtual; stdcall; - function EnumFormatEtc(Direction: Integer; out EnumFormatEtc: IEnumFormatEtc): HResult; virtual; stdcall; - function GetCanonicalFormatEtc(const FormatEtc: TFormatEtc; out FormatEtcOut: TFormatEtc): HResult; virtual; stdcall; - function GetData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium): HResult; virtual; stdcall; - function GetDataHere(const FormatEtc: TFormatEtc; out Medium: TStgMedium): HResult; virtual; stdcall; - function QueryGetData(const FormatEtc: TFormatEtc): HResult; virtual; stdcall; - function SetData(const FormatEtc: TFormatEtc; var Medium: TStgMedium; DoRelease: BOOL): HResult; virtual; stdcall; - end; - - // TVTDragManager is a class to manage drag and drop in a Virtual Treeview. - TVTDragManager = class(TInterfacedObject, IVTDragManager, IDropSource, IDropTarget) - 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. - 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 - FFullDragging: BOOL; // True, if full dragging is currently enabled in the system. - - function GetDataObject: IDataObject; stdcall; - function GetDragSource: TBaseVirtualTree; stdcall; - function GetDropTargetHelperSupported: Boolean; stdcall; - function GetIsDropTarget: Boolean; stdcall; - public - constructor Create(AOwner: TBaseVirtualTree); virtual; - destructor Destroy; override; - - function DragEnter(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; - var Effect: Longint): HResult; stdcall; - function DragLeave: HResult; stdcall; - function DragOver(KeyState: Integer; Pt: TPoint; var Effect: LongInt): HResult; stdcall; - function Drop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; stdcall; - procedure ForceDragLeave; stdcall; - function GiveFeedback(Effect: Integer): HResult; stdcall; - function QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; stdcall; - end; + TVSTGetTextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType; var CellText: string) of object; + TVSTGetHintEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string) of object; + // New text can only be set for variable caption. + TVSTNewTextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + NewText: string) of object; + /// String tree event for custom handling of string abbreviations. + /// The instance that fired the event. + /// Teh canvas on that the sending control will paint. + /// The Node that is going to be painted. + /// The column index that is going to be painted. + /// Var parameter that contains the caption or string that should be used. + /// Boolean var paramter: Assign True if a string is passed in the Result parameter. Leave the default value False if no shorting is need or the control shuld do it. + /// + /// If the text of a node does not fit into its cell (in grid mode) or is too wide for the width of the tree view it is being abbreviated with an ellipsis (...). By default the ellipsis is added to the end of the node text. + /// Occasionally you may want to shorten the node text at a different position, for example if the node text is a path string and not the last folder or filename should be cut off but rather some mid level folders if possible. + /// + TVSTShortenStringEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + Column: TColumnIndex; const S: string; TextSpace: TDimension; var Result: string; + var Done: Boolean) of object; + TVTMeasureTextEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + Column: TColumnIndex; const Text: string; var Extent: TDimension) of object; + TVTDrawTextEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + Column: TColumnIndex; const Text: string; const CellRect: TRect; var DefaultDraw: Boolean) of object; + TVTDrawTextExEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + Column: TColumnIndex; const Text: string; const CellRect: TRect; + var DefaultDraw: Boolean; var DrawFormat: Cardinal) of object; - PVTHintData = ^TVTHintData; - TVTHintData = record - Tree: TBaseVirtualTree; + /// Event arguments of the OnGetCellText event + TVSTGetCellTextEventArgs = record Node: PVirtualNode; Column: TColumnIndex; - HintRect: TRect; // used for draw trees only, string trees get the size from the hint string - HintText: string; // set when size of the hint window is calculated - BidiMode: TBidiMode; - Alignment: TAlignment; - LineBreakStyle: TVTToolTipLineBreakStyle; - end; - - // The trees need an own hint window class because of Unicode output and adjusted font. - TVirtualTreeHintWindow = class(THintWindow) - strict private - FHintData: TVTHintData; - FTextHeight: TDimension; - procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; - procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; - strict protected - procedure CreateParams(var Params: TCreateParams); override; - procedure Paint; override; - public - function CalcHintRect(MaxWidth: TDimension; const AHint: string; AData: Pointer): TRect; override; - function IsHintMsg(var Msg: TMsg): Boolean; override; + CellText: string; + StaticText: string; + StaticTextAlignment: TAlignment; + ExportType: TVTExportType; + constructor Create(pNode: PVirtualNode; pColumn: TColumnIndex; pExportType: TVTExportType = TVTExportType.etNone); end; - // Drag image support for the tree. - TVTTransparency = 0..255; - TVTBias = -128..127; - - // Simple move limitation for the drag image. - TVTDragMoveRestriction = ( - dmrNone, - dmrHorizontalOnly, - dmrVerticalOnly - ); - - 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. - ); + /// Event signature which is called when text is painted on the canvas or needed for the export. + TVSTGetCellTextEvent = procedure(Sender: TCustomVirtualStringTree; var E: TVSTGetCellTextEventArgs) of object; - // Class to manage header and tree drag image during a drag'n drop operation. - TVTDragImage = class + TCustomVirtualStringTree = class(TVTAncestor) private - FOwner: TBaseVirtualTree; - 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); - procedure RecaptureBackground(Tree: TBaseVirtualTree; R: TRect; VisibleRegion: HRGN; CaptureNCArea, - ReshowDragImage: Boolean); - function WillMove(P: TPoint): Boolean; - property Visible: Boolean read GetVisible; - property PreBlendBias: TVTBias read FPreBlendBias write FPreBlendBias default 0; - property Transparency: TVTTransparency read FTransparency write FTransparency default 128; - property ColorKey: TColor read FColorKey write FColorKey default clWindow; - property Fade: Boolean read FFade write FFade default False; - public - constructor Create(AOwner: TBaseVirtualTree); - 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 ShowDragImage; - - property MoveRestriction: TVTDragMoveRestriction read FRestriction write FRestriction default dmrNone; - end; - - // tree columns implementation - TVirtualTreeColumns = class; - TVTHeader = class; - - TVirtualTreeColumnStyle = ( - vsText, - vsOwnerDraw - ); + FInternalDataOffset: Cardinal; // offset to the internal data of the string tree + FDefaultText: string; // text to show if there's no OnGetText event handler (e.g. at design time) + FTextHeight: Integer; // true size of the font + FEllipsisWidth: Integer; // width of '...' for the current font - TVTHeaderColumnLayout = ( - blGlyphLeft, - blGlyphRight, - blGlyphTop, - blGlyphBottom - ); + FOnGetText: TVSTGetTextEvent; // used to retrieve the string to be displayed for a specific node + fOnGetCellText: TVSTGetCellTextEvent; // used to retrieve the normal and static text of a tree node + FOnGetHint: TVSTGetHintEvent; // used to retrieve the hint to be displayed for a specific node + FOnNewText: TVSTNewTextEvent; // used to notify the application about an edited node caption + FOnShortenString: TVSTShortenStringEvent; // used to allow the application a customized string shortage + FOnMeasureTextWidth: TVTMeasureTextEvent; // used to adjust the width of the cells + FOnMeasureTextHeight: TVTMeasureTextEvent; + FOnDrawText: TVTDrawTextEvent; // used to custom draw the node text + FOnDrawTextEx: TVTDrawTextExEvent; // a more advanced version, with all parameters + /// Returns True if the property DefaultText has a value that differs from the default value, False otherwise. + function IsDefaultTextStored(): Boolean; + function GetImageText(Node: PVirtualNode; Kind: TVTImageKind; + Column: TColumnIndex): string; + function GetOptions: TCustomStringTreeOptions; + function GetStaticText(Node: PVirtualNode; Column: TColumnIndex): string; + function GetText(Node: PVirtualNode; Column: TColumnIndex): string; + procedure ReadText(Reader: TReader); + procedure WriteText(Writer: TWriter); + procedure ResetInternalData(Node: PVirtualNode; Recursive: Boolean); + procedure SetDefaultText(const Value: string); + procedure SetOptions(const Value: TCustomStringTreeOptions); + procedure SetText(Node: PVirtualNode; Column: TColumnIndex; const Value: string); + procedure WMSetFont(var Msg: TWMSetFont); message WM_SETFONT; + procedure GetDataFromGrid(const AStrings : TStringList; const IncludeHeading : Boolean = True); + protected + /// Contains the name of the string that should be restored as selection + /// + FPreviouslySelected: TStringList; + procedure InitializeTextProperties(var PaintInfo: TVTPaintInfo); + procedure PaintNormalText(var PaintInfo: TVTPaintInfo; TextOutFlags: Integer; Text: string); virtual; + procedure PaintStaticText(const PaintInfo: TVTPaintInfo; pStaticTextAlignment: TAlignment; const Text: string); virtual; // [IPK] - private to protected + procedure AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var NextNonEmpty: TColumnIndex); override; + function CanExportNode(Node: PVirtualNode): Boolean; + function CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): TDimension; virtual; + function CalculateTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): TDimension; virtual; + function ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; override; + procedure DefineProperties(Filer: TFiler); override; + function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; override; + procedure DoAddToSelection(Node: PVirtualNode); override; + function DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; override; + function DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; override; + function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; override; + function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; override; + procedure DoGetText(var pEventArgs: TVSTGetCellTextEventArgs); virtual; + function DoIncrementalSearch(Node: PVirtualNode; const Text: string): Integer; override; + procedure DoNewText(Node: PVirtualNode; Column: TColumnIndex; const Text: string); virtual; + procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override; + function DoShortenString(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const S: string; Width: TDimension; + EllipsisWidth: TDimension = 0): string; virtual; + procedure DoTextDrawing(var PaintInfo: TVTPaintInfo; const Text: string; CellRect: TRect; DrawFormat: Cardinal); virtual; + function DoTextMeasuring(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): TSize; virtual; + function GetOptionsClass: TTreeOptionsClass; override; + procedure GetRenderStartValues(Source: TVSTTextSourceType; var Node: PVirtualNode; + var NextNodeProc: TGetNextNodeProc); + function InternalData(Node: PVirtualNode): Pointer; + procedure MainColumnChanged; override; + function ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, + ChunkSize: Integer): Boolean; override; + procedure ReadOldStringOptions(Reader: TReader); + function RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HResult; override; + procedure SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal); override; + procedure WriteChunks(Stream: TStream; Node: PVirtualNode); override; - TSortDirection = ( - sdAscending, - sdDescending - ); + property DefaultText: string read FDefaultText write SetDefaultText stored False;// Stored via own writer + property EllipsisWidth: Integer read FEllipsisWidth; + property TreeOptions: TCustomStringTreeOptions read GetOptions write SetOptions; - TSortDirectionHelper = record helper for VirtualTrees.TSortDirection - strict private - const cSortDirectionToInt: Array [TSortDirection] of Integer = (1, -1); + property OnGetHint: TVSTGetHintEvent read FOnGetHint write FOnGetHint; + property OnGetText: TVSTGetTextEvent read FOnGetText write FOnGetText; + property OnGetCellText: TVSTGetCellTextEvent read fOnGetCellText write fOnGetCellText; + property OnNewText: TVSTNewTextEvent read FOnNewText write FOnNewText; + property OnShortenString: TVSTShortenStringEvent read FOnShortenString write FOnShortenString; + property OnMeasureTextWidth: TVTMeasureTextEvent read FOnMeasureTextWidth write FOnMeasureTextWidth; + property OnMeasureTextHeight: TVTMeasureTextEvent read FOnMeasureTextHeight write FOnMeasureTextHeight; + property OnDrawText: TVTDrawTextEvent read FOnDrawText write FOnDrawText; + property OnDrawTextEx: TVTDrawTextExEvent read FOnDrawTextEx write FOnDrawTextEx; public - /// Returns +1 for ascending and -1 for descending sort order. - function ToInt(): Integer; inline; - end; - - // Used during owner draw of the header to indicate which drop mark for the column must be drawn. - TVTDropMarkMode = ( - dmmNone, - dmmLeft, - dmmRight - ); - - TVirtualTreeColumn = class; - - // This structure carries all important information about header painting and is used in the advanced header painting. - THeaderPaintInfo = record - TargetCanvas: TCanvas; - Column: TVirtualTreeColumn; - PaintRectangle: TRect; - TextRectangle: TRect; - IsHoverIndex, - IsDownIndex, - IsEnabled, - ShowHeaderGlyph, - ShowSortGlyph, - ShowRightBorder: Boolean; - DropMark: TVTDropMarkMode; - GlyphPos, - SortGlyphPos: TPoint; - SortGlyphSize: TSize; - procedure DrawSortArrow(pDirection: TSortDirection); - procedure DrawDropMark(); + constructor Create(AOwner: TComponent); override; + destructor Destroy(); override; + function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; override; + function ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; S: string = ''): TDimension; virtual; + function ContentToClipboard(Format: Word; Source: TVSTTextSourceType): HGLOBAL; + procedure ContentToCustom(Source: TVSTTextSourceType); + function ContentToHTML(Source: TVSTTextSourceType; const Caption: string = ''): String; + function ContentToRTF(Source: TVSTTextSourceType): RawByteString; + function ContentToText(Source: TVSTTextSourceType; Separator: Char): String; overload; + function ContentToUnicode(Source: TVSTTextSourceType; Separator: WideChar): string; overload; deprecated 'Use ContentToText instead'; + function ContentToText(Source: TVSTTextSourceType; const Separator: string): string; overload; + procedure GetTextInfo(Node: PVirtualNode; Column: TColumnIndex; const AFont: TFont; var R: TRect; + var Text: string); override; + function InvalidateNode(Node: PVirtualNode): TRect; override; + function Path(Node: PVirtualNode; Column: TColumnIndex; Delimiter: Char): string; + procedure ReinitNode(Node: PVirtualNode; Recursive: Boolean; ForceReinit: + Boolean = False); override; + procedure RemoveFromSelection(Node: PVirtualNode); override; + function SaveToCSVFile(const FileNameWithPath : TFileName; const IncludeHeading : Boolean) : Boolean; + /// Alternate text for images used in Accessibility. + property ImageText[Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex]: string read GetImageText; + property StaticText[Node: PVirtualNode; Column: TColumnIndex]: string read GetStaticText; + property Text[Node: PVirtualNode; Column: TColumnIndex]: string read GetText write SetText; end; - - TVirtualTreeColumn = class(TCollectionItem) + {$if CompilerVersion >= 33} + [ComponentPlatformsAttribute(pfidWindows)] + {$ifend} + TVirtualStringTree = class(TCustomVirtualStringTree) private - FText, - FHint: string; - FWidth: TDimension; - FPosition: TColumnPosition; - FMinWidth: TDimension; - FMaxWidth: TDimension; - FStyle: TVirtualTreeColumnStyle; - FImageIndex: TImageIndex; - FBiDiMode: TBiDiMode; - FLayout: TVTHeaderColumnLayout; - FMargin, - FSpacing: TDimension; - FOptions: TVTColumnOptions; - FEditOptions: TVTEditOptions; - FEditNextColumn: TDimension; - FTag: NativeInt; - FAlignment: TAlignment; - FCaptionAlignment: TAlignment; // Alignment of the caption. - FLastWidth: TDimension; - FColor: TColor; - FBonusPixel: Boolean; - FSpringRest: Single; // Accumulator for width adjustment when auto spring option is enabled. - FCaptionText: string; - FCheckBox: Boolean; - FCheckType: TCheckType; - FCheckState: TCheckState; - FImageRect: TRect; - FHasImage: Boolean; - FDefaultSortDirection: TSortDirection; - function GetCaptionAlignment: TAlignment; - function GetLeft: TDimension; - function IsBiDiModeStored: Boolean; - function IsCaptionAlignmentStored: Boolean; - function IsColorStored: Boolean; - procedure SetAlignment(const Value: TAlignment); - procedure SetBiDiMode(Value: TBiDiMode); - procedure SetCaptionAlignment(const Value: TAlignment); - procedure SetCheckBox(Value: Boolean); - procedure SetCheckState(Value: TCheckState); - procedure SetCheckType(Value: TCheckType); - procedure SetColor(const Value: TColor); - procedure SetImageIndex(Value: TImageIndex); - procedure SetLayout(Value: TVTHeaderColumnLayout); - procedure SetMargin(Value: TDimension); - procedure SetMaxWidth(Value: TDimension); - procedure SetMinWidth(Value: TDimension); - procedure SetOptions(Value: TVTColumnOptions); - procedure SetPosition(Value: TColumnPosition); - procedure SetSpacing(Value: TDimension); - procedure SetStyle(Value: TVirtualTreeColumnStyle); - procedure SetWidth(Value: TDimension); + function GetOptions: TStringTreeOptions; + procedure SetOptions(const Value: TStringTreeOptions); protected - FLeft: TDimension; - procedure ComputeHeaderLayout(var PaintInfo: THeaderPaintInfo; DrawFormat: Cardinal; CalculateTextRect: Boolean = False); - procedure DefineProperties(Filer: TFiler); override; - procedure GetAbsoluteBounds(var Left, Right: TDimension); - function GetDisplayName: string; override; - function GetText: string; virtual; // [IPK] - procedure SetText(const Value: string); virtual; // [IPK] private to protected & virtual - function GetOwner: TVirtualTreeColumns; reintroduce; - procedure ReadHint(Reader: TReader); - procedure ReadText(Reader: TReader); - property HasImage: Boolean read FHasImage; - property ImageRect: TRect read FImageRect; + function GetOptionsClass: TTreeOptionsClass; override; public - constructor Create(Collection: TCollection); override; - destructor Destroy; override; - - procedure Assign(Source: TPersistent); override; - function Equals(OtherColumnObj: TObject): Boolean; override; - function GetRect: TRect; virtual; - procedure LoadFromStream(const Stream: TStream; Version: Integer); - procedure ParentBiDiModeChanged; - procedure ParentColorChanged; - procedure RestoreLastWidth; - function GetEffectiveColor(): TColor; - procedure SaveToStream(const Stream: TStream); - function UseRightToLeftReading: Boolean; - - property CaptionText: string read FCaptionText; - property Left: TDimension read GetLeft; - property Owner: TVirtualTreeColumns read GetOwner; + property Canvas; + property RangeX; + property LastDragEffect; + property CheckImageKind; // should no more be published to make #622 fix working published - property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; - property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored; - property CaptionAlignment: TAlignment read GetCaptionAlignment write SetCaptionAlignment - stored IsCaptionAlignmentStored default taLeftJustify; - property CheckType: TCheckType read FCheckType write SetCheckType default ctCheckBox; - property CheckState: TCheckState read FCheckState write SetCheckState default csUncheckedNormal; - property CheckBox: Boolean read FCheckBox write SetCheckBox default False; - property Color: TColor read FColor write SetColor stored IsColorStored; - property DefaultSortDirection: TSortDirection read FDefaultSortDirection write FDefaultSortDirection default sdAscending; - property Hint: string read FHint write FHint; - property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; - property Layout: TVTHeaderColumnLayout read FLayout write SetLayout default blGlyphLeft; - property Margin: TDimension read FMargin write SetMargin default 4; - property MaxWidth: TDimension read FMaxWidth write SetMaxWidth default 10000; - property MinWidth: TDimension read FMinWidth write SetMinWidth default 10; - property Options: TVTColumnOptions read FOptions write SetOptions default DefaultColumnOptions; - property EditOptions: TVTEditOptions read FEditOptions write FEditOptions default toDefaultEdit; - property EditNextColumn: TDimension read FEditNextColumn write FEditNextColumn default -1; - property Position: TColumnPosition read FPosition write SetPosition; - property Spacing: TDimension read FSpacing write SetSpacing default 3; - property Style: TVirtualTreeColumnStyle read FStyle write SetStyle default vsText; - property Tag: NativeInt read FTag write FTag default 0; - property Text: string read GetText write SetText; - property Width: TDimension read FWidth write SetWidth default 50; - end; - - TVirtualTreeColumnClass = class of TVirtualTreeColumn; - - TColumnsArray = array of TVirtualTreeColumn; - TCardinalArray = array of Cardinal; - TIndexArray = array of TColumnIndex; - - TVirtualTreeColumns = class(TCollection) - private - FHeader: TVTHeader; - FHeaderBitmap: TBitmap; // backbuffer for drawing - FHoverIndex, // currently "hot" column - FDownIndex, // Column on which a mouse button is held down. - FTrackIndex: TColumnIndex; // Index of column which is currently being resized. - FClickIndex: TColumnIndex; // Index of the last clicked column. - FCheckBoxHit: Boolean; // True if the last click was on a header checkbox. - FPositionToIndex: TIndexArray; - FDefaultWidth: TDimension; // the width columns are created with - 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: TDimension; - function GetItem(Index: TColumnIndex): TVirtualTreeColumn; - function GetNewIndex(P: TPoint; var OldIndex: TColumnIndex): Boolean; - procedure SetDefaultWidth(Value: TDimension); - procedure SetItem(Index: TColumnIndex; Value: TVirtualTreeColumn); - protected - // drag support - FDragIndex: TColumnIndex; // index of column currently being dragged - FDropTarget: TColumnIndex; // current target column (index) while dragging - FDropBefore: Boolean; // True if drop position is in the left half of a column, False for the right - // side to drop the dragged column to - - procedure AdjustAutoSize(CurrentIndex: TColumnIndex; Force: Boolean = False); - function AdjustDownColumn(P: TPoint): TColumnIndex; - function AdjustHoverColumn(P: TPoint): Boolean; - procedure AdjustPosition(Column: TVirtualTreeColumn; Position: Cardinal); - function CanSplitterResize(P: TPoint; Column: TColumnIndex): Boolean; - procedure DoCanSplitterResize(P: TPoint; Column: TColumnIndex; var Allowed: Boolean); virtual; - procedure DrawButtonText(DC: HDC; Caption: string; Bounds: TRect; Enabled, Hot: Boolean; DrawFormat: Cardinal; - WrapCaption: Boolean); - procedure FixPositions; - function GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: TDimension; Relative: Boolean = True): Integer; - function GetOwner: TPersistent; override; - function HandleClick(P: TPoint; Button: TMouseButton; Force, DblClick: Boolean): Boolean; virtual; - procedure HeaderPopupMenuAddHeaderPopupItem(const Sender: TBaseVirtualTree; const Column: TColumnIndex; - var Cmd: TAddPopupItemType); - procedure HeaderPopupMenuColumnChange(const Sender: TBaseVirtualTree; const Column: TColumnIndex; Visible: Boolean); - procedure IndexChanged(OldIndex, NewIndex: Integer); - procedure InitializePositionArray; - procedure Notify(Item: TCollectionItem; Action: System.Classes.TCollectionNotification); override; - procedure ReorderColumns(RTL: Boolean); - procedure Update(Item: TCollectionItem); override; - procedure UpdatePositions(Force: Boolean = False); - - property HeaderBitmap: TBitmap read FHeaderBitmap; - property PositionToIndex: TIndexArray read FPositionToIndex; - property HoverIndex: TColumnIndex read FHoverIndex; - property DownIndex: TColumnIndex read FDownIndex; - property CheckBoxHit: Boolean read FCheckBoxHit; - public - constructor Create(AOwner: TVTHeader); virtual; - destructor Destroy; override; - - function Add: TVirtualTreeColumn; virtual; - procedure AnimatedResize(Column: TColumnIndex; NewWidth: TDimension); - procedure Assign(Source: TPersistent); override; - procedure Clear; virtual; - function ColumnFromPosition(P: TPoint; Relative: Boolean = True): TColumnIndex; overload; virtual; - function ColumnFromPosition(PositionIndex: TColumnPosition): TColumnIndex; overload; virtual; - function Equals(OtherColumnsObj: TObject): Boolean; override; - procedure GetColumnBounds(Column: TColumnIndex; var Left, Right: TDimension); - function GetFirstVisibleColumn(ConsiderAllowFocus: Boolean = False): TColumnIndex; - function GetLastVisibleColumn(ConsiderAllowFocus: Boolean = False): TColumnIndex; - function GetFirstColumn: TColumnIndex; - function GetNextColumn(Column: TColumnIndex): TColumnIndex; - function GetNextVisibleColumn(Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex; - function GetPreviousColumn(Column: TColumnIndex): TColumnIndex; - function GetPreviousVisibleColumn(Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex; - function GetScrollWidth: TDimension; - function GetVisibleColumns: TColumnsArray; - function GetVisibleFixedWidth: TDimension; - function IsValidColumn(Column: TColumnIndex): Boolean; - procedure LoadFromStream(const Stream: TStream; Version: Integer); - procedure PaintHeader(DC: HDC; R: TRect; HOffset: TDimension); overload; virtual; - procedure PaintHeader(TargetCanvas: TCanvas; R: TRect; const Target: TPoint; - RTLOffset: TDimension = 0); overload; virtual; - procedure SaveToStream(const Stream: TStream); - procedure EndUpdate(); override; - function TotalWidth: TDimension; - - property Count: Integer read GetCount; - property ClickIndex: TColumnIndex read FClickIndex; - property DefaultWidth: TDimension read FDefaultWidth write SetDefaultWidth; - property Items[Index: TColumnIndex]: TVirtualTreeColumn read GetItem write SetItem; default; - property Header: TVTHeader read FHeader; - property TrackIndex: TColumnIndex read FTrackIndex; - end; - - TVirtualTreeColumnsClass = class of TVirtualTreeColumns; - - TVTConstraintPercent = 0..100; - TVTFixedAreaConstraints = class(TPersistent) - private - FHeader: TVTHeader; - FMaxHeightPercent, - FMaxWidthPercent, - FMinHeightPercent, - FMinWidthPercent: TVTConstraintPercent; - FOnChange: TNotifyEvent; - procedure SetConstraints(Index: Integer; Value: TVTConstraintPercent); - protected - procedure Change; - property Header: TVTHeader read FHeader; - public - constructor Create(AOwner: TVTHeader); - - procedure Assign(Source: TPersistent); override; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - published - property MaxHeightPercent: TVTConstraintPercent index 0 read FMaxHeightPercent write SetConstraints default 0; - property MaxWidthPercent: TVTConstraintPercent index 1 read FMaxWidthPercent write SetConstraints default 0; - property MinHeightPercent: TVTConstraintPercent index 2 read FMinHeightPercent write SetConstraints default 0; - property MinWidthPercent: TVTConstraintPercent index 3 read FMinWidthPercent write SetConstraints default 0; - end; - - TVTHeaderStyle = ( - hsThickButtons, // TButton look and feel - hsFlatButtons, // flatter look than hsThickButton, like an always raised flat TToolButton - hsPlates // flat TToolButton look and feel (raise on hover etc.) - ); - - TVTHeaderOption = ( - hoAutoResize, // Adjust a column so that the header never exceeds the client width of the owner control. - hoColumnResize, // Resizing columns with the mouse is allowed. - hoDblClickResize, // Allows a column to resize itself to its largest entry. - hoDrag, // Dragging columns is allowed. - hoHotTrack, // Header captions are highlighted when mouse is over a particular column. - hoOwnerDraw, // Header items with the owner draw style can be drawn by the application via event. - hoRestrictDrag, // Header can only be dragged horizontally. - hoShowHint, // Show application defined header hint. - hoShowImages, // Show header images. - hoShowSortGlyphs, // Allow visible sort glyphs. - hoVisible, // Header is visible. - hoAutoSpring, // Distribute size changes of the header to all columns, which are sizable and have the - // coAutoSpring option enabled. - hoFullRepaintOnResize, // Fully invalidate the header (instead of subsequent columns only) when a column is resized. - hoDisableAnimatedResize, // Disable animated resize for all columns. - hoHeightResize, // Allow resizing header height via mouse. - hoHeightDblClickResize, // Allow the header to resize itself to its default height. - hoHeaderClickAutoSort, // Clicks on the header will make the clicked column the SortColumn or toggle sort direction if - // it already was the sort column - hoAutoColumnPopupMenu // Show a context menu for activating and deactivating columns on right click - ); - TVTHeaderOptions = set of TVTHeaderOption; - - THeaderState = ( - hsAutoSizing, // auto size chain is in progess, do not trigger again on WM_SIZE - hsDragging, // header dragging is in progress (only if enabled) - hsDragPending, // left button is down, user might want to start dragging a column - hsLoading, // The header currently loads from stream, so updates are not necessary. - hsColumnWidthTracking, // column resizing is in progress - hsColumnWidthTrackPending, // left button is down, user might want to start resize a column - hsHeightTracking, // height resizing is in progress - hsHeightTrackPending, // left button is down, user might want to start changing height - hsResizing, // multi column resizing in progress - hsScaling, // the header is scaled after a change of FixedAreaConstraints or client size - hsNeedScaling // the header needs to be scaled - ); - THeaderStates = set of THeaderState; - - - TSmartAutoFitType = ( - smaAllColumns, // consider nodes in view only for all columns - smaNoColumn, // consider nodes in view only for no column - smaUseColumnOption // use coSmartResize of the corresponding column - ); // describes the used column resize behaviour for AutoFitColumns - - - TChangeReason = ( - crIgnore, // used as placeholder - crAccumulated, // used for delayed changes - crChildAdded, // one or more child nodes have been added - crChildDeleted, // one or more child nodes have been deleted - crNodeAdded, // a node has been added - crNodeCopied, // a node has been duplicated - crNodeMoved // a node has been moved to a new place - ); // desribes what made a structure change event happen - - TVTHeader = class(TPersistent) - private - FOwner: TBaseVirtualTree; - FColumns: TVirtualTreeColumns; - FHeight: TDimension; - FFont: TFont; - FParentFont: Boolean; - FOptions: TVTHeaderOptions; - FStyle: TVTHeaderStyle; // button style - FBackgroundColor: TColor; - FAutoSizeIndex: TColumnIndex; - FPopupMenu: TPopupMenu; - FMainColumn: TColumnIndex; // the column which holds the tree - FMaxHeight: TDimension; - FMinHeight: TDimension; - FDefaultHeight: TDimension; - FFixedAreaConstraints: TVTFixedAreaConstraints; // Percentages for the fixed area (header, fixed columns). - FImages: TCustomImageList; - FImageChangeLink: TChangeLink; // connections to the image list to get notified about changes - fSplitterHitTolerance: TDimension; // For property SplitterHitTolerance - FSortColumn: TColumnIndex; - FSortDirection: TSortDirection; - FDragImage: TVTDragImage; // drag image management during header drag - FLastWidth: TDimension; // Used to adjust spring columns. This is the width of all visible columns, - // not the header rectangle. - function GetMainColumn: TColumnIndex; - function GetUseColumns: Boolean; - function IsFontStored: Boolean; - procedure SetAutoSizeIndex(Value: TColumnIndex); - procedure SetBackground(Value: TColor); - procedure SetColumns(Value: TVirtualTreeColumns); - procedure SetDefaultHeight(Value: TDimension); - procedure SetFont(const Value: TFont); - procedure SetHeight(Value: TDimension); - procedure SetImages(const Value: TCustomImageList); - procedure SetMainColumn(Value: TColumnIndex); - procedure SetMaxHeight(Value: TDimension); - procedure SetMinHeight(Value: TDimension); - procedure SetOptions(Value: TVTHeaderOptions); - procedure SetParentFont(Value: Boolean); - procedure SetSortColumn(Value: TColumnIndex); - procedure SetSortDirection(const Value: TSortDirection); - procedure SetStyle(Value: TVTHeaderStyle); - protected - FStates: THeaderStates; // Used to keep track of internal states the header can enter. - FDragStart: TPoint; // initial mouse drag position - FTrackStart: TPoint; // client coordinates of the tracking start point - FTrackPoint: TPoint; // Client coordinate where the tracking started. - FDoingAutoFitColumns: boolean; // Flag to avoid using the stored width for Main column - - procedure FontChanged(Sender: TObject); virtual; - function CanSplitterResize(P: TPoint): Boolean; - function CanWriteColumns: Boolean; virtual; - procedure ChangeScale(M, D: TDimension); virtual; - function DetermineSplitterIndex(P: TPoint): Boolean; virtual; - procedure DoAfterAutoFitColumn(Column: TColumnIndex); virtual; - procedure DoAfterColumnWidthTracking(Column: TColumnIndex); virtual; - procedure DoAfterHeightTracking; virtual; - function DoBeforeAutoFitColumn(Column: TColumnIndex; SmartAutoFitType: TSmartAutoFitType): Boolean; virtual; - procedure DoBeforeColumnWidthTracking(Column: TColumnIndex; Shift: TShiftState); virtual; - procedure DoBeforeHeightTracking(Shift: TShiftState); virtual; - procedure DoCanSplitterResize(P: TPoint; var Allowed: Boolean); virtual; - function DoColumnWidthDblClickResize(Column: TColumnIndex; P: TPoint; Shift: TShiftState): Boolean; virtual; - function DoColumnWidthTracking(Column: TColumnIndex; Shift: TShiftState; var TrackPoint: TPoint; P: TPoint): Boolean; virtual; - function DoGetPopupMenu(Column: TColumnIndex; Position: TPoint): TPopupMenu; virtual; - 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); - procedure FixedAreaConstraintsChanged(Sender: TObject); - function GetColumnsClass: TVirtualTreeColumnsClass; virtual; - function GetOwner: TPersistent; override; - function GetShiftState: TShiftState; - function HandleHeaderMouseMove(var Message: TWMMouseMove): Boolean; - function HandleMessage(var Message: TMessage): Boolean; virtual; - procedure ImageListChange(Sender: TObject); - procedure PrepareDrag(P, Start: TPoint); - procedure ReadColumns(Reader: TReader); - procedure RecalculateHeader; virtual; - procedure RescaleHeader; - procedure UpdateMainColumn; - procedure UpdateSpringColumns; - procedure WriteColumns(Writer: TWriter); - public - constructor Create(AOwner: TBaseVirtualTree); virtual; - destructor Destroy; override; - - function AllowFocus(ColumnIndex: TColumnIndex): Boolean; - procedure Assign(Source: TPersistent); override; - procedure AutoFitColumns(Animated: Boolean = True; SmartAutoFitType: TSmartAutoFitType = smaUseColumnOption; - RangeStartCol: Integer = NoColumn; RangeEndCol: Integer = NoColumn); virtual; - function InHeader(P: TPoint): Boolean; virtual; - function InHeaderSplitterArea(P: TPoint): Boolean; virtual; - procedure Invalidate(Column: TVirtualTreeColumn; ExpandToBorder: Boolean = False; UpdateNowFlag : Boolean = False); - procedure LoadFromStream(const Stream: TStream); virtual; - function ResizeColumns(ChangeBy: TDimension; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex; - Options: TVTColumnOptions = [coVisible]): TDimension; - procedure RestoreColumns; - procedure SaveToStream(const Stream: TStream); virtual; - - property DragImage: TVTDragImage read FDragImage; - property States: THeaderStates read FStates; - property Treeview: TBaseVirtualTree read FOwner; - property UseColumns: Boolean read GetUseColumns; - property doingAutoFitColumns: boolean read FDoingAutoFitColumns; - published - property AutoSizeIndex: TColumnIndex read FAutoSizeIndex write SetAutoSizeIndex; - property Background: TColor read FBackgroundColor write SetBackground default clBtnFace; - property Columns: TVirtualTreeColumns read FColumns write SetColumns stored False; // Stored by the owner tree to support VFI. - property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight default 19; - property Font: TFont read FFont write SetFont stored IsFontStored; - property FixedAreaConstraints: TVTFixedAreaConstraints read FFixedAreaConstraints write FFixedAreaConstraints; - property Height: Integer read FHeight write SetHeight default 19; - property Images: TCustomImageList read FImages write SetImages; - property MainColumn: TColumnIndex read GetMainColumn write SetMainColumn default 0; - property MaxHeight: Integer read FMaxHeight write SetMaxHeight default 10000; - property MinHeight: Integer read FMinHeight write SetMinHeight default 10; - property Options: TVTHeaderOptions read FOptions write SetOptions default [hoColumnResize, hoDrag, hoShowSortGlyphs]; - property ParentFont: Boolean read FParentFont write SetParentFont default True; - property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu; - property SortColumn: TColumnIndex read FSortColumn write SetSortColumn default NoColumn; - property SortDirection: TSortDirection read FSortDirection write SetSortDirection default sdAscending; - property SplitterHitTolerance: Integer read fSplitterHitTolerance write fSplitterHitTolerance default 8; // The area in pixels around a spliter which is sensitive for resizing - property Style: TVTHeaderStyle read FStyle write SetStyle default hsThickButtons; - end; - - TVTHeaderClass = class of TVTHeader; - - // Communication interface between a tree editor and the tree itself (declared as using stdcall in case it - // is implemented in a (C/C++) DLL). The GUID is not nessecary in Delphi but important for BCB users - // to allow QueryInterface and _uuidof calls. - IVTEditLink = interface - ['{2BE3EAFA-5ACB-45B4-9D9A-B58BCC496E17}'] - function BeginEdit: Boolean; stdcall; // Called when editing actually starts. - function CancelEdit: Boolean; stdcall; // Called when editing has been cancelled by the tree. - function EndEdit: Boolean; stdcall; // Called when editing has been finished by the tree. Returns True if successful, False if edit mode is still active. - function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall; - // Called after creation to allow a setup. - procedure ProcessMessage(var Message: TMessage); stdcall; - // Used to forward messages to the edit window(s)- - procedure SetBounds(R: TRect); stdcall; // Called to place the editor. - end; - - // Indicates in the OnUpdating event what state the tree is currently in. - TVTUpdateState = ( - usBegin, // The tree just entered the update state (BeginUpdate call for the first time). - usBeginSynch, // The tree just entered the synch update state (BeginSynch call for the first time). - usSynch, // Begin/EndSynch has been called but the tree did not change the update state. - usUpdate, // Begin/EndUpdate has been called but the tree did not change the update state. - usEnd, // The tree just left the update state (EndUpdate called for the last level). - usEndSynch // The tree just left the synch update state (EndSynch called for the last level). - ); - - // These elements are used both to query the application, which of them it wants to draw itself and to tell it during - // painting, which elements must be drawn during the advanced custom draw events. - THeaderPaintElements = set of ( - hpeBackground, - hpeDropMark, - hpeHeaderGlyph, - hpeSortGlyph, - hpeText, - // New in 7.0: Use this in FOnHeaderDrawQueryElements and OnAdvancedHeaderDraw - // for additional custom header drawing while keeping the default drawing - hpeOverlay - ); - - // Various events must be handled at different places than they were initiated or need - // a persistent storage until they are reset. - TVirtualTreeStates = set of ( - tsChangePending, // A selection change is pending. - tsCheckPropagation, // Set during automatic check state propagation. - tsCollapsing, // A full collapse operation is in progress. - tsToggleFocusedSelection, // Node selection was modifed using Ctrl-click. Change selection state on next mouse up. - tsClearPending, // Need to clear the current selection on next mouse move. - tsClearOnNewSelection, // Need to clear the current selection before selecting a new node - tsClipboardFlushing, // Set during flushing the clipboard to avoid freeing the content. - tsCopyPending, // Indicates a pending copy operation which needs to be finished. - tsCutPending, // Indicates a pending cut operation which needs to be finished. - tsDrawSelPending, // Multiselection only. User held down the left mouse button on a free - // area and might want to start draw selection. - tsDrawSelecting, // Multiselection only. Draw selection has actually started. - tsEditing, // Indicates that an edit operation is currently in progress. - tsEditPending, // An mouse up start edit if dragging has not started. - tsExpanding, // A full expand operation is in progress. - tsNodeHeightTracking, // A node height changing operation is in progress. - tsNodeHeightTrackPending, // left button is down, user might want to start changing a node's height. - tsHint, // Set when our hint is visible or soon will be. - tsInAnimation, // Set if the tree is currently in an animation loop. - tsIncrementalSearching, // Set when the user starts incremental search. - tsIncrementalSearchPending, // Set in WM_KEYDOWN to tell to use the char in WM_CHAR for incremental search. - tsIterating, // Set when IterateSubtree is currently in progress. - tsLeftButtonDown, // Set when the left mouse button is down. - tsLeftDblClick, // Set when the left mouse button was doubly clicked. - tsMiddleButtonDown, // Set when the middle mouse button is down. - tsMiddleDblClick, // Set when the middle mouse button was doubly clicked. - tsNeedRootCountUpdate, // Set if while loading a root node count is set. - tsOLEDragging, // OLE dragging in progress. - tsOLEDragPending, // User has requested to start delayed dragging. - tsPainting, // The tree is currently painting itself. - tsRightButtonDown, // Set when the right mouse button is down. - tsRightDblClick, // Set when the right mouse button was doubly clicked. - tsPopupMenuShown, // The user clicked the right mouse button, which might cause a popup menu to appear. - tsScrolling, // Set when autoscrolling is active. - tsScrollPending, // Set when waiting for the scroll delay time to elapse. - tsSizing, // Set when the tree window is being resized. This is used to prevent recursive calls - // due to setting the scrollbars when sizing. - tsStopValidation, // Cache validation can be stopped (usually because a change has occured meanwhile). - tsStructureChangePending, // The structure of the tree has been changed while the update was locked. - tsSynchMode, // Set when the tree is in synch mode, where no timer events are triggered. - tsThumbTracking, // Stop updating the horizontal scroll bar while dragging the vertical thumb and vice versa. - tsToggling, // A toggle operation (for some node) is in progress. - tsUpdateHiddenChildrenNeeded, // Pending update for the hidden children flag after massive visibility changes. - tsUpdating, // The tree does currently not update its window because a BeginUpdate has not yet ended. - tsUseCache, // The tree's node caches are validated and non-empty. - tsUserDragObject, // Signals that the application created an own drag object in OnStartDrag. - tsUseThemes, // The tree runs under WinXP+, is theme aware and themes are enabled. - tsValidating, // The tree's node caches are currently validated. - tsPreviouslySelectedLocked,// The member FPreviouslySelected should not be changed - tsValidationNeeded, // Something in the structure of the tree has changed. The cache needs validation. - 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. - tsWindowCreating, // Set during window handle creation to avoid frequent unnecessary updates. - tsUseExplorerTheme // The tree runs under WinVista+ and is using the explorer theme - ); - - // determines whether and how the drag image is to show - TVTDragImageKind = ( - diComplete, // show a complete drag image with all columns, only visible columns are shown - diMainColumnOnly, // show only the main column (the tree column) - diNoImage // don't show a drag image at all - ); - - // Switch for OLE and VCL drag'n drop. Because it is not possible to have both simultanously. - TVTDragType = ( - dtOLE, - dtVCL - ); - - // options which determine what to draw in PaintTree - TVTInternalPaintOption = ( - poBackground, // draw background image if there is any and it is enabled - poColumnColor, // erase node's background with the column's color - poDrawFocusRect, // draw focus rectangle around the focused node - poDrawSelection, // draw selected nodes with the normal selection color - poDrawDropMark, // draw drop mark if a node is currently the drop target - poGridLines, // draw grid lines if enabled - poMainOnly, // draw only the main column - poSelectedOnly, // draw only selected nodes - poUnbuffered // draw directly onto the target canvas; especially useful when printing - ); - TVTInternalPaintOptions = set of TVTInternalPaintOption; - - // Determines the look of a tree's lines. - TVTLineStyle = ( - lsCustomStyle, // application provides a line pattern - lsDotted, // usual dotted lines (default) - lsSolid // simple solid lines - ); - - // TVTLineType is used during painting a tree - TVTLineType = ( - ltNone, // no line at all - ltBottomRight, // a line from bottom to the center and from there to the right - ltTopDown, // a line from top to bottom - ltTopDownRight, // a line from top to bottom and from center to the right - ltRight, // a line from center to the right - ltTopRight, // a line from bottom to center and from there to the right - // special styles for alternative drawings of tree lines - ltLeft, // a line from top to bottom at the left - ltLeftBottom // a combination of ltLeft and a line at the bottom from left to right - ); - - // Determines how to draw tree lines. - TVTLineMode = ( - lmNormal, // usual tree lines (as in TTreeview) - lmBands // looks similar to a Nassi-Schneidermann diagram - ); - - // A collection of line type IDs which is used while painting a node. - TLineImage = array of TVTLineType; - - TVTScrollIncrement = 1..10000; - - // Export type - TVTExportType = ( - etNone, // No export, normal displaying on the screen - etRTF, // contentToRTF - etHTML, // contentToHTML - etText, // contentToText - etExcel, // supported by external tools - etWord, // supported by external tools - etPDF, // supported by external tools - etPrinter,// supported by external tools - etCSV, // supported by external tools - etCustom // supported by external tools - ); - - TVTNodeExportEvent = procedure (Sender: TBaseVirtualTree; aExportType: TVTExportType; Node: PVirtualNode) of object; - TVTColumnExportEvent = procedure (Sender: TBaseVirtualTree; aExportType: TVTExportType; Column: TVirtualTreeColumn) of object; - TVTTreeExportEvent = procedure(Sender: TBaseVirtualTree; aExportType: TVTExportType) of object; - - // A class to manage scroll bar aspects. - TScrollBarOptions = class(TPersistent) - private - FAlwaysVisible: Boolean; - FOwner: TBaseVirtualTree; - FScrollBars: TScrollStyle; // used to hide or show vertical and/or horizontal scrollbar - FScrollBarStyle: TScrollBarStyle; // kind of scrollbars to use - FIncrementX, - FIncrementY: TVTScrollIncrement; // number of pixels to scroll in one step (when auto scrolling) - procedure SetAlwaysVisible(Value: Boolean); - procedure SetScrollBars(Value: TScrollStyle); - procedure SetScrollBarStyle(Value: TScrollBarStyle); - protected - function GetOwner: TPersistent; override; - public - constructor Create(AOwner: TBaseVirtualTree); - - procedure Assign(Source: TPersistent); override; - published - property AlwaysVisible: Boolean read FAlwaysVisible write SetAlwaysVisible default False; - property HorizontalIncrement: TVTScrollIncrement read FIncrementX write FIncrementX default 20; - property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; - property ScrollBarStyle: TScrollBarStyle read FScrollBarStyle write SetScrollBarStyle default sbmRegular; - property VerticalIncrement: TVTScrollIncrement read FIncrementY write FIncrementY default 20; - end; - - // class to collect all switchable colors into one place - TVTColors = class(TPersistent) - private - type - TVTColorEnum =(cDisabledColor, cDropMarkColor, cDropTargetColor, cFocusedSelectionColor, - cGridLineColor, cTreeLineColor, cUnfocusedSelectionColor, cBorderColor, cHotColor, - cFocusedSelectionBorderColor, cUnfocusedSelectionBorderColor, cDropTargetBorderColor, - cSelectionRectangleBlendColor, cSelectionRectangleBorderColor, cHeaderHotColor, - cSelectionTextColor, cUnfocusedColor); - - // Please make sure that the published Color properties at the corresponding index - // have the same color if you change anything here! - const cDefaultColors : array[TVTColorEnum] of TColor = ( - clBtnShadow, // DisabledColor - clHighlight, // DropMarkColor - clHighLight, // DropTargetColor - clHighLight, // FocusedSelectionColor - clBtnFace, // GridLineColor - clBtnShadow, // TreeLineColor - clInactiveCaption, // UnfocusedSelectionColor - clBtnFace, // BorderColor - clWindowText, // HotColor - clHighLight, // FocusedSelectionBorderColor - clInactiveCaption, // UnfocusedSelectionBorderColor - clHighlight, // DropTargetBorderColor - clHighlight, // SelectionRectangleBlendColor - clHighlight, // SelectionRectangleBorderColor - clBtnShadow, // HeaderHotColor - clHighlightText, // SelectionTextColor - clInactiveCaptionText); // UnfocusedColor [IPK] - - private - FOwner: TBaseVirtualTree; - FColors: array[TVTColorEnum] of TColor; // [IPK] 15 -> 16 - function GetColor(const Index: TVTColorEnum): TColor; - procedure SetColor(const Index: TVTColorEnum; const Value: TColor); - function GetBackgroundColor: TColor; - function GetHeaderFontColor: TColor; - function GetNodeFontColor: TColor; - function GetSelectedNodeFontColor(Focused:boolean): TColor; - public - constructor Create(AOwner: TBaseVirtualTree); - - procedure Assign(Source: TPersistent); override; - property BackGroundColor: TColor read GetBackgroundColor; - property HeaderFontColor: TColor read GetHeaderFontColor; - property NodeFontColor: TColor read GetNodeFontColor; - published - property BorderColor: TColor index cBorderColor read GetColor write SetColor default clBtnFace; - property DisabledColor: TColor index cDisabledColor read GetColor write SetColor default clBtnShadow; - property DropMarkColor: TColor index cDropMarkColor read GetColor write SetColor default clHighlight; - property DropTargetColor: TColor index cDropTargetColor read GetColor write SetColor default clHighLight; - property DropTargetBorderColor: TColor index cDropTargetBorderColor read GetColor write SetColor default clHighLight; - /// The background color of selected nodes in case the tree has the focus, or the toPopupMode flag is set. - property FocusedSelectionColor: TColor index cFocusedSelectionColor read GetColor write SetColor default clHighLight; - /// The border color of selected nodes when the tree has the focus. - property FocusedSelectionBorderColor: TColor index cFocusedSelectionBorderColor read GetColor write SetColor default clHighLight; - property GridLineColor: TColor index cGridLineColor read GetColor write SetColor default clBtnFace; - property HeaderHotColor: TColor index cHeaderHotColor read GetColor write SetColor default clBtnShadow; - property HotColor: TColor index cHotColor read GetColor write SetColor default clWindowText; - property SelectionRectangleBlendColor: TColor index cSelectionRectangleBlendColor read GetColor write SetColor default clHighlight; - property SelectionRectangleBorderColor: TColor index cSelectionRectangleBorderColor read GetColor write SetColor default clHighlight; - /// The text color of selected nodes - property SelectionTextColor: TColor index cSelectionTextColor read GetColor write SetColor default clHighlightText; - property TreeLineColor: TColor index cTreeLineColor read GetColor write SetColor default clBtnShadow; - property UnfocusedColor: TColor index cUnfocusedColor read GetColor write SetColor default clInactiveCaptionText; // [IPK] Added - /// The background color of selected nodes in case the tree does not have the focus and the toPopupMode flag is not set. - property UnfocusedSelectionColor: TColor index cUnfocusedSelectionColor read GetColor write SetColor default clInactiveCaption; - /// The border color of selected nodes in case the tree does not have the focus and the toPopupMode flag is not set. - property UnfocusedSelectionBorderColor: TColor index cUnfocusedSelectionBorderColor read GetColor write SetColor default clInactiveCaption; - end; - - // For painting a node and its columns/cells a lot of information must be passed frequently around. - TVTImageInfo = record - Index: TImageIndex; // Index in the associated image list. - XPos, // Horizontal position in the current target canvas. - YPos: TDimension; // Vertical position in the current target canvas. - Ghosted: Boolean; // Flag to indicate that the image must be drawn slightly lighter. - Images: TCustomImageList; // The image list to be used for painting. - function Equals(const pImageInfo2: TVTImageInfo): Boolean; - end; - - TVTImageInfoIndex = ( - iiNormal, - iiState, - iiCheck, - iiOverlay - ); - - // Options which are used when modifying the scroll offsets. - TScrollUpdateOptions = set of ( - suoRepaintHeader, // if suoUpdateNCArea is also set then invalidate the header - suoRepaintScrollBars, // if suoUpdateNCArea is also set then repaint both scrollbars after updating them - suoScrollClientArea, // scroll and invalidate the proper part of the client area - suoUpdateNCArea // update non-client area (scrollbars, header) - ); - - // Determines the look of a tree's buttons. - TVTButtonStyle = ( - bsRectangle, // traditional Windows look (plus/minus buttons) - bsTriangle // traditional Macintosh look - ); - - // TButtonFillMode is only used when the button style is bsRectangle and determines how to fill the interior. - 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) - fmTransparent // transparent color, use the item's background color - ); - - TVTPaintInfo = record - Canvas: TCanvas; // the canvas to paint on - PaintOptions: TVTInternalPaintOptions; // a copy of the paint options passed to PaintTree - Node: PVirtualNode; // the node to paint - Column: TColumnIndex; // the node's column index to paint - Position: TColumnPosition; // the column position of the node - CellRect: TRect; // the node cell - ContentRect: TRect; // the area of the cell used for the node's content - NodeWidth: TDimension; // the actual node width - Alignment: TAlignment; // how to align within the node rectangle - CaptionAlignment: TAlignment; // how to align text within the caption rectangle - BidiMode: TBidiMode; // directionality to be used for painting - BrushOrigin: TPoint; // the alignment for the brush used to draw dotted lines - ImageInfo: array[TVTImageInfoIndex] of TVTImageInfo; // info about each possible node image - Offsets: TVTOffsets; // The offsets of the various elements of a tree node - VAlign: TDimension; - procedure AdjustImageCoordinates(); - end; - - // Method called by the Animate routine for each animation step. - TVTAnimationCallback = function(Step, StepSize: Integer; Data: Pointer): Boolean of object; - - TVTIncrementalSearch = ( - isAll, // search every node in tree, initialize if necessary - isNone, // disable incremental search - isInitializedOnly, // search only initialized nodes, skip others - isVisibleOnly // search only visible nodes, initialize if necessary - ); - - // Determines which direction to use when advancing nodes during an incremental search. - TVTSearchDirection = ( - sdForward, - sdBackward - ); - - // Determines where to start incremental searching for each key press. - TVTSearchStart = ( - ssAlwaysStartOver, // always use the first/last node (depending on direction) to search from - ssLastHit, // use the last found node - ssFocusedNode // use the currently focused node - ); - - // Determines how to use the align member of a node. - TVTNodeAlignment = ( - naFromBottom, // the align member specifies amount of units (usually pixels) from top border of the node - naFromTop, // align is to be measured from bottom - naProportional // align is to be measure in percent of the entire node height and relative to top - ); - - // Determines how to draw the selection rectangle used for draw selection. - TVTDrawSelectionMode = ( - smDottedRectangle, // same as DrawFocusRect - smBlendedRectangle // alpha blending, uses special colors (see TVTColors) - ); - - // Determines for which purpose the cell paint event is called. - TVTCellPaintMode = ( - cpmPaint, // painting the cell - cpmGetContentMargin // getting cell content margin - ); - - // Determines which sides of the cell content margin should be considered. - TVTCellContentMarginType = ( - ccmtAllSides, // consider all sides - ccmtTopLeftOnly, // consider top margin and left margin only - ccmtBottomRightOnly // consider bottom margin and right margin only - ); - - TClipboardFormats = class(TStringList) - private - FOwner: TBaseVirtualTree; - public - constructor Create(AOwner: TBaseVirtualTree); virtual; - - function Add(const S: string): Integer; override; - procedure Insert(Index: Integer; const S: string); override; - property Owner: TBaseVirtualTree read FOwner; - end; - - // ----- Event prototypes: - - // node enumeration - TVTGetNodeProc = reference to procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean); - // node events - TVTChangingEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; var Allowed: Boolean) of object; - TVTCheckChangingEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; var NewState: TCheckState; - var Allowed: Boolean) of object; - TVTChangeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; - TVTStructureChangeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Reason: TChangeReason) of object; - TVTEditCancelEvent = procedure(Sender: TBaseVirtualTree; Column: TColumnIndex) of object; - TVTEditChangingEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - var Allowed: Boolean) of object; - TVTEditChangeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex) of object; - TVTFreeNodeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; - TVTFocusChangingEvent = procedure(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn, - NewColumn: TColumnIndex; var Allowed: Boolean) of object; - TVTFocusChangeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex) of object; - TVTAddToSelectionEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; - TVTRemoveFromSelectionEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; - TVTGetImageEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; - var Ghosted: Boolean; var ImageIndex: TImageIndex) of object; - TVTGetImageExEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; - var Ghosted: Boolean; var ImageIndex: TImageIndex; var ImageList: TCustomImageList) of object; - TVTGetImageTextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; - var ImageText: string) of object; - TVTHotNodeChangeEvent = procedure(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode) of object; - TVTInitChildrenEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal) of object; - TVTInitNodeEvent = procedure(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; - var InitialStates: TVirtualNodeInitStates) of object; - TVTPopupEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; const P: TPoint; - var AskParent: Boolean; var PopupMenu: TPopupMenu) of object; - TVTHelpContextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - var HelpContext: Integer) of object; - TVTCreateEditorEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - out EditLink: IVTEditLink) of object; - TVTSaveTreeEvent = procedure(Sender: TBaseVirtualTree; Stream: TStream) of object; - TVTSaveNodeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Stream: TStream) of object; - TVTBeforeGetCheckStateEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; - - // header/column events - TVTHeaderAddPopupItemEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex; - var Cmd: TAddPopupItemType) of object; - TVTHeaderClickEvent = procedure(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo) of object; - TVTHeaderMouseEvent = procedure(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object; - TVTHeaderMouseMoveEvent = procedure(Sender: TVTHeader; Shift: TShiftState; X, Y: Integer) of object; - TVTBeforeHeaderHeightTrackingEvent = procedure(Sender: TVTHeader; Shift: TShiftState) of object; - TVTAfterHeaderHeightTrackingEvent = procedure(Sender: TVTHeader) of object; - TVTHeaderHeightTrackingEvent = procedure(Sender: TVTHeader; var P: TPoint; Shift: TShiftState; var Allowed: Boolean) of object; - TVTHeaderHeightDblClickResizeEvent = procedure(Sender: TVTHeader; var P: TPoint; Shift: TShiftState; var Allowed: Boolean) of object; - TVTHeaderNotifyEvent = procedure(Sender: TVTHeader; Column: TColumnIndex) of object; - TVTHeaderDraggingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var Allowed: Boolean) of object; - TVTHeaderDraggedEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; OldPosition: Integer) of object; - TVTHeaderDraggedOutEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; DropPosition: TPoint) of object; - TVTHeaderPaintEvent = procedure(Sender: TVTHeader; HeaderCanvas: TCanvas; Column: TVirtualTreeColumn; R: TRect; Hover, - Pressed: Boolean; DropMark: TVTDropMarkMode) of object; - TVTHeaderPaintQueryElementsEvent = procedure(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; - var Elements: THeaderPaintElements) of object; - TVTAdvancedHeaderPaintEvent = procedure(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; - const Elements: THeaderPaintElements) of object; - TVTBeforeAutoFitColumnsEvent = procedure(Sender: TVTHeader; var SmartAutoFitType: TSmartAutoFitType) of object; - TVTBeforeAutoFitColumnEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var SmartAutoFitType: TSmartAutoFitType; - var Allowed: Boolean) of object; - TVTAfterAutoFitColumnEvent = procedure(Sender: TVTHeader; Column: TColumnIndex) of object; - TVTAfterAutoFitColumnsEvent = procedure(Sender: TVTHeader) of object; - TVTColumnClickEvent = procedure (Sender: TBaseVirtualTree; Column: TColumnIndex; Shift: TShiftState) of object; - TVTColumnDblClickEvent = procedure (Sender: TBaseVirtualTree; Column: TColumnIndex; Shift: TShiftState) of object; - TColumnChangeEvent = procedure(const Sender: TBaseVirtualTree; const Column: TColumnIndex; Visible: Boolean) of object; - TVTColumnWidthDblClickResizeEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; Shift: TShiftState; P: TPoint; - var Allowed: Boolean) of object; - TVTBeforeColumnWidthTrackingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; Shift: TShiftState) of object; - TVTAfterColumnWidthTrackingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex) of object; - TVTColumnWidthTrackingEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; Shift: TShiftState; var TrackPoint: TPoint; P: TPoint; - var Allowed: Boolean) of object; - TVTGetHeaderCursorEvent = procedure(Sender: TVTHeader; var Cursor: HCURSOR) of object; - TVTBeforeGetMaxColumnWidthEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var UseSmartColumnWidth: Boolean) of object; - TVTAfterGetMaxColumnWidthEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var MaxWidth: Integer) of object; - TVTCanSplitterResizeColumnEvent = procedure(Sender: TVTHeader; P: TPoint; Column: TColumnIndex; var Allowed: Boolean) of object; - TVTCanSplitterResizeHeaderEvent = procedure(Sender: TVTHeader; P: TPoint; var Allowed: Boolean) of object; - - // move, copy and node tracking events - TVTNodeMovedEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; - TVTNodeMovingEvent = procedure(Sender: TBaseVirtualTree; Node, Target: PVirtualNode; - var Allowed: Boolean) of object; - TVTNodeCopiedEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; - TVTNodeCopyingEvent = procedure(Sender: TBaseVirtualTree; Node, Target: PVirtualNode; - var Allowed: Boolean) of object; - TVTNodeClickEvent = procedure(Sender: TBaseVirtualTree; const HitInfo: THitInfo) of object; - TVTNodeHeightTrackingEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; - var TrackPoint: TPoint; P: TPoint; var Allowed: Boolean) of object; - TVTNodeHeightDblClickResizeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - Shift: TShiftState; P: TPoint; var Allowed: Boolean) of object; - TVTCanSplitterResizeNodeEvent = procedure(Sender: TBaseVirtualTree; P: TPoint; Node: PVirtualNode; - Column: TColumnIndex; var Allowed: Boolean) of object; - - // drag'n drop/OLE events - TVTCreateDragManagerEvent = procedure(Sender: TBaseVirtualTree; out DragManager: IVTDragManager) of object; - TVTCreateDataObjectEvent = procedure(Sender: TBaseVirtualTree; out IDataObject: IDataObject) of object; - TVTDragAllowedEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - var Allowed: Boolean) of object; - TVTDragOverEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; - Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean) of object; - TVTDragDropEvent = procedure(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; - Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode) of object; - TVTRenderOLEDataEvent = procedure(Sender: TBaseVirtualTree; const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; - ForClipboard: Boolean; var Result: HRESULT) of object; - TVTGetUserClipboardFormatsEvent = procedure(Sender: TBaseVirtualTree; var Formats: TFormatEtcArray) of object; - - // paint events - TVTBeforeItemEraseEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; - var ItemColor: TColor; var EraseAction: TItemEraseAction) of object; - TVTAfterItemEraseEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - ItemRect: TRect) of object; - TVTBeforeItemPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - ItemRect: TRect; var CustomDraw: Boolean) of object; - TVTAfterItemPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - ItemRect: TRect) of object; - TVTBeforeCellPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect) of object; - TVTAfterCellPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - Column: TColumnIndex; CellRect: TRect) of object; - TVTPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas) of object; - TVTBackgroundPaintEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; R: TRect; - var Handled: Boolean) of object; - TVTGetLineStyleEvent = procedure(Sender: TBaseVirtualTree; var Bits: Pointer) of object; - TVTMeasureItemEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - var NodeHeight: Integer) of object; - - TVTPrepareButtonImagesEvent = procedure(Sender: TBaseVirtualTree; const APlusBM : TBitmap; const APlusHotBM :TBitmap; - const APlusSelectedHotBM :TBitmap; const AMinusBM : TBitmap; const AMinusHotBM : TBitmap; - const AMinusSelectedHotBM :TBitmap; var ASize : TSize) of object; - - // search, sort - TVTCompareEvent = procedure(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; - var Result: Integer) of object; - TVTIncrementalSearchEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; const SearchText: string; - var Result: Integer) of object; - - // operations - TVTOperationEvent = procedure(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind) of object; - - TVTHintKind = (vhkText, vhkOwnerDraw); - TVTHintKindEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Kind: TVTHintKind) of object; - TVTDrawHintEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; R: TRect; Column: TColumnIndex) of object; - TVTGetHintSizeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect) of object; - - // miscellaneous - TVTBeforeDrawLineImageEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Level: Integer; var PosX: Integer) of object; - TVTGetNodeDataSizeEvent = procedure(Sender: TBaseVirtualTree; var NodeDataSize: Integer) of object; - TVTKeyActionEvent = procedure(Sender: TBaseVirtualTree; var CharCode: Word; var Shift: TShiftState; - var DoDefault: Boolean) of object; - TVTScrollEvent = procedure(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer) of object; - TVTUpdatingEvent = procedure(Sender: TBaseVirtualTree; State: TVTUpdateState) of object; - TVTGetCursorEvent = procedure(Sender: TBaseVirtualTree; var Cursor: TCursor) of object; - TVTStateChangeEvent = procedure(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates) of object; - TVTGetCellIsEmptyEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - var IsEmpty: Boolean) of object; - TVTScrollBarShowEvent = procedure(Sender: TBaseVirtualTree; Bar: Integer; Show: Boolean) of object; - - // Helper types for node iterations. - TGetFirstNodeProc = function: PVirtualNode of object; - TGetNextNodeProc = function(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode of object; - - TVZVirtualNodeEnumerationMode = ( - vneAll, - vneChecked, - vneChild, - vneCutCopy, - vneInitialized, - vneLeaf, - vneLevel, - vneNoInit, - vneSelected, - vneVisible, - vneVisibleChild, - vneVisibleNoInitChild, - vneVisibleNoInit - ); - - PVTVirtualNodeEnumeration = ^TVTVirtualNodeEnumeration; - - TVTVirtualNodeEnumerator = record - private - FNode: PVirtualNode; - FCanMoveNext: Boolean; - FEnumeration: PVTVirtualNodeEnumeration; - function GetCurrent: PVirtualNode; inline; - public - function MoveNext: Boolean; inline; - property Current: PVirtualNode read GetCurrent; - end; - - TVTVirtualNodeEnumeration = record - private - FMode: TVZVirtualNodeEnumerationMode; - FTree: TBaseVirtualTree; - // GetNextXxx parameters: - FConsiderChildrenAbove: Boolean; - FNode: PVirtualNode; - FNodeLevel: Cardinal; - FState: TCheckState; - FIncludeFiltered: Boolean; - public - function GetEnumerator: TVTVirtualNodeEnumerator; - private - function GetNext(Node: PVirtualNode): PVirtualNode; - end; - - - // ----- TBaseVirtualTree - TBaseVirtualTree = class(TCustomControl) - private - FTotalInternalDataSize: Cardinal; // Cache of the sum of the necessary internal data size for all tree - FBorderStyle: TBorderStyle; - FHeader: TVTHeader; - FRoot: PVirtualNode; - FDefaultNodeHeight, - FIndent: Cardinal; - FOptions: TCustomVirtualTreeOptions; - FUpdateCount: Cardinal; // update stopper, updates of the tree control are only done if = 0 - FSynchUpdateCount: Cardinal; // synchronizer, causes all events which are usually done via timers - // to happen immediately, regardless of the normal update state - FNodeDataSize: Integer; // number of bytes to allocate with each node (in addition to its base - // structure and the internal data), if -1 then do callback - FStates: TVirtualTreeStates; // various active/pending states the tree needs to consider - FLastSelected, - FFocusedNode: PVirtualNode; - FEditColumn, // column to be edited (focused node) - FFocusedColumn: TColumnIndex; // NoColumn if no columns are active otherwise the last hit column of - // the currently focused node - FHeightTrackPoint: TPoint; // Starting point of a node's height changing operation. - FHeightTrackNode: PVirtualNode; // Node which height is being changed. - FHeightTrackColumn: TColumnIndex; // Initial column where the height changing operation takes place. - FScrollDirections: TScrollDirections; // directions to scroll client area into depending on mouse position - FLastStructureChangeReason: TChangeReason; // Used for delayed structure change event. - FLastStructureChangeNode, // dito - FLastChangedNode, // used for delayed change event - FCurrentHotNode: PVirtualNode; // Node over which the mouse is hovering. - FCurrentHotColumn: TColumnIndex; // Column over which the mouse is hovering. - FHotNodeButtonHit: Boolean; // Indicates wether the mouse is hovering over the hot node's button. - FLastSelRect, - FNewSelRect: TRect; // used while doing draw selection - FHotCursor: TCursor; // can be set to additionally indicate the current hot node - FLastHitInfo: THitInfo; // The THitInfo of the last mouse-down event. - // in Win98 (slide) and Windows 2000 (fade)) - FHintMode: TVTHintMode; // determines the kind of the hint window - FHintData: TVTHintData; // used while preparing the hint window - FChangeDelay: Cardinal; // used to delay OnChange event - FEditDelay: Cardinal; // determines time to elapse before a node goes into edit mode - FPositionCache: TCache; // array which stores node references ordered by vertical positions - // (see also DoValidateCache for more information) - FVisibleCount: Cardinal; // number of currently visible nodes - FStartIndex: Cardinal; // index to start validating cache from - FSelection: TNodeArray; // list of currently selected nodes - FSelectionCount: Integer; // number of currently selected nodes (size of FSelection might differ) - FSelectionLocked: Boolean; // prevents the tree from changing the selection - FRangeAnchor: PVirtualNode; // anchor node for selection with the keyboard, determines start of a - // selection range - FCheckPropagationCount: Cardinal; // nesting level of check propagation (WL, 05.02.2004) - FLastSelectionLevel: Integer; // keeps the last node level for constrained multiselection - FDrawSelShiftState: TShiftState; // keeps the initial shift state when the user starts selection with - // the mouse - FEditLink: IVTEditLink; // used to comunicate with an application defined editor - FTempNodeCache: TNodeArray; // used at various places to hold temporarily a bunch of node refs. - FTempNodeCount: Cardinal; // number of nodes in FTempNodeCache - FBackground: TPicture; // A background image loadable at design and runtime. - FBackgroundImageTransparent: Boolean; // By default, this is off. When switched on, will try to draw the image - // transparent by using the color of the component as transparent color - - FMargin: Integer; // horizontal distance to border and columns - FTextMargin: Integer; // space between the node's text and its horizontal bounds - FBackgroundOffsetX, - FBackgroundOffsetY: Integer; // used to fine tune the position of the background image - FAnimationDuration: Cardinal; // specifies how long an animation shall take (expanding, hint) - FWantTabs: Boolean; // If True then the tree also consumes the tab key. - FNodeAlignment: TVTNodeAlignment; // determines how to interpret the align member of a node - FHeaderRect: TRect; // Space which the header currently uses in the control (window coords). - FLastHintRect: TRect; // Area which the mouse must leave to reshow a hint. - FUpdateRect: TRect; - FEmptyListMessage: string; // Optional message that will be displayed if no nodes exist in the control. - - // paint support and images - FPlusBM, - FMinusBM, // small bitmaps used for tree buttons - FHotPlusBM, - FHotMinusBM, - FSelectedHotPlusBM, - FSelectedHotMinusBM: TBitmap; // small bitmaps used for hot tree buttons - FImages, // normal images in the tree - FStateImages, // state images in the tree - FCustomCheckImages: TCustomImageList; // application defined check images - FCheckImageKind: TCheckImageKind; // light or dark, cross marks or tick marks - FCheckImages: TCustomImageList; // Reference to global image list to be used for the check images. - //TODO: Use this margin for other images as well - FImagesMargin: Integer; // The margin used left and right of the checkboxes. - FImageChangeLink, - FStateChangeLink, - FCustomCheckChangeLink: TChangeLink; // connections to the image lists - FOldFontChange: TNotifyEvent; // helper method pointer for tracking font changes in the off screen buffer - FColors: TVTColors; // class comprising all customizable colors in the tree - FButtonStyle: TVTButtonStyle; // style of the tree buttons - FButtonFillMode: TVTButtonFillMode; // for rectangular tree buttons only: how to fill them - FLineStyle: TVTLineStyle; // style of the tree lines - FLineMode: TVTLineMode; // tree lines or bands etc. - FDottedBrush: HBRUSH; // used to paint dotted lines without special pens - FSelectionCurveRadius: Cardinal; // radius for rounded selection rectangles - FSelectionBlendFactor: Byte; // Determines the factor by which the selection rectangle is to be - // faded if enabled. - FDrawSelectionMode: TVTDrawSelectionMode; // determines the paint mode for draw selection - - // alignment and directionality support - FAlignment: TAlignment; // default alignment of the tree if no columns are shown - - // drag'n drop and clipboard support - FDragImageKind: TVTDragImageKind; // determines whether or not and what to show in the drag image - FDragOperations: TDragOperations; // determines which operations are allowed during drag'n drop - FDragThreshold: Integer; // used to determine when to actually start a drag'n drop operation - FDragManager: IVTDragManager; // drag'n drop, cut'n paste - FDropTargetNode: PVirtualNode; // node currently selected as drop target - FLastDropMode: TDropMode; // set while dragging and used to track changes - FDragSelection: TNodeArray; // temporary copy of FSelection used during drag'n drop - FLastDragEffect: Integer; // The last executed drag effect - FDragType: TVTDragType; // used to switch between OLE and VCL drag'n drop - FDragImage: TVTDragImage; // drag image management - FDragWidth, - FDragHeight: Integer; // size of the drag image, the larger the more CPU power is needed - FClipboardFormats: TClipboardFormats; // a list of clipboard format descriptions enabled for this tree - FLastVCLDragTarget: PVirtualNode; // A node cache for VCL drag'n drop (keywords: DragLeave on DragDrop). - FVCLDragEffect: Integer; // A cache for VCL drag'n drop to keep the current drop effect. - - // scroll support - FScrollBarOptions: TScrollBarOptions; // common properties of horizontal and vertical scrollbar - FAutoScrollInterval: TAutoScrollInterval; // determines speed of auto scrolling - FAutoScrollDelay: Cardinal; // amount of milliseconds to wait until autoscrolling becomes active - FAutoExpandDelay: Cardinal; // amount of milliseconds to wait until a node is expanded if it is the - // drop target - FOffsetX: Integer; - FOffsetY: Integer; // Determines left and top scroll offset. - FEffectiveOffsetX: Integer; // Actual position of the horizontal scroll bar (varies depending on bidi mode). - FRangeX, - FRangeY: Cardinal; // current virtual width and height of the tree - FBottomSpace: Cardinal; // Extra space below the last node. - - FDefaultPasteMode: TVTNodeAttachMode; // Used to determine where to add pasted nodes to. - FDragScrollStart: Cardinal; // Contains the start time when a tree does auto scrolling as drop target. - - // search - FIncrementalSearch: TVTIncrementalSearch; // Used to determine whether and how incremental search is to be used. - FSearchTimeout: Cardinal; // Number of milliseconds after which to stop incremental searching. - FSearchBuffer: string; // Collects a sequence of keypresses used to do incremental searching. - FLastSearchNode: PVirtualNode; // Reference to node which was last found as search fit. - FSearchDirection: TVTSearchDirection; // Direction to incrementally search the tree. - FSearchStart: TVTSearchStart; // Where to start iteration on each key press. - - // miscellanous - FPanningWindow: HWND; // Helper window for wheel panning - FPanningCursor: HCURSOR; // 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. - FChangingTheme: Boolean; // Used to indicate that a theme change is goi ng on - FNextNodeToSelect: PVirtualNode; // Next tree node that we would like to select if the current one gets deleted or looses selection for other reasons. - - // MSAA support - FAccessible: IAccessible; // The IAccessible interface to the window itself. - FAccessibleItem: IAccessible; // The IAccessible to the item that currently has focus. - FAccessibleName: string; // The name the window is given for screen readers. - - // export - FOnBeforeNodeExport: TVTNodeExportEvent; // called before exporting a node - FOnNodeExport: TVTNodeExportEvent; - FOnAfterNodeExport: TVTNodeExportEvent; // called after exporting a node - FOnBeforeColumnExport: TVTColumnExportEvent; // called before exporting a column - FOnColumnExport: TVTColumnExportEvent; - FOnAfterColumnExport: TVTColumnExportEvent; // called after exporting a column - FOnBeforeTreeExport: TVTTreeExportEvent; // called before starting the export - FOnAfterTreeExport: TVTTreeExportEvent; // called after finishing the export - FOnBeforeHeaderExport: TVTTreeExportEvent; // called before exporting the header - FOnAfterHeaderExport: TVTTreeExportEvent; // called after exporting the header - - // common events - FOnChange: TVTChangeEvent; // selection change - FOnStructureChange: TVTStructureChangeEvent; // structural change like adding nodes etc. - FOnInitChildren: TVTInitChildrenEvent; // called when a node's children are needed (expanding etc.) - FOnInitNode: TVTInitNodeEvent; // called when a node needs to be initialized (child count etc.) - FOnFreeNode: TVTFreeNodeEvent; // called when a node is about to be destroyed, user data can and should - // be freed in this event - FOnGetImage: TVTGetImageEvent; // Used to retrieve the image index of a given node. - FOnGetImageEx: TVTGetImageExEvent; // Used to retrieve the image index of a given node along with a custom - // image list. - FOnGetImageText: TVTGetImageTextEvent; // Used to retrieve the image alternative text of a given node. - // Used by the accessibility interface to provide useful text for status images. - FOnHotChange: TVTHotNodeChangeEvent; // called when the current "hot" node (that is, the node under the mouse) - // changes and hot tracking is enabled - FOnExpanding, // called just before a node is expanded - FOnCollapsing: TVTChangingEvent; // called just before a node is collapsed - FOnChecking: TVTCheckChangingEvent; // called just before a node's check state is changed - FOnExpanded, // called after a node has been expanded - FOnCollapsed, // called after a node has been collapsed - FOnChecked: TVTChangeEvent; // called after a node's check state has been changed - FOnResetNode: TVTChangeEvent; // called when a node is set to be uninitialized - FOnNodeMoving: TVTNodeMovingEvent; // called just before a node is moved from one parent node to another - // (this can be cancelled) - FOnNodeMoved: TVTNodeMovedEvent; // called after a node and its children have been moved to another - // parent node (probably another tree, but within the same application) - FOnNodeCopying: TVTNodeCopyingEvent; // called when a node is copied to another parent node (probably in - // another tree, but within the same application, can be cancelled) - FOnNodeClick: TVTNodeClickEvent; // called when the user clicks on a node - FOnNodeDblClick: TVTNodeClickEvent; // called when the user double clicks on a node - FOnCanSplitterResizeNode: TVTCanSplitterResizeNodeEvent; // called to query the application wether resizing a node is allowed - FOnNodeHeightTracking: TVTNodeHeightTrackingEvent; // called when a node's height is being changed via mouse - FOnNodeHeightDblClickResize: TVTNodeHeightDblClickResizeEvent; // called when a node's vertical splitter is double clicked - FOnNodeCopied: TVTNodeCopiedEvent; // call after a node has been copied - FOnEditing: TVTEditChangingEvent; // called just before a node goes into edit mode - FOnEditCancelled: TVTEditCancelEvent; // called when editing has been cancelled - FOnEdited: TVTEditChangeEvent; // called when editing has successfully been finished - FOnFocusChanging: TVTFocusChangingEvent; // called when the focus is about to go to a new node and/or column - // (can be cancelled) - FOnFocusChanged: TVTFocusChangeEvent; // called when the focus goes to a new node and/or column - FOnAddToSelection: TVTAddToSelectionEvent; // called when a node is added to the selection - FOnRemoveFromSelection: TVTRemoveFromSelectionEvent; // called when a node is removed from the selection - FOnGetPopupMenu: TVTPopupEvent; // called when the popup for a node or the header needs to be shown - FOnGetHelpContext: TVTHelpContextEvent; // called when a node specific help theme should be called - FOnCreateEditor: TVTCreateEditorEvent; // called when a node goes into edit mode, this allows applications - // to supply their own editor - FOnLoadNode, // called after a node has been loaded from a stream (file, clipboard, - // OLE drag'n drop) to allow an application to load their own data - // saved in OnSaveNode - FOnSaveNode: TVTSaveNodeEvent; // called when a node needs to be serialized into a stream - // (see OnLoadNode) to give the application the opportunity to save - // their node specific, persistent data (note: never save memory - // references) - FOnLoadTree, // called after the tree has been loaded from a stream to allow an - // application to load their own data saved in OnSaveTree - FOnSaveTree: TVTSaveTreeEvent; // called after the tree has been saved to a stream to allow an - // application to save its own data - - // header/column mouse events - FOnAfterAutoFitColumn: TVTAfterAutoFitColumnEvent; - FOnAfterAutoFitColumns: TVTAfterAutoFitColumnsEvent; - FOnBeforeAutoFitColumns: TVTBeforeAutoFitColumnsEvent; - FOnBeforeAutoFitColumn: TVTBeforeAutoFitColumnEvent; - FOnHeaderAddPopupItem: TVTHeaderAddPopupItemEvent; - FOnHeaderClick: TVTHeaderClickEvent; - FOnHeaderDblClick: TVTHeaderClickEvent; - FOnAfterHeaderHeightTracking: TVTAfterHeaderHeightTrackingEvent; - FOnBeforeHeaderHeightTracking: TVTBeforeHeaderHeightTrackingEvent; - FOnHeaderHeightTracking: TVTHeaderHeightTrackingEvent; - FOnHeaderHeightDblClickResize: TVTHeaderHeightDblClickResizeEvent; - FOnHeaderMouseDown, - FOnHeaderMouseUp: TVTHeaderMouseEvent; - FOnHeaderMouseMove: TVTHeaderMouseMoveEvent; - FOnAfterGetMaxColumnWidth: TVTAfterGetMaxColumnWidthEvent; - FOnBeforeGetMaxColumnWidth: TVTBeforeGetMaxColumnWidthEvent; - FOnColumnClick: TVTColumnClickEvent; - FOnColumnDblClick: TVTColumnDblClickEvent; - FOnColumnResize: TVTHeaderNotifyEvent; - fOnColumnVisibilityChanged: TColumnChangeEvent; - FOnColumnWidthDblClickResize: TVTColumnWidthDblClickResizeEvent; - FOnAfterColumnWidthTracking: TVTAfterColumnWidthTrackingEvent; - FOnBeforeColumnWidthTracking: TVTBeforeColumnWidthTrackingEvent; - FOnColumnWidthTracking: TVTColumnWidthTrackingEvent; - FOnGetHeaderCursor: TVTGetHeaderCursorEvent; // triggered to allow the app. to use customized cursors for the header - FOnCanSplitterResizeColumn: TVTCanSplitterResizeColumnEvent; - FOnCanSplitterResizeHeader: TVTCanSplitterResizeHeaderEvent; - - // paint events - FOnAfterPaint, // triggered when the tree has entirely been painted - FOnBeforePaint: TVTPaintEvent; // triggered when the tree is about to be painted - FOnAfterItemPaint: TVTAfterItemPaintEvent; // triggered after an item has been painted - FOnBeforeItemPaint: TVTBeforeItemPaintEvent; // triggered when an item is about to be painted - FOnBeforeItemErase: TVTBeforeItemEraseEvent; // triggered when an item's background is about to be erased - FOnAfterItemErase: TVTAfterItemEraseEvent; // triggered after an item's background has been erased - FOnAfterCellPaint: TVTAfterCellPaintEvent; // triggered after a column of an item has been painted - FOnBeforeCellPaint: TVTBeforeCellPaintEvent; // triggered when a column of an item is about to be painted - FOnHeaderDraw: TVTHeaderPaintEvent; // Used when owner draw is enabled for the header and a column is set - // to owner draw mode. - FOnPrepareButtonImages : TVTPrepareButtonImagesEvent; //allow use to customise plus/minus bitmap images - FOnHeaderDrawQueryElements: TVTHeaderPaintQueryElementsEvent; // Used for advanced header painting to query the - // application for the elements, which are drawn by it and which should - // be drawn by the tree. - FOnAdvancedHeaderDraw: TVTAdvancedHeaderPaintEvent; // Used when owner draw is enabled for the header and a column - // is set to owner draw mode. But only if OnHeaderDrawQueryElements - // returns at least one element to be drawn by the application. - // In this case OnHeaderDraw is not used. - FOnGetLineStyle: TVTGetLineStyleEvent; // triggered when a custom line style is used and the pattern brush - // needs to be build - FOnPaintBackground: TVTBackgroundPaintEvent; // triggered if a part of the tree's background must be erased which is - // 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. - - // drag'n drop events - FOnCreateDragManager: TVTCreateDragManagerEvent; // called to allow for app./descendant defined drag managers - FOnCreateDataObject: TVTCreateDataObjectEvent; // called to allow for app./descendant defined data objects - FOnDragAllowed: TVTDragAllowedEvent; // used to get permission for manual drag in mouse down - FOnDragOver: TVTDragOverEvent; // called for every mouse move - FOnDragDrop: TVTDragDropEvent; // called on release of mouse button (if drop was allowed) - FOnHeaderDragged: TVTHeaderDraggedEvent; // header (column) drag'n drop - FOnHeaderDraggedOut: TVTHeaderDraggedOutEvent; // header (column) drag'n drop, which did not result in a valid drop. - FOnHeaderDragging: TVTHeaderDraggingEvent; // header (column) drag'n drop - FOnRenderOLEData: TVTRenderOLEDataEvent; // application/descendant defined clipboard formats - FOnGetUserClipboardFormats: TVTGetUserClipboardFormatsEvent; // gives application/descendants the opportunity to - // add own clipboard formats on the fly - - // miscellanous events - FOnGetNodeDataSize: TVTGetNodeDataSizeEvent; // Called if NodeDataSize is -1. - FOnBeforeDrawLineImage: TVTBeforeDrawLineImageEvent; // Called to allow adjusting the indention of treelines. - FOnKeyAction: TVTKeyActionEvent; // Used to selectively prevent key actions (full expand on Ctrl+'+' etc.). - FOnScroll: TVTScrollEvent; // Called when one or both paint offsets changed. - FOnUpdating: TVTUpdatingEvent; // Called from BeginUpdate, EndUpdate, BeginSynch and EndSynch. - FOnGetCursor: TVTGetCursorEvent; // Called to allow the app. to set individual cursors. - FOnStateChange: TVTStateChangeEvent; // Called whenever a state in the tree changes. - FOnGetCellIsEmpty: TVTGetCellIsEmptyEvent; // Called when the tree needs to know if a cell is empty. - FOnShowScrollBar: TVTScrollBarShowEvent; // Called when a scrollbar is changed in its visibility. - FOnBeforeGetCheckState: TVTBeforeGetCheckStateEvent; // Called before a CheckState for a Node is obtained. - // Gives the application a chance to do special processing - // when a check state is actually required for the first time. - - // search, sort - FOnCompareNodes: TVTCompareEvent; // used during sort - FOnDrawHint: TVTDrawHintEvent; - FOnGetHintSize: TVTGetHintSizeEvent; - FOnGetHintKind: TVTHintKindEvent; - FOnIncrementalSearch: TVTIncrementalSearchEvent; // triggered on every key press (not key down) - FOnMouseEnter: TNotifyEvent; - FOnMouseLeave: TNotifyEvent; - - // operations - FOnStartOperation: TVTOperationEvent; // Called when an operation starts - FOnEndOperation: TVTOperationEvent; // Called when an operation ends - - FVclStyleEnabled: Boolean; - - procedure CMStyleChanged(var Message: TMessage); message CM_STYLECHANGED; - procedure CMParentDoubleBufferedChange(var Message: TMessage); message CM_PARENTDOUBLEBUFFEREDCHANGED; - - procedure AdjustTotalCount(Node: PVirtualNode; Value: Integer; relative: Boolean = False); - procedure AdjustTotalHeight(Node: PVirtualNode; Value: Integer; relative: Boolean = False); - function CalculateCacheEntryCount: Integer; - procedure CalculateVerticalAlignments(var PaintInfo: TVTPaintInfo; var VButtonAlign: Integer); - function ChangeCheckState(Node: PVirtualNode; Value: TCheckState): Boolean; - function CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRight: Integer; Alignment: TAlignment; OldRect, - NewRect: TRect): Boolean; - function CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRight: Integer; Alignment: TAlignment; OldRect, - NewRect: TRect): Boolean; - 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: Integer; Style: TVTLineType; Reverse: Boolean); - function FindInPositionCache(Node: PVirtualNode; var CurrentPos: Cardinal): PVirtualNode; overload; - function FindInPositionCache(Position: Cardinal; var CurrentPos: Cardinal): PVirtualNode; overload; - procedure FixupTotalCount(Node: PVirtualNode); - procedure FixupTotalHeight(Node: PVirtualNode); - function GetBottomNode: PVirtualNode; - function GetCheckState(Node: PVirtualNode): TCheckState; - function GetCheckType(Node: PVirtualNode): TCheckType; - function GetChildCount(Node: PVirtualNode): Cardinal; - function GetChildrenInitialized(Node: PVirtualNode): Boolean; inline; - function GetCutCopyCount: Integer; - function GetDisabled(Node: PVirtualNode): Boolean; - function GetSyncCheckstateWithSelection(Node: PVirtualNode): Boolean; - function GetDragManager: IVTDragManager; - function GetExpanded(Node: PVirtualNode): Boolean; - function GetFiltered(Node: PVirtualNode): Boolean; - function GetFullyVisible(Node: PVirtualNode): Boolean; - function GetHasChildren(Node: PVirtualNode): Boolean; - function GetMultiline(Node: PVirtualNode): Boolean; - function GetNodeHeight(Node: PVirtualNode): Cardinal; - function GetNodeParent(Node: PVirtualNode): PVirtualNode; - function GetOffsetXY: TPoint; - function GetRootNodeCount: Cardinal; - function GetSelected(Node: PVirtualNode): Boolean; - function GetTopNode: PVirtualNode; - function GetTotalCount: Cardinal; - function GetVerticalAlignment(Node: PVirtualNode): Byte; - function GetVisible(Node: PVirtualNode): Boolean; - function GetVisiblePath(Node: PVirtualNode): Boolean; - function HandleDrawSelection(X, Y: Integer): Boolean; - function HasVisibleNextSibling(Node: PVirtualNode): Boolean; - function HasVisiblePreviousSibling(Node: PVirtualNode): Boolean; - procedure ImageListChange(Sender: TObject); - procedure InitializeFirstColumnValues(var PaintInfo: TVTPaintInfo); - procedure InitRootNode(OldSize: Cardinal = 0); - function IsFirstVisibleChild(Parent, Node: PVirtualNode): Boolean; - function IsLastVisibleChild(Parent, Node: PVirtualNode): Boolean; - function MakeNewNode: PVirtualNode; - function PackArray({*}const TheArray: TNodeArray; Count: Integer): Integer; - procedure PrepareBitmaps(NeedButtons, NeedLines: Boolean); - procedure FakeReadIdent(Reader: TReader); - procedure SetAlignment(const Value: TAlignment); - procedure SetAnimationDuration(const Value: Cardinal); - procedure SetBackground(const Value: TPicture); - procedure SetBackGroundImageTransparent(const Value: Boolean); - procedure SetBackgroundOffset(const Index, Value: Integer); - procedure SetBorderStyle(Value: TBorderStyle); - procedure SetBottomNode(Node: PVirtualNode); - procedure SetBottomSpace(const Value: Cardinal); - procedure SetButtonFillMode(const Value: TVTButtonFillMode); - procedure SetButtonStyle(const Value: TVTButtonStyle); - procedure SetCheckImageKind(Value: TCheckImageKind); - procedure SetCheckState(Node: PVirtualNode; Value: TCheckState); - procedure SetCheckType(Node: PVirtualNode; Value: TCheckType); - procedure SetClipboardFormats(const Value: TClipboardFormats); - procedure SetColors(const Value: TVTColors); - procedure SetCustomCheckImages(const Value: TCustomImageList); - procedure SetDefaultNodeHeight(Value: Cardinal); - procedure SetDisabled(Node: PVirtualNode; Value: Boolean); - procedure SetEmptyListMessage(const Value: string); - procedure SetExpanded(Node: PVirtualNode; Value: Boolean); - procedure SetFocusedColumn(Value: TColumnIndex); - procedure SetFocusedNode(Value: PVirtualNode); - procedure SetFullyVisible(Node: PVirtualNode; Value: Boolean); - procedure SetHasChildren(Node: PVirtualNode; Value: Boolean); - procedure SetHeader(const Value: TVTHeader); - procedure SetHotNode(Value: PVirtualNode); - procedure SetFiltered(Node: PVirtualNode; Value: Boolean); - procedure SetImages(const Value: TCustomImageList); - procedure SetIndent(Value: Cardinal); - procedure SetLineMode(const Value: TVTLineMode); - procedure SetLineStyle(const Value: TVTLineStyle); - procedure SetMargin(Value: Integer); - procedure SetMultiline(Node: PVirtualNode; const Value: Boolean); - procedure SetNodeAlignment(const Value: TVTNodeAlignment); - procedure SetNodeDataSize(Value: Integer); - procedure SetNodeHeight(Node: PVirtualNode; Value: Cardinal); - procedure SetNodeParent(Node: PVirtualNode; const Value: PVirtualNode); - procedure SetOffsetX(const Value: Integer); - procedure SetOffsetXY(const Value: TPoint); - procedure SetOffsetY(const Value: Integer); - procedure SetOptions(const Value: TCustomVirtualTreeOptions); - procedure SetRootNodeCount(Value: Cardinal); - procedure SetScrollBarOptions(Value: TScrollBarOptions); - procedure SetSearchOption(const Value: TVTIncrementalSearch); - procedure SetSelected(Node: PVirtualNode; Value: Boolean); - procedure SetSelectionCurveRadius(const Value: Cardinal); - procedure SetStateImages(const Value: TCustomImageList); - procedure SetTextMargin(Value: Integer); - procedure SetTopNode(Node: PVirtualNode); - procedure SetUpdateState(Updating: Boolean); - procedure SetVerticalAlignment(Node: PVirtualNode; Value: Byte); - procedure SetVisible(Node: PVirtualNode; Value: Boolean); - procedure SetVisiblePath(Node: PVirtualNode; Value: Boolean); - procedure PrepareBackGroundPicture(Source: TPicture; DrawBitmap: TBitmap; DrawBitmapWidth: Integer; DrawBitMapHeight: Integer; ABkgcolor: TColor); - procedure StaticBackground(Source: TPicture; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); - procedure StopTimer(ID: Integer); - procedure SetWindowTheme(const Theme: string); - procedure TileBackground(Source: TPicture; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); - function ToggleCallback(Step, StepSize: Integer; Data: Pointer): Boolean; - - procedure CMColorChange(var Message: TMessage); message CM_COLORCHANGED; - procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED; - procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED; - procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED; - procedure CMDenySubclassing(var Message: TMessage); message CM_DENYSUBCLASSING; - procedure CMDrag(var Message: TCMDrag); message CM_DRAG; - procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; - procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; - procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; - procedure CMHintShowPause(var Message: TCMHintShowPause); message CM_HINTSHOWPAUSE; - procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; - procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; - procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL; - procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; - procedure TVMGetItem(var Message: TMessage); message TVM_GETITEM; - procedure TVMGetItemRect(var Message: TMessage); message TVM_GETITEMRECT; - procedure TVMGetNextItem(var Message: TMessage); message TVM_GETNEXTITEM; - procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE; - procedure WMChar(var Message: TWMChar); message WM_CHAR; - procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU; - procedure WMCopy(var Message: TWMCopy); message WM_COPY; - procedure WMCut(var Message: TWMCut); message WM_CUT; - procedure WMEnable(var Message: TWMEnable); message WM_ENABLE; - procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; - procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; - procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT; - procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL; - procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; - procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP; - procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; - procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; - procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; - procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; - procedure WMMButtonDblClk(var Message: TWMMButtonDblClk); message WM_MBUTTONDBLCLK; - procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN; - procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP; - procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; - procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY; - procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; - procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT; - procedure WMPaint(var Message: TWMPaint); message WM_PAINT; - procedure WMPaste(var Message: TWMPaste); message WM_PASTE; - procedure WMPrint(var Message: TWMPrint); message WM_PRINT; - procedure WMPrintClient(var Message: TWMPrintClient); message WM_PRINTCLIENT; - procedure WMRButtonDblClk(var Message: TWMRButtonDblClk); message WM_RBUTTONDBLCLK; - procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; - procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP; - procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; - procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; - procedure WMSize(var Message: TWMSize); message WM_SIZE; - procedure WMTimer(var Message: TWMTimer); message WM_TIMER; - procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED; - procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; - function GetRangeX: Cardinal; - function GetDoubleBuffered: Boolean; - procedure SetDoubleBuffered(const Value: Boolean); - - protected - FFontChanged: Boolean; // flag for keeping informed about font changes in the off screen buffer // [IPK] - private to protected - procedure AutoScale(isDpiChange: Boolean); virtual; - procedure AddToSelection(Node: PVirtualNode; NotifySynced: Boolean); overload; virtual; - 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: Integer); virtual; - 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; - function CalculateSelectionRect(X, Y: Integer): Boolean; virtual; - function CanAutoScroll: Boolean; virtual; - function CanShowDragImage: Boolean; virtual; - function CanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex): Boolean; - procedure Change(Node: PVirtualNode); virtual; - procedure ChangeTreeStatesAsync(EnterStates, LeaveStates: TVirtualTreeStates); - procedure ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; isDpiChange: Boolean{$ifend}); override; - function CheckParentCheckState(Node: PVirtualNode; NewCheckState: TCheckState): Boolean; virtual; - procedure ClearSelection(pFireChangeEvent: Boolean); overload; virtual; - procedure ClearTempCache; virtual; - function ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; - function ComputeRTLOffset(ExcludeScrollBar: Boolean = False): Integer; virtual; - function CountLevelDifference(Node1, Node2: PVirtualNode): Integer; virtual; - function CountVisibleChildren(Node: PVirtualNode): Cardinal; virtual; - procedure CreateParams(var Params: TCreateParams); override; - procedure CreateWnd; override; - procedure DefineProperties(Filer: TFiler); override; - procedure DeleteNode(Node: PVirtualNode; Reindex: Boolean; ParentClearing: Boolean); overload; - function DetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect): TDropMode; virtual; - procedure DetermineHiddenChildrenFlag(Node: PVirtualNode); virtual; - procedure DetermineHiddenChildrenFlagAllNodes; virtual; - procedure DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: Integer; Alignment: TAlignment); virtual; - procedure DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: Integer; Alignment: TAlignment); virtual; - function DetermineLineImageAndSelectLevel(Node: PVirtualNode; var LineImage: TLineImage): Integer; virtual; - function DetermineNextCheckState(CheckType: TCheckType; CheckState: TCheckState): TCheckState; virtual; - function DetermineScrollDirections(X, Y: Integer): TScrollDirections; virtual; - procedure DoAdvancedHeaderDraw(var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements); virtual; - procedure DoAfterCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); virtual; - procedure DoAfterItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); virtual; - procedure DoAfterItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); virtual; - procedure DoAfterPaint(Canvas: TCanvas); virtual; - procedure DoAutoScroll(X, Y: Integer); virtual; - function DoBeforeDrag(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; - procedure DoBeforeCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); virtual; - procedure DoBeforeItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; var Color: TColor; - var EraseAction: TItemEraseAction); virtual; - function DoBeforeItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect): Boolean; virtual; - procedure DoBeforePaint(Canvas: TCanvas); virtual; - function DoCancelEdit: Boolean; virtual; - procedure DoCanEdit(Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); virtual; - procedure DoCanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex; - var Allowed: Boolean); virtual; - procedure DoChange(Node: PVirtualNode); virtual; - procedure DoCheckClick(Node: PVirtualNode; NewCheckState: TCheckState); virtual; - procedure DoChecked(Node: PVirtualNode); virtual; - function DoChecking(Node: PVirtualNode; var NewCheckState: TCheckState): Boolean; virtual; - procedure DoCollapsed(Node: PVirtualNode); virtual; - function DoCollapsing(Node: PVirtualNode): Boolean; virtual; - procedure DoColumnClick(Column: TColumnIndex; Shift: TShiftState); virtual; - procedure DoColumnDblClick(Column: TColumnIndex; Shift: TShiftState); virtual; - procedure DoColumnResize(Column: TColumnIndex); virtual; - procedure DoColumnVisibilityChanged(const Column: TColumnIndex; Visible: Boolean); - function DoCompare(Node1, Node2: PVirtualNode; Column: TColumnIndex): Integer; virtual; - function DoCreateDataObject: IDataObject; virtual; - function DoCreateDragManager: IVTDragManager; virtual; - function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; virtual; - procedure DoDragging(P: TPoint); virtual; - procedure DoDragExpand; virtual; - procedure DoBeforeDrawLineImage(Node: PVirtualNode; Level: Integer; var XPos: Integer); virtual; - function DoDragOver(Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; - var Effect: Integer): Boolean; virtual; - procedure DoDragDrop(Source: TObject; const DataObject: IDataObject; const Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; - var Effect: Integer; Mode: TDropMode); virtual; - procedure DoDrawHint(Canvas: TCanvas; Node: PVirtualNode; R: TRect; Column: - TColumnIndex); - procedure DoEdit; virtual; - procedure DoEndDrag(Target: TObject; X, Y: Integer); override; - function DoEndEdit: Boolean; virtual; - procedure DoEndOperation(OperationKind: TVTOperationKind); virtual; - procedure DoEnter(); override; - procedure DoExpanded(Node: PVirtualNode); virtual; - function DoExpanding(Node: PVirtualNode): Boolean; virtual; - procedure DoFocusChange(Node: PVirtualNode; Column: TColumnIndex); virtual; - function DoFocusChanging(OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex): Boolean; virtual; - procedure DoFocusNode(Node: PVirtualNode; Ask: Boolean); virtual; - procedure DoFreeNode(Node: PVirtualNode); virtual; - function DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; - CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; virtual; - procedure DoGetCursor(var Cursor: TCursor); virtual; - procedure DoGetHeaderCursor(var Cursor: HCURSOR); virtual; - procedure DoGetHintSize(Node: PVirtualNode; Column: TColumnIndex; var R: - TRect); virtual; - procedure DoGetHintKind(Node: PVirtualNode; Column: TColumnIndex; var Kind: - TVTHintKind); - function DoGetImageIndex(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; - var Ghosted: Boolean; var Index: TImageIndex): TCustomImageList; virtual; - procedure DoGetImageText(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var ImageText: string); virtual; - procedure DoGetLineStyle(var Bits: Pointer); virtual; - function DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; virtual; - function DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; virtual; - function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; virtual; - function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; virtual; - function DoGetPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint): TPopupMenu; virtual; - procedure DoGetUserClipboardFormats(var Formats: TFormatEtcArray); virtual; - procedure DoHeaderAddPopupItem(const Column: TColumnIndex; var Cmd: TAddPopupItemType); - procedure DoHeaderClick(const HitInfo: TVTHeaderHitInfo); virtual; - procedure DoHeaderDblClick(const HitInfo: TVTHeaderHitInfo); virtual; - procedure DoHeaderDragged(Column: TColumnIndex; OldPosition: TColumnPosition); virtual; - procedure DoHeaderDraggedOut(Column: TColumnIndex; DropPosition: TPoint); virtual; - function DoHeaderDragging(Column: TColumnIndex): Boolean; virtual; - procedure DoHeaderDraw(Canvas: TCanvas; Column: TVirtualTreeColumn; R: TRect; Hover, Pressed: Boolean; - DropMark: TVTDropMarkMode); virtual; - procedure DoHeaderDrawQueryElements(var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); virtual; - procedure DoHeaderMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual; - procedure DoHeaderMouseMove(Shift: TShiftState; X, Y: Integer); virtual; - procedure DoHeaderMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual; - procedure DoHotChange(Old, New: PVirtualNode); virtual; - function DoIncrementalSearch(Node: PVirtualNode; const Text: string): Integer; virtual; - function DoInitChildren(Node: PVirtualNode; var ChildCount: Cardinal): Boolean; virtual; - procedure DoInitNode(Parent, Node: PVirtualNode; var InitStates: TVirtualNodeInitStates); virtual; - function DoKeyAction(var CharCode: Word; var Shift: TShiftState): Boolean; virtual; - procedure DoLoadUserData(Node: PVirtualNode; Stream: TStream); virtual; - procedure DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer); virtual; - procedure DoMouseEnter(); virtual; - procedure DoMouseLeave(); virtual; - procedure DoNodeCopied(Node: PVirtualNode); virtual; - function DoNodeCopying(Node, NewParent: PVirtualNode): Boolean; virtual; - procedure DoNodeClick(const HitInfo: THitInfo); virtual; - procedure DoNodeDblClick(const HitInfo: THitInfo); virtual; - function DoNodeHeightDblClickResize(Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; - P: TPoint): Boolean; virtual; - function DoNodeHeightTracking(Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; - var TrackPoint: TPoint; P: TPoint): Boolean; virtual; - procedure DoNodeMoved(Node: PVirtualNode); virtual; - function DoNodeMoving(Node, NewParent: PVirtualNode): Boolean; virtual; - function DoPaintBackground(Canvas: TCanvas; R: TRect): Boolean; virtual; - procedure DoPaintDropMark(Canvas: TCanvas; Node: PVirtualNode; R: TRect); virtual; - procedure DoPaintNode(var PaintInfo: TVTPaintInfo); virtual; - procedure DoPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint); virtual; - procedure DoRemoveFromSelection(Node: PVirtualNode); virtual; - function DoRenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; - ForClipboard: Boolean): HRESULT; virtual; - procedure DoReset(Node: PVirtualNode); virtual; - procedure DoSaveUserData(Node: PVirtualNode; Stream: TStream); virtual; - procedure DoScroll(DeltaX, DeltaY: Integer); virtual; - function DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOptions; ClipRect: PRect = nil): Boolean; virtual; - procedure DoShowScrollBar(Bar: Integer; Show: Boolean); virtual; - procedure DoStartDrag(var DragObject: TDragObject); override; - procedure DoStartOperation(OperationKind: TVTOperationKind); virtual; - procedure DoStateChange(Enter: TVirtualTreeStates; Leave: TVirtualTreeStates = []); virtual; - procedure DoStructureChange(Node: PVirtualNode; Reason: TChangeReason); virtual; - procedure DoTimerScroll; virtual; - procedure DoUpdating(State: TVTUpdateState); virtual; - function DoValidateCache: Boolean; virtual; - procedure DragAndDrop(AllowedEffects: DWord; const DataObject: IDataObject; var DragEffect: Integer); virtual; - procedure DragCanceled; override; - function DragDrop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; - var Effect: Integer): HResult; reintroduce; virtual; - function DragEnter(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; virtual; - procedure DragFinished; virtual; - procedure DragLeave; virtual; - function DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint; - var Effect: Integer): HResult; reintroduce; virtual; - procedure DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: Integer); virtual; - procedure DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: Integer; UseSelectedBkColor: Boolean = False); virtual; - procedure EndOperation(OperationKind: TVTOperationKind); - procedure EnsureNodeFocused(); virtual; - function FindNodeInSelection(P: PVirtualNode; var Index: Integer; LowBound, HighBound: Integer): Boolean; virtual; - procedure FinishChunkHeader(Stream: TStream; StartPos, EndPos: Integer); virtual; - procedure FontChanged(AFont: TObject); virtual; - function GetBorderDimensions: TSize; virtual; - function GetCheckedCount: Integer; - function GetCheckImage(Node: PVirtualNode; ImgCheckType: TCheckType = ctNone; - ImgCheckState: TCheckState = csUncheckedNormal; ImgEnabled: Boolean = True): Integer; virtual; - function GetColumnClass: TVirtualTreeColumnClass; virtual; - function GetDefaultHintKind: TVTHintKind; virtual; - function GetHeaderClass: TVTHeaderClass; virtual; - function GetHintWindowClass: THintWindowClass; virtual; - procedure GetImageIndex(var Info: TVTPaintInfo; Kind: TVTImageKind; InfoIndex: TVTImageInfoIndex); virtual; - function GetImageSize(Node: PVirtualNode; Kind: TVTImageKind = TVTImageKind.ikNormal; Column: TColumnIndex = 0; IncludePadding: Boolean = True): TSize; virtual; - function GetNodeImageSize(Node: PVirtualNode): TSize; virtual; deprecated 'Use GetImageSize instead'; - function GetMaxRightExtend: Cardinal; virtual; - procedure GetNativeClipboardFormats(var Formats: TFormatEtcArray); virtual; - function GetOperationCanceled: Boolean; - function GetOptionsClass: TTreeOptionsClass; virtual; - function GetTreeFromDataObject(const DataObject: IDataObject): TBaseVirtualTree; virtual; - procedure HandleHotTrack(X, Y: Integer); virtual; - procedure HandleIncrementalSearch(CharCode: Word); virtual; - procedure HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); virtual; - procedure HandleMouseDown(var Message: TWMMouse; var HitInfo: THitInfo); virtual; - procedure HandleMouseUp(var Message: TWMMouse; const HitInfo: THitInfo); virtual; - procedure HandleClickSelection(LastFocused, NewNode: PVirtualNode; Shift: TShiftState; DragPending: Boolean); - function HasImage(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex): Boolean; virtual; deprecated 'Use GetImageSize instead'; - function HasPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Pos: TPoint): Boolean; virtual; - procedure InitChildren(Node: PVirtualNode); virtual; - procedure InitNode(Node: PVirtualNode); virtual; - procedure InternalAddFromStream(Stream: TStream; Version: Integer; Node: PVirtualNode); virtual; - function InternalAddToSelection(Node: PVirtualNode; ForceInsert: Boolean): Boolean; overload; - function InternalAddToSelection(const NewItems: TNodeArray; NewLength: Integer; - ForceInsert: Boolean): Boolean; overload; - procedure InternalCacheNode(Node: PVirtualNode); virtual; - procedure InternalClearSelection; virtual; - procedure InternalConnectNode(Node, Destination: PVirtualNode; Target: TBaseVirtualTree; Mode: TVTNodeAttachMode); virtual; - function InternalData(Node: PVirtualNode): Pointer; - procedure InternalDisconnectNode(Node: PVirtualNode; KeepFocus: Boolean; Reindex: Boolean = True; ParentClearing: Boolean = False); virtual; - procedure InternalRemoveFromSelection(Node: PVirtualNode); virtual; - procedure InterruptValidation; - procedure InvalidateCache; - procedure Loaded; override; - procedure MainColumnChanged; virtual; - procedure MarkCutCopyNodes; virtual; - procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; - procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure OriginalWMNCPaint(DC: HDC); virtual; - procedure Paint; override; - procedure PaintCheckImage(Canvas: TCanvas; const ImageInfo: TVTImageInfo; Selected: Boolean); virtual; - procedure PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean); virtual; - procedure PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect; ButtonX, - ButtonY: Integer; BidiMode: TBiDiMode); virtual; - procedure PaintTreeLines(const PaintInfo: TVTPaintInfo; IndentSize: Integer; const LineImage: TLineImage); virtual; - procedure PaintSelectionRectangle(Target: TCanvas; WindowOrgX: Integer; const SelectionRect: TRect; - TargetRect: TRect); virtual; - procedure PanningWindowProc(var Message: TMessage); virtual; - procedure PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: Integer); virtual; - function ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, - ChunkSize: Integer): Boolean; virtual; - procedure ReadNode(Stream: TStream; Version: Integer; Node: PVirtualNode); virtual; - procedure RedirectFontChangeEvent(Canvas: TCanvas); virtual; - procedure RemoveFromSelection(Node: PVirtualNode); virtual; - procedure UpdateNextNodeToSelect(Node: PVirtualNode); virtual; - function RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HResult; virtual; - procedure ResetRangeAnchor; virtual; - procedure RestoreFontChangeEvent(Canvas: TCanvas); virtual; - procedure SelectNodes(StartNode, EndNode: PVirtualNode; AddOnly: Boolean); virtual; - procedure SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal); virtual; - procedure SetFocusedNodeAndColumn(Node: PVirtualNode; Column: TColumnIndex); virtual; - procedure SetRangeX(value: Cardinal); - procedure SkipNode(Stream: TStream); virtual; - procedure StartOperation(OperationKind: TVTOperationKind); - procedure StartWheelPanning(Position: TPoint); virtual; - procedure StopWheelPanning; virtual; - procedure StructureChange(Node: PVirtualNode; Reason: TChangeReason); virtual; - function SuggestDropEffect(Source: TObject; Shift: TShiftState; Pt: TPoint; AllowedEffects: Integer): Integer; virtual; - procedure ToggleSelection(StartNode, EndNode: PVirtualNode); virtual; - procedure UnselectNodes(StartNode, EndNode: PVirtualNode); virtual; - procedure UpdateColumnCheckState(Col: TVirtualTreeColumn); - procedure UpdateDesigner; virtual; - 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; - procedure WriteChunks(Stream: TStream; Node: PVirtualNode); virtual; - procedure WriteNode(Stream: TStream; Node: PVirtualNode); virtual; - - procedure VclStyleChanged; virtual; - property VclStyleEnabled: Boolean read FVclStyleEnabled; - property TotalInternalDataSize: Cardinal read FTotalInternalDataSize; - - property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; - property AnimationDuration: Cardinal read FAnimationDuration write SetAnimationDuration default 200; - property AutoExpandDelay: Cardinal read FAutoExpandDelay write FAutoExpandDelay default 1000; - property AutoScrollDelay: Cardinal read FAutoScrollDelay write FAutoScrollDelay default 1000; - property AutoScrollInterval: TAutoScrollInterval read FAutoScrollInterval write FAutoScrollInterval default 1; - property Background: TPicture read FBackground write SetBackground; - property BackGroundImageTransparent: Boolean read FBackGroundImageTransparent write SetBackGroundImageTransparent default False; - property BackgroundOffsetX: Integer index 0 read FBackgroundOffsetX write SetBackgroundOffset default 0; - property BackgroundOffsetY: Integer index 1 read FBackgroundOffsetY write SetBackgroundOffset default 0; - property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; - property BottomSpace: Cardinal read FBottomSpace write SetBottomSpace default 0; - property ButtonFillMode: TVTButtonFillMode read FButtonFillMode write SetButtonFillMode default fmTreeColor; - property ButtonStyle: TVTButtonStyle read FButtonStyle write SetButtonStyle default bsRectangle; - property ChangeDelay: Cardinal read FChangeDelay write FChangeDelay default 0; - property CheckImageKind: TCheckImageKind read FCheckImageKind write SetCheckImageKind stored False default ckSystemDefault; // deprecated, see issue #622 - property ClipboardFormats: TClipboardFormats read FClipboardFormats write SetClipboardFormats; - property Colors: TVTColors read FColors write SetColors; - property CustomCheckImages: TCustomImageList read FCustomCheckImages write SetCustomCheckImages; - property DefaultHintKind: TVTHintKind read GetDefaultHintKind; - property DefaultNodeHeight: Cardinal read FDefaultNodeHeight write SetDefaultNodeHeight default 18; - property DefaultPasteMode: TVTNodeAttachMode read FDefaultPasteMode write FDefaultPasteMode default amAddChildLast; - property DragHeight: Integer read FDragHeight write FDragHeight default 350; - property DragImageKind: TVTDragImageKind read FDragImageKind write FDragImageKind default diComplete; - property DragOperations: TDragOperations read FDragOperations write FDragOperations default [doCopy, doMove]; - property DragSelection: TNodeArray read FDragSelection; - property LastDragEffect: Integer read FLastDragEffect; - property DragType: TVTDragType read FDragType write FDragType default dtOLE; - property DragWidth: Integer read FDragWidth write FDragWidth default 200; - property DrawSelectionMode: TVTDrawSelectionMode read FDrawSelectionMode write FDrawSelectionMode - default smDottedRectangle; - property EditColumn: TColumnIndex read FEditColumn write FEditColumn; - property EditDelay: Cardinal read FEditDelay write FEditDelay default 1000; - property EffectiveOffsetX: Integer read FEffectiveOffsetX; - property HeaderRect: TRect read FHeaderRect; - property HintMode: TVTHintMode read FHintMode write FHintMode default hmDefault; - property HintData: TVTHintData read FHintData write FHintData; - property HotCursor: TCursor read FHotCursor write FHotCursor default crDefault; - property Images: TCustomImageList read FImages write SetImages; - property IncrementalSearch: TVTIncrementalSearch read FIncrementalSearch write SetSearchOption default isNone; - property IncrementalSearchDirection: TVTSearchDirection read FSearchDirection write FSearchDirection default sdForward; - property IncrementalSearchStart: TVTSearchStart read FSearchStart write FSearchStart default ssFocusedNode; - property IncrementalSearchTimeout: Cardinal read FSearchTimeout write FSearchTimeout default 1000; - property Indent: Cardinal read FIndent write SetIndent default 18; - property LastClickPos: TPoint read FLastClickPos write FLastClickPos; - property LastDropMode: TDropMode read FLastDropMode write FLastDropMode; - property LastHintRect: TRect read FLastHintRect write FLastHintRect; - property LineMode: TVTLineMode read FLineMode write SetLineMode default lmNormal; - property LineStyle: TVTLineStyle read FLineStyle write SetLineStyle default lsDotted; - property Margin: Integer read FMargin write SetMargin default 4; - property NextNodeToSelect: PVirtualNode read FNextNodeToSelect; // Next tree node that we would like to select if the current one gets deleted - property NodeAlignment: TVTNodeAlignment read FNodeAlignment write SetNodeAlignment default naProportional; - property NodeDataSize: Integer read FNodeDataSize write SetNodeDataSize default -1; - property OperationCanceled: Boolean read GetOperationCanceled; - property HotMinusBM: TBitmap read FHotMinusBM; - property HotPlusBM: TBitmap read FHotPlusBM; - property MinusBM: TBitmap read FMinusBM; - property PlusBM: TBitmap read FPlusBM; - property RangeX: Cardinal 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: Cardinal 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; - property SelectionCurveRadius: Cardinal read FSelectionCurveRadius write SetSelectionCurveRadius default 0; - property StateImages: TCustomImageList read FStateImages write SetStateImages; - property TextMargin: Integer read FTextMargin write SetTextMargin default 4; - property TreeOptions: TCustomVirtualTreeOptions read FOptions write SetOptions; - property WantTabs: Boolean read FWantTabs write FWantTabs default False; - property SyncCheckstateWithSelection[Node: PVirtualNode]: Boolean read GetSyncCheckstateWithSelection; - - property OnAddToSelection: TVTAddToSelectionEvent read FOnAddToSelection write FOnAddToSelection; - property OnAdvancedHeaderDraw: TVTAdvancedHeaderPaintEvent read FOnAdvancedHeaderDraw write FOnAdvancedHeaderDraw; - property OnAfterAutoFitColumn: TVTAfterAutoFitColumnEvent read FOnAfterAutoFitColumn write FOnAfterAutoFitColumn; - property OnAfterAutoFitColumns: TVTAfterAutoFitColumnsEvent read FOnAfterAutoFitColumns write FOnAfterAutoFitColumns; - property OnAfterCellPaint: TVTAfterCellPaintEvent read FOnAfterCellPaint write FOnAfterCellPaint; - property OnAfterColumnExport : TVTColumnExportEvent read FOnAfterColumnExport write FOnAfterColumnExport; - property OnAfterColumnWidthTracking: TVTAfterColumnWidthTrackingEvent read FOnAfterColumnWidthTracking write FOnAfterColumnWidthTracking; - property OnAfterGetMaxColumnWidth: TVTAfterGetMaxColumnWidthEvent read FOnAfterGetMaxColumnWidth write FOnAfterGetMaxColumnWidth; - property OnAfterHeaderExport: TVTTreeExportEvent read FOnAfterHeaderExport write FOnAfterHeaderExport; - property OnAfterHeaderHeightTracking: TVTAfterHeaderHeightTrackingEvent read FOnAfterHeaderHeightTracking - write FOnAfterHeaderHeightTracking; - property OnAfterItemErase: TVTAfterItemEraseEvent read FOnAfterItemErase write FOnAfterItemErase; - property OnAfterItemPaint: TVTAfterItemPaintEvent read FOnAfterItemPaint write FOnAfterItemPaint; - property OnAfterNodeExport: TVTNodeExportEvent read FOnAfterNodeExport write FOnAfterNodeExport; - property OnAfterPaint: TVTPaintEvent read FOnAfterPaint write FOnAfterPaint; - property OnAfterTreeExport: TVTTreeExportEvent read FOnAfterTreeExport write FOnAfterTreeExport; - property OnBeforeAutoFitColumn: TVTBeforeAutoFitColumnEvent read FOnBeforeAutoFitColumn write FOnBeforeAutoFitColumn; - property OnBeforeAutoFitColumns: TVTBeforeAutoFitColumnsEvent read FOnBeforeAutoFitColumns write FOnBeforeAutoFitColumns; - property OnBeforeCellPaint: TVTBeforeCellPaintEvent read FOnBeforeCellPaint write FOnBeforeCellPaint; - property OnBeforeColumnExport: TVTColumnExportEvent read FOnBeforeColumnExport write FOnBeforeColumnExport; - property OnBeforeColumnWidthTracking: TVTBeforeColumnWidthTrackingEvent read FOnBeforeColumnWidthTracking - write FOnBeforeColumnWidthTracking; - property OnBeforeDrawTreeLine: TVTBeforeDrawLineImageEvent read FOnBeforeDrawLineImage write FOnBeforeDrawLineImage; - property OnBeforeGetMaxColumnWidth: TVTBeforeGetMaxColumnWidthEvent read FOnBeforeGetMaxColumnWidth write FOnBeforeGetMaxColumnWidth; - property OnBeforeHeaderExport: TVTTreeExportEvent read FOnBeforeHeaderExport write FOnBeforeHeaderExport; - property OnBeforeHeaderHeightTracking: TVTBeforeHeaderHeightTrackingEvent read FOnBeforeHeaderHeightTracking - write FOnBeforeHeaderHeightTracking; - property OnBeforeItemErase: TVTBeforeItemEraseEvent read FOnBeforeItemErase write FOnBeforeItemErase; - property OnBeforeItemPaint: TVTBeforeItemPaintEvent read FOnBeforeItemPaint write FOnBeforeItemPaint; - property OnBeforeNodeExport: TVTNodeExportEvent read FOnBeforeNodeExport write FOnBeforeNodeExport; - property OnBeforePaint: TVTPaintEvent read FOnBeforePaint write FOnBeforePaint; - property OnBeforeTreeExport: TVTTreeExportEvent read FOnBeforeTreeExport write FOnBeforeTreeExport; - property OnCanSplitterResizeColumn: TVTCanSplitterResizeColumnEvent read FOnCanSplitterResizeColumn write FOnCanSplitterResizeColumn; - property OnCanSplitterResizeHeader: TVTCanSplitterResizeHeaderEvent read FOnCanSplitterResizeHeader write FOnCanSplitterResizeHeader; - property OnCanSplitterResizeNode: TVTCanSplitterResizeNodeEvent read FOnCanSplitterResizeNode write FOnCanSplitterResizeNode; - property OnChange: TVTChangeEvent read FOnChange write FOnChange; - property OnChecked: TVTChangeEvent read FOnChecked write FOnChecked; - property OnChecking: TVTCheckChangingEvent read FOnChecking write FOnChecking; - property OnCollapsed: TVTChangeEvent read FOnCollapsed write FOnCollapsed; - property OnCollapsing: TVTChangingEvent read FOnCollapsing write FOnCollapsing; - property OnColumnClick: TVTColumnClickEvent read FOnColumnClick write FOnColumnClick; - property OnColumnDblClick: TVTColumnDblClickEvent read FOnColumnDblClick write FOnColumnDblClick; - property OnColumnExport : TVTColumnExportEvent read FOnColumnExport write FOnColumnExport; - property OnColumnResize: TVTHeaderNotifyEvent read FOnColumnResize write FOnColumnResize; - property OnColumnVisibilityChanged: TColumnChangeEvent read fOnColumnVisibilityChanged write fOnColumnVisibilityChanged; - property OnColumnWidthDblClickResize: TVTColumnWidthDblClickResizeEvent read FOnColumnWidthDblClickResize - write FOnColumnWidthDblClickResize; - property OnColumnWidthTracking: TVTColumnWidthTrackingEvent read FOnColumnWidthTracking write FOnColumnWidthTracking; - property OnCompareNodes: TVTCompareEvent read FOnCompareNodes write FOnCompareNodes; - property OnCreateDataObject: TVTCreateDataObjectEvent read FOnCreateDataObject write FOnCreateDataObject; - property OnCreateDragManager: TVTCreateDragManagerEvent read FOnCreateDragManager write FOnCreateDragManager; - property OnCreateEditor: TVTCreateEditorEvent read FOnCreateEditor write FOnCreateEditor; - property OnDragAllowed: TVTDragAllowedEvent read FOnDragAllowed write FOnDragAllowed; - property OnDragOver: TVTDragOverEvent read FOnDragOver write FOnDragOver; - property OnDragDrop: TVTDragDropEvent read FOnDragDrop write FOnDragDrop; - property OnDrawHint: TVTDrawHintEvent read FOnDrawHint write FOnDrawHint; - property OnEditCancelled: TVTEditCancelEvent read FOnEditCancelled write FOnEditCancelled; - property OnEditing: TVTEditChangingEvent read FOnEditing write FOnEditing; - property OnEdited: TVTEditChangeEvent read FOnEdited write FOnEdited; - property OnEndOperation: TVTOperationEvent read FOnEndOperation write FOnEndOperation; - property OnExpanded: TVTChangeEvent read FOnExpanded write FOnExpanded; - property OnExpanding: TVTChangingEvent read FOnExpanding write FOnExpanding; - property OnFocusChanged: TVTFocusChangeEvent read FOnFocusChanged write FOnFocusChanged; - property OnFocusChanging: TVTFocusChangingEvent read FOnFocusChanging write FOnFocusChanging; - property OnFreeNode: TVTFreeNodeEvent read FOnFreeNode write FOnFreeNode; - property OnGetCellIsEmpty: TVTGetCellIsEmptyEvent read FOnGetCellIsEmpty write FOnGetCellIsEmpty; - property OnGetCursor: TVTGetCursorEvent read FOnGetCursor write FOnGetCursor; - property OnGetHeaderCursor: TVTGetHeaderCursorEvent read FOnGetHeaderCursor write FOnGetHeaderCursor; - property OnGetHelpContext: TVTHelpContextEvent read FOnGetHelpContext write FOnGetHelpContext; - property OnGetHintSize: TVTGetHintSizeEvent read FOnGetHintSize write - FOnGetHintSize; - property OnGetHintKind: TVTHintKindEvent read FOnGetHintKind write - FOnGetHintKind; - property OnGetImageIndex: TVTGetImageEvent read FOnGetImage write FOnGetImage; - property OnGetImageIndexEx: TVTGetImageExEvent read FOnGetImageEx write FOnGetImageEx; - property OnGetImageText: TVTGetImageTextEvent read FOnGetImageText write FOnGetImageText; - property OnGetLineStyle: TVTGetLineStyleEvent read FOnGetLineStyle write FOnGetLineStyle; - property OnGetNodeDataSize: TVTGetNodeDataSizeEvent read FOnGetNodeDataSize write FOnGetNodeDataSize; - property OnGetPopupMenu: TVTPopupEvent read FOnGetPopupMenu write FOnGetPopupMenu; - property OnGetUserClipboardFormats: TVTGetUserClipboardFormatsEvent read FOnGetUserClipboardFormats - write FOnGetUserClipboardFormats; - property OnHeaderAddPopupItem: TVTHeaderAddPopupItemEvent read FOnHeaderAddPopupItem write FOnHeaderAddPopupItem; - property OnHeaderClick: TVTHeaderClickEvent read FOnHeaderClick write FOnHeaderClick; - property OnHeaderDblClick: TVTHeaderClickEvent read FOnHeaderDblClick write FOnHeaderDblClick; - property OnHeaderDragged: TVTHeaderDraggedEvent read FOnHeaderDragged write FOnHeaderDragged; - property OnHeaderDraggedOut: TVTHeaderDraggedOutEvent read FOnHeaderDraggedOut write FOnHeaderDraggedOut; - property OnHeaderDragging: TVTHeaderDraggingEvent read FOnHeaderDragging write FOnHeaderDragging; - property OnHeaderDraw: TVTHeaderPaintEvent read FOnHeaderDraw write FOnHeaderDraw; - property OnHeaderDrawQueryElements: TVTHeaderPaintQueryElementsEvent read FOnHeaderDrawQueryElements - write FOnHeaderDrawQueryElements; - property OnHeaderHeightTracking: TVTHeaderHeightTrackingEvent read FOnHeaderHeightTracking - write FOnHeaderHeightTracking; - property OnHeaderHeightDblClickResize: TVTHeaderHeightDblClickResizeEvent read FOnHeaderHeightDblClickResize - write FOnHeaderHeightDblClickResize; - property OnHeaderMouseDown: TVTHeaderMouseEvent read FOnHeaderMouseDown write FOnHeaderMouseDown; - property OnHeaderMouseMove: TVTHeaderMouseMoveEvent read FOnHeaderMouseMove write FOnHeaderMouseMove; - property OnHeaderMouseUp: TVTHeaderMouseEvent read FOnHeaderMouseUp write FOnHeaderMouseUp; - property OnHotChange: TVTHotNodeChangeEvent read FOnHotChange write FOnHotChange; - property OnIncrementalSearch: TVTIncrementalSearchEvent read FOnIncrementalSearch write FOnIncrementalSearch; - property OnInitChildren: TVTInitChildrenEvent read FOnInitChildren write FOnInitChildren; - property OnInitNode: TVTInitNodeEvent read FOnInitNode write FOnInitNode; - property OnKeyAction: TVTKeyActionEvent read FOnKeyAction write FOnKeyAction; - property OnLoadNode: TVTSaveNodeEvent read FOnLoadNode write FOnLoadNode; - property OnLoadTree: TVTSaveTreeEvent read FOnLoadTree write FOnLoadTree; - property OnMeasureItem: TVTMeasureItemEvent read FOnMeasureItem write FOnMeasureItem; - property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; - property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave; - property OnNodeClick: TVTNodeClickEvent read FOnNodeClick write FOnNodeClick; - property OnNodeCopied: TVTNodeCopiedEvent read FOnNodeCopied write FOnNodeCopied; - property OnNodeCopying: TVTNodeCopyingEvent read FOnNodeCopying write FOnNodeCopying; - property OnNodeDblClick: TVTNodeClickEvent read FOnNodeDblClick write FOnNodeDblClick; - property OnNodeExport: TVTNodeExportEvent read FOnNodeExport write FOnNodeExport; - property OnNodeHeightTracking: TVTNodeHeightTrackingEvent read FOnNodeHeightTracking write FOnNodeHeightTracking; - property OnNodeHeightDblClickResize: TVTNodeHeightDblClickResizeEvent read FOnNodeHeightDblClickResize - write FOnNodeHeightDblClickResize; - property OnNodeMoved: TVTNodeMovedEvent read FOnNodeMoved write FOnNodeMoved; - property OnNodeMoving: TVTNodeMovingEvent read FOnNodeMoving write FOnNodeMoving; - property OnPaintBackground: TVTBackgroundPaintEvent read FOnPaintBackground write FOnPaintBackground; - property OnPrepareButtonBitmaps : TVTPrepareButtonImagesEvent read FOnPrepareButtonImages write FOnPrepareButtonImages; - property OnRemoveFromSelection: TVTRemoveFromSelectionEvent read FOnRemoveFromSelection write FOnRemoveFromSelection; - property OnRenderOLEData: TVTRenderOLEDataEvent read FOnRenderOLEData write FOnRenderOLEData; - property OnResetNode: TVTChangeEvent read FOnResetNode write FOnResetNode; - property OnSaveNode: TVTSaveNodeEvent read FOnSaveNode write FOnSaveNode; - property OnSaveTree: TVTSaveTreeEvent read FOnSaveTree write FOnSaveTree; - property OnScroll: TVTScrollEvent read FOnScroll write FOnScroll; - property OnShowScrollBar: TVTScrollBarShowEvent read FOnShowScrollBar write FOnShowScrollBar; - property OnBeforeGetCheckState: TVTBeforeGetCheckStateEvent read FOnBeforeGetCheckState write FOnBeforeGetCheckState; - property OnStartOperation: TVTOperationEvent read FOnStartOperation write FOnStartOperation; - property OnStateChange: TVTStateChangeEvent read FOnStateChange write FOnStateChange; - property OnStructureChange: TVTStructureChangeEvent read FOnStructureChange write FOnStructureChange; - property OnUpdating: TVTUpdatingEvent read FOnUpdating write FOnUpdating; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - function AbsoluteIndex(Node: PVirtualNode): Cardinal; - function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; overload; virtual; - function AddChild(Parent: PVirtualNode; const UserData: IInterface): PVirtualNode; overload; - function AddChild(Parent: PVirtualNode; const UserData: TObject): PVirtualNode; overload; - procedure AddFromStream(Stream: TStream; TargetNode: PVirtualNode); - procedure AfterConstruction; override; - procedure Assign(Source: TPersistent); override; - procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1); - procedure BeginSynch; - procedure BeginUpdate; virtual; - procedure CancelCutOrCopy; - function CancelEditNode: Boolean; - procedure CancelOperation; - function CanEdit(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; - function CanFocus: Boolean; override; - procedure Clear; virtual; - procedure ClearChecked; - procedure ClearSelection(); overload; inline; - function CopyTo(Source: PVirtualNode; Tree: TBaseVirtualTree; Mode: TVTNodeAttachMode; - ChildrenOnly: Boolean): PVirtualNode; overload; - function CopyTo(Source, Target: PVirtualNode; Mode: TVTNodeAttachMode; - ChildrenOnly: Boolean): PVirtualNode; overload; - procedure CopyToClipboard; virtual; - procedure CutToClipboard; virtual; - procedure DeleteChildren(Node: PVirtualNode; ResetHasChildren: Boolean = False); - procedure DeleteNode(Node: PVirtualNode); overload; inline; - procedure DeleteNodes(const pNodes: TNodeArray); - procedure DeleteSelectedNodes; virtual; - function Dragging: Boolean; - function EditNode(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; - function EndEditNode: Boolean; - procedure EndSynch; - procedure EndUpdate; virtual; - procedure EnsureNodeSelected(); virtual; - function ExecuteAction(Action: TBasicAction): Boolean; override; - procedure FinishCutOrCopy; - procedure FlushClipboard; - procedure FullCollapse(Node: PVirtualNode = nil); virtual; - procedure FullExpand(Node: PVirtualNode = nil); virtual; - function GetControlsAlignment: TAlignment; override; - function GetDisplayRect(Node: PVirtualNode; Column: TColumnIndex; TextOnly: Boolean; Unclipped: Boolean = False; - ApplyCellContentMargin: Boolean = False): TRect; - function GetEffectivelyFiltered(Node: PVirtualNode): Boolean; - function GetEffectivelyVisible(Node: PVirtualNode): Boolean; - function GetFirst(ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetFirstChecked(State: TCheckState = csCheckedNormal; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetFirstChild(Node: PVirtualNode): PVirtualNode; - function GetFirstChildNoInit(Node: PVirtualNode): PVirtualNode; - function GetFirstCutCopy(ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetFirstInitialized(ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetFirstLeaf: PVirtualNode; - function GetFirstLevel(NodeLevel: Cardinal): PVirtualNode; - function GetFirstNoInit(ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetFirstSelected(ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetFirstVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; - IncludeFiltered: Boolean = False): PVirtualNode; - function GetFirstVisibleChild(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - function GetFirstVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - function GetFirstVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; - IncludeFiltered: Boolean = False): PVirtualNode; - procedure GetHitTestInfoAt(X, Y: Integer; Relative: Boolean; var HitInfo: THitInfo); virtual; - function GetLast(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetLastInitialized(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetLastNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetLastChild(Node: PVirtualNode): PVirtualNode; - function GetLastChildNoInit(Node: PVirtualNode): PVirtualNode; - function GetLastVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; - IncludeFiltered: Boolean = False): PVirtualNode; - function GetLastVisibleChild(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - function GetLastVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - function GetLastVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; - IncludeFiltered: Boolean = False): PVirtualNode; - function GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): Integer; virtual; - function GetNext(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetNextChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; - ConsiderChildrenAbove: Boolean = False): PVirtualNode; overload; - function GetNextChecked(Node: PVirtualNode; ConsiderChildrenAbove: Boolean): PVirtualNode; overload; - function GetNextCutCopy(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetNextInitialized(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetNextLeaf(Node: PVirtualNode): PVirtualNode; - function GetNextLevel(Node: PVirtualNode; NodeLevel: Cardinal): PVirtualNode; - function GetNextNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetNextSelected(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetNextSibling(Node: PVirtualNode): PVirtualNode; - function GetNextSiblingNoInit(Node: PVirtualNode): PVirtualNode; - function GetNextVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; - function GetNextVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; - function GetNextVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - function GetNextVisibleSiblingNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - function GetNodeAt(const P: TPoint): PVirtualNode; overload; inline; - function GetNodeAt(X, Y: Integer): PVirtualNode; overload; - function GetNodeAt(X, Y: Integer; Relative: Boolean; var NodeTop: Integer): PVirtualNode; overload; - function GetNodeData(Node: PVirtualNode): Pointer; overload; - function GetNodeData(pNode: PVirtualNode): T; overload; inline; - function GetSelectedData(): TArray; overload; - function GetInterfaceFromNodeData(pNode: PVirtualNode): T; overload; inline; - function GetNodeDataAt(pXCoord: Integer; pYCoord: Integer): T; - function GetFirstSelectedNodeData(): T; - function GetNodeLevel(Node: PVirtualNode): Cardinal; - function GetNodeLevelForSelectConstraint(Node: PVirtualNode): integer; - function GetOffset(pElement: TVTElement; pNode: PVirtualNode): integer; - procedure GetOffsets(pNode: PVirtualNode; out pOffsets: TVTOffsets; pElement: TVTElement = TVTElement.ofsEndOfClientArea; pColumn: Integer = NoColumn); - function GetPrevious(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetPreviousChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; - ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetPreviousCutCopy(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetPreviousInitialized(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetPreviousLeaf(Node: PVirtualNode): PVirtualNode; - function GetPreviousLevel(Node: PVirtualNode; NodeLevel: Cardinal): PVirtualNode; - function GetPreviousNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetPreviousSelected(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - function GetPreviousSibling(Node: PVirtualNode): PVirtualNode; - function GetPreviousSiblingNoInit(Node: PVirtualNode): PVirtualNode; - function GetPreviousVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; - function GetPreviousVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; - function GetPreviousVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - function GetPreviousVisibleSiblingNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - function GetSortedCutCopySet(Resolve: Boolean): TNodeArray; - function GetSortedSelection(Resolve: Boolean): TNodeArray; - procedure GetTextInfo(Node: PVirtualNode; Column: TColumnIndex; const AFont: TFont; var R: TRect; - var Text: string); virtual; - function GetTreeRect: TRect; - function GetVisibleParent(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - function HasAsParent(Node, PotentialParent: PVirtualNode): Boolean; - function InsertNode(Node: PVirtualNode; Mode: TVTNodeAttachMode; UserData: Pointer = nil): PVirtualNode; - procedure InvalidateChildren(Node: PVirtualNode; Recursive: Boolean); - procedure InvalidateColumn(Column: TColumnIndex); - function InvalidateNode(Node: PVirtualNode): TRect; virtual; - procedure InvalidateToBottom(Node: PVirtualNode); - procedure InvertSelection(VisibleOnly: Boolean); - function IsEditing: Boolean; - function IsMouseSelecting: Boolean; - function IsEmpty: Boolean; inline; - function IterateSubtree(Node: 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; - procedure MeasureItemHeight(const Canvas: TCanvas; Node: PVirtualNode); virtual; - procedure MoveTo(Source, Target: PVirtualNode; Mode: TVTNodeAttachMode; ChildrenOnly: Boolean); overload; - procedure MoveTo(Node: PVirtualNode; Tree: TBaseVirtualTree; Mode: TVTNodeAttachMode; - ChildrenOnly: Boolean); overload; - procedure PaintTree(TargetCanvas: TCanvas; Window: TRect; Target: TPoint; PaintOptions: TVTInternalPaintOptions; - PixelFormat: TPixelFormat = pfDevice); virtual; - function PasteFromClipboard: Boolean; virtual; - procedure PrepareDragImage(HotSpot: TPoint; const DataObject: IDataObject); - procedure Print(Printer: TPrinter; PrintHeader: Boolean); - function ProcessDrop(const DataObject: IDataObject; TargetNode: PVirtualNode; var Effect: Integer; Mode: - TVTNodeAttachMode): Boolean; - function ProcessOLEData(Source: TBaseVirtualTree; const DataObject: IDataObject; TargetNode: PVirtualNode; - Mode: TVTNodeAttachMode; Optimized: Boolean): Boolean; - procedure RepaintNode(Node: PVirtualNode); - procedure ReinitChildren(Node: PVirtualNode; Recursive: Boolean); virtual; - procedure InitRecursive(Node: PVirtualNode; Levels: Cardinal = MaxInt; pVisibleOnly: Boolean = True); - procedure ReinitNode(Node: PVirtualNode; Recursive: Boolean); virtual; - procedure ResetNode(Node: PVirtualNode); virtual; - procedure SaveToFile(const FileName: TFileName); - procedure SaveToStream(Stream: TStream; Node: PVirtualNode = nil); virtual; - function ScaledPixels(pPixels: Integer): Integer; - function ScrollIntoView(Node: PVirtualNode; Center: Boolean; Horizontally: Boolean = False): Boolean; overload; - function ScrollIntoView(Column: TColumnIndex; Center: Boolean; Node: PVirtualNode = nil): Boolean; overload; - procedure SelectAll(VisibleOnly: Boolean); - procedure SetCheckStateForAll(aCheckState: TCheckState; pSelectedOnly: Boolean; pExcludeDisabled: Boolean = True); - procedure SetNodeData(pNode: PVirtualNode; pUserData: Pointer); overload; inline; - procedure SetNodeData(pNode: PVirtualNode; const pUserData: IInterface); overload; inline; - procedure SetNodeData(pNode: PVirtualNode; pUserData: T); overload; - procedure Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; - procedure SortTree(Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; - procedure ToggleNode(Node: PVirtualNode); - procedure UpdateHorizontalRange; virtual; - procedure UpdateHorizontalScrollBar(DoRepaint: Boolean); - procedure UpdateRanges; - procedure UpdateScrollBars(DoRepaint: Boolean); virtual; - procedure UpdateVerticalRange; - procedure UpdateVerticalScrollBar(DoRepaint: Boolean); - function UseRightToLeftReading: Boolean; - procedure ValidateChildren(Node: PVirtualNode; Recursive: Boolean); - procedure ValidateNode(Node: PVirtualNode; Recursive: Boolean); - - { Enumerations } - function Nodes(ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; - function CheckedNodes(State: TCheckState = csCheckedNormal; ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; - function ChildNodes(Node: PVirtualNode): TVTVirtualNodeEnumeration; - function CutCopyNodes(ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; - function InitializedNodes(ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; - function LeafNodes: TVTVirtualNodeEnumeration; - function LevelNodes(NodeLevel: Cardinal): TVTVirtualNodeEnumeration; - function NoInitNodes(ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; - function SelectedNodes(ConsiderChildrenAbove: Boolean = False): TVTVirtualNodeEnumeration; - function VisibleNodes(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; - IncludeFiltered: Boolean = False): TVTVirtualNodeEnumeration; - function VisibleChildNodes(Node: PVirtualNode; IncludeFiltered: Boolean = False): TVTVirtualNodeEnumeration; - function VisibleChildNoInitNodes(Node: PVirtualNode; IncludeFiltered: Boolean = False): TVTVirtualNodeEnumeration; - function VisibleNoInitNodes(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; - IncludeFiltered: Boolean = False): TVTVirtualNodeEnumeration; - property Accessible: IAccessible read FAccessible write FAccessible; - property AccessibleItem: IAccessible read FAccessibleItem write FAccessibleItem; - property AccessibleName: string read FAccessibleName write FAccessibleName; - property BottomNode: PVirtualNode read GetBottomNode write SetBottomNode; - property CheckedCount: Integer read GetCheckedCount; - property CheckImages: TCustomImageList read FCheckImages; - property CheckState[Node: PVirtualNode]: TCheckState read GetCheckState write SetCheckState; - property CheckType[Node: PVirtualNode]: TCheckType read GetCheckType write SetCheckType; - property ChildCount[Node: PVirtualNode]: Cardinal read GetChildCount write SetChildCount; - property ChildrenInitialized[Node: PVirtualNode]: Boolean read GetChildrenInitialized; - property CutCopyCount: Integer read GetCutCopyCount; - property DragImage: TVTDragImage read FDragImage; - property DragManager: IVTDragManager read GetDragManager; - property DropTargetNode: PVirtualNode read FDropTargetNode write FDropTargetNode; - property EditLink: IVTEditLink read FEditLink; - property EmptyListMessage: string read FEmptyListMessage write SetEmptyListMessage; - property Expanded[Node: PVirtualNode]: Boolean read GetExpanded write SetExpanded; - property FocusedColumn: TColumnIndex read FFocusedColumn write SetFocusedColumn default InvalidColumn; - property FocusedNode: PVirtualNode read FFocusedNode write SetFocusedNode; - property Font; - property FullyVisible[Node: PVirtualNode]: Boolean read GetFullyVisible write SetFullyVisible; - property HasChildren[Node: PVirtualNode]: Boolean read GetHasChildren write SetHasChildren; - property Header: TVTHeader read FHeader write SetHeader; - property HotNode: PVirtualNode read FCurrentHotNode write SetHotNode; - property IsDisabled[Node: PVirtualNode]: Boolean read GetDisabled write SetDisabled; - property IsEffectivelyFiltered[Node: PVirtualNode]: Boolean read GetEffectivelyFiltered; - property IsEffectivelyVisible[Node: PVirtualNode]: Boolean read GetEffectivelyVisible; - 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]: Cardinal read GetNodeHeight write SetNodeHeight; - property NodeParent[Node: PVirtualNode]: PVirtualNode read GetNodeParent write SetNodeParent; - property OffsetX: Integer read FOffsetX write SetOffsetX; - property OffsetXY: TPoint read GetOffsetXY write SetOffsetXY; - property OffsetY: Integer read FOffsetY write SetOffsetY; - property OperationCount: Cardinal read FOperationCount; - property RootNode: PVirtualNode read FRoot; - property SearchBuffer: string read FSearchBuffer; - property Selected[Node: PVirtualNode]: Boolean read GetSelected write SetSelected; - property SelectionLocked: Boolean read FSelectionLocked write FSelectionLocked; - property TotalCount: Cardinal read GetTotalCount; - property TreeStates: TVirtualTreeStates read FStates write FStates; - property SelectedCount: Integer read FSelectionCount; - property TopNode: PVirtualNode read GetTopNode write SetTopNode; - property VerticalAlignment[Node: PVirtualNode]: Byte read GetVerticalAlignment write SetVerticalAlignment; - property VisibleCount: Cardinal read FVisibleCount; - property VisiblePath[Node: PVirtualNode]: Boolean read GetVisiblePath write SetVisiblePath; - property UpdateCount: Cardinal read FUpdateCount; - property DoubleBuffered: Boolean read GetDoubleBuffered write SetDoubleBuffered default True; - end; - - - // --------- TCustomVirtualStringTree - - // Options regarding strings (useful only for the string tree and descendants): - TVTStringOption = ( - toSaveCaptions, // If set then the caption is automatically saved with the tree node, regardless of what is - // saved in the user data. - toShowStaticText, // Show static text in a caption which can be differently formatted than the caption - // but cannot be edited. - toAutoAcceptEditChange // Automatically accept changes during edit if the user finishes editing other then - // VK_RETURN or ESC. If not set then changes are cancelled. - ); - TVTStringOptions = set of TVTStringOption; - -const - DefaultStringOptions = [toSaveCaptions, toAutoAcceptEditChange]; - -type - TCustomStringTreeOptions = class(TCustomVirtualTreeOptions) - private - FStringOptions: TVTStringOptions; - procedure SetStringOptions(const Value: TVTStringOptions); - protected - property StringOptions: TVTStringOptions read FStringOptions write SetStringOptions default DefaultStringOptions; - public - constructor Create(AOwner: TBaseVirtualTree); override; - - procedure AssignTo(Dest: TPersistent); override; - end; - - TStringTreeOptions = class(TCustomStringTreeOptions) - published - property AnimationOptions; - property AutoOptions; - property ExportMode; - property MiscOptions; - property PaintOptions; - property SelectionOptions; - property StringOptions; - property EditOptions; - end; - - TCustomVirtualStringTree = class; - - // Edit support Classes. - TStringEditLink = class; - - TVTEdit = class(TCustomEdit) - private - procedure CMAutoAdjust(var Message: TMessage); message CM_AUTOADJUST; - procedure CMExit(var Message: TMessage); message CM_EXIT; - procedure CMRelease(var Message: TMessage); message CM_RELEASE; - procedure CNCommand(var Message: TWMCommand); message CN_COMMAND; - procedure WMChar(var Message: TWMChar); message WM_CHAR; - procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; - procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; - procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; - protected - FRefLink: IVTEditLink; - FLink: TStringEditLink; - procedure AutoAdjustSize; virtual; - function CalcMinHeight: Integer; virtual; - procedure CreateParams(var Params: TCreateParams); override; - function GetTextSize: TSize; virtual; - public - constructor Create(Link: TStringEditLink); reintroduce; - - procedure Release; virtual; - - property AutoSelect; - property AutoSize; + property AccessibleName; + property Action; + property Align; + property Alignment; + property Anchors; + property AnimationDuration; + property AutoExpandDelay; + property AutoScrollDelay; + property AutoScrollInterval; + property Background; + property BackGroundImageTransparent; + property BackgroundOffsetX; + property BackgroundOffsetY; + property BiDiMode; + property BevelEdges; + property BevelInner; + property BevelOuter; + property BevelKind; + property BevelWidth; property BorderStyle; - property CharCase; - property HideSelection; - property MaxLength; - property OEMConvert; - property PasswordChar; - end; - - TStringEditLink = class(TInterfacedObject, IVTEditLink) - private - FEdit: TVTEdit; // A normal custom edit control. - protected - FTree: TCustomVirtualStringTree; // A back reference to the tree calling. - FNode: PVirtualNode; // The node to be edited. - FColumn: TColumnIndex; // The column of the node. - FAlignment: TAlignment; - FTextBounds: TRect; // Smallest rectangle around the text. - FStopping: Boolean; // Set to True when the edit link requests stopping the edit action. - procedure SetEdit(const Value: TVTEdit); // Setter for the FEdit member; - public - constructor Create; virtual; - destructor Destroy; override; - property Node : PVirtualNode read FNode; // [IPK] Make FNode accessible - property Column: TColumnIndex read FColumn; // [IPK] Make Column(Index) accessible - - function BeginEdit: Boolean; virtual; stdcall; - function CancelEdit: Boolean; virtual; stdcall; - property Edit: TVTEdit read FEdit write SetEdit; - function EndEdit: Boolean; virtual; stdcall; - function GetBounds: TRect; virtual; stdcall; - function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; stdcall; - procedure ProcessMessage(var Message: TMessage); virtual; stdcall; - procedure SetBounds(R: TRect); virtual; stdcall; - end; - - // Describes the type of text to return in the text and draw info retrival events. - TVSTTextType = ( - ttNormal, // normal label of the node, this is also the text which can be edited - ttStatic // static (non-editable) text after the normal text - ); - - // Describes the source to use when converting a string tree into a string for clipboard etc. - TVSTTextSourceType = ( - tstAll, // All nodes are rendered. Initialization is done on the fly. - tstInitialized, // Only initialized nodes are rendered. - tstSelected, // Only selected nodes are rendered. - tstCutCopySet, // Only nodes currently marked as being in the cut/copy clipboard set are rendered. - tstVisible, // Only visible nodes are rendered. - tstChecked // Only checked nodes are rendered - ); - - TVTPaintText = procedure(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - TextType: TVSTTextType) of object; - TVSTGetTextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - TextType: TVSTTextType; var CellText: string) of object; - TVSTGetHintEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string) of object; - // New text can only be set for variable caption. - TVSTNewTextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - NewText: string) of object; - TVSTShortenStringEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - Column: TColumnIndex; const S: string; TextSpace: Integer; var Result: string; - var Done: Boolean) of object; - TVTMeasureTextEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - Column: TColumnIndex; const Text: string; var Extent: Integer) of object; - TVTDrawTextEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; - Column: TColumnIndex; const Text: string; const CellRect: TRect; var DefaultDraw: Boolean) of object; - - /// Event arguments of the OnGetCellText event - TVSTGetCellTextEventArgs = record - Node: PVirtualNode; - Column: TColumnIndex; - CellText: string; - StaticText: string; - ExportType: TVTExportType; - constructor Create(pNode: PVirtualNode; pColumn: TColumnIndex; pExportType: TVTExportType = TVTExportType.etNone); - end; - - /// Event signature which is called when text is painted on the canvas or needed for the export. - TVSTGetCellTextEvent = procedure(Sender: TCustomVirtualStringTree; var E: TVSTGetCellTextEventArgs) of object; - - TCustomVirtualStringTree = class(TBaseVirtualTree) - private - FInternalDataOffset: Cardinal; // offset to the internal data of the string tree - FDefaultText: string; // text to show if there's no OnGetText event handler (e.g. at design time) - FTextHeight: Integer; // true size of the font - FEllipsisWidth: Integer; // width of '...' for the current font - - FOnPaintText: TVTPaintText; // triggered before either normal or fixed text is painted to allow - // even finer customization (kind of sub cell painting) - FOnGetText: TVSTGetTextEvent; // used to retrieve the string to be displayed for a specific node - fOnGetCellText: TVSTGetCellTextEvent; // used to retrieve the normal and static text of a tree node - FOnGetHint: TVSTGetHintEvent; // used to retrieve the hint to be displayed for a specific node - FOnNewText: TVSTNewTextEvent; // used to notify the application about an edited node caption - FOnShortenString: TVSTShortenStringEvent; // used to allow the application a customized string shortage - FOnMeasureTextWidth: TVTMeasureTextEvent; // used to adjust the width of the cells - FOnMeasureTextHeight: TVTMeasureTextEvent; - FOnDrawText: TVTDrawTextEvent; // used to custom draw the node text - /// Returns True if the property DefaultText has a value that differs from the default value, False otherwise. - function IsDefaultTextStored(): Boolean; - function GetImageText(Node: PVirtualNode; Kind: TVTImageKind; - Column: TColumnIndex): string; - function GetOptions: TCustomStringTreeOptions; - function GetStaticText(Node: PVirtualNode; Column: TColumnIndex): string; - function GetText(Node: PVirtualNode; Column: TColumnIndex): string; - procedure ReadText(Reader: TReader); - procedure WriteText(Writer: TWriter); - procedure ResetInternalData(Node: PVirtualNode; Recursive: Boolean); - procedure SetDefaultText(const Value: string); - procedure SetOptions(const Value: TCustomStringTreeOptions); - procedure SetText(Node: PVirtualNode; Column: TColumnIndex; const Value: string); - procedure WMSetFont(var Msg: TWMSetFont); message WM_SETFONT; - procedure GetDataFromGrid(const AStrings : TStringList; const IncludeHeading : Boolean = True); - protected - FPreviouslySelected: TStringList; - procedure InitializeTextProperties(var PaintInfo: TVTPaintInfo); // [IPK] - private to protected - procedure PaintNormalText(var PaintInfo: TVTPaintInfo; TextOutFlags: Integer; Text: string); virtual; // [IPK] - private to protected - procedure PaintStaticText(const PaintInfo: TVTPaintInfo; TextOutFlags: Integer; const Text: string); virtual; // [IPK] - private to protected - procedure AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var NextNonEmpty: TColumnIndex); override; - function CanExportNode(Node: PVirtualNode): Boolean; - function CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): Integer; virtual; - function CalculateTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): Integer; virtual; - function ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; override; - procedure DefineProperties(Filer: TFiler); override; - function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; override; - function DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; override; - function DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): string; override; - function DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; override; - function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; override; - procedure DoGetText(var pEventArgs: TVSTGetCellTextEventArgs); virtual; - function DoIncrementalSearch(Node: PVirtualNode; const Text: string): Integer; override; - procedure DoNewText(Node: PVirtualNode; Column: TColumnIndex; const Text: string); virtual; - procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override; - procedure DoPaintText(Node: PVirtualNode; const Canvas: TCanvas; Column: TColumnIndex; - TextType: TVSTTextType); virtual; - function DoShortenString(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const S: string; Width: Integer; - EllipsisWidth: Integer = 0): string; virtual; - procedure DoTextDrawing(var PaintInfo: TVTPaintInfo; const Text: string; CellRect: TRect; DrawFormat: Cardinal); virtual; - function DoTextMeasuring(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): TSize; virtual; - function GetOptionsClass: TTreeOptionsClass; override; - procedure GetRenderStartValues(Source: TVSTTextSourceType; var Node: PVirtualNode; - var NextNodeProc: TGetNextNodeProc); - function InternalData(Node: PVirtualNode): Pointer; - procedure MainColumnChanged; override; - function ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, - ChunkSize: Integer): Boolean; override; - procedure ReadOldStringOptions(Reader: TReader); - function RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; ForClipboard: Boolean): HResult; override; - procedure SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal); override; - procedure WriteChunks(Stream: TStream; Node: PVirtualNode); override; - - property DefaultText: string read FDefaultText write SetDefaultText stored False;// Stored via own writer - property EllipsisWidth: Integer read FEllipsisWidth; - property TreeOptions: TCustomStringTreeOptions read GetOptions write SetOptions; - - property OnGetHint: TVSTGetHintEvent read FOnGetHint write FOnGetHint; - property OnGetText: TVSTGetTextEvent read FOnGetText write FOnGetText; - property OnGetCellText: TVSTGetCellTextEvent read fOnGetCellText write fOnGetCellText; - property OnNewText: TVSTNewTextEvent read FOnNewText write FOnNewText; - property OnPaintText: TVTPaintText read FOnPaintText write FOnPaintText; - property OnShortenString: TVSTShortenStringEvent read FOnShortenString write FOnShortenString; - property OnMeasureTextWidth: TVTMeasureTextEvent read FOnMeasureTextWidth write FOnMeasureTextWidth; - property OnMeasureTextHeight: TVTMeasureTextEvent read FOnMeasureTextHeight write FOnMeasureTextHeight; - property OnDrawText: TVTDrawTextEvent read FOnDrawText write FOnDrawText; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy(); override; - function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; override; - function ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; S: string = ''): Integer; virtual; - function ContentToClipboard(Format: Word; Source: TVSTTextSourceType): HGLOBAL; - procedure ContentToCustom(Source: TVSTTextSourceType); - function ContentToHTML(Source: TVSTTextSourceType; const Caption: string = ''): String; - function ContentToRTF(Source: TVSTTextSourceType): RawByteString; - function ContentToText(Source: TVSTTextSourceType; Separator: Char): String; overload; - function ContentToUnicode(Source: TVSTTextSourceType; Separator: WideChar): string; overload; deprecated 'Use ContentToText instead'; - function ContentToText(Source: TVSTTextSourceType; const Separator: string): string; overload; - procedure GetTextInfo(Node: PVirtualNode; Column: TColumnIndex; const AFont: TFont; var R: TRect; - var Text: string); override; - function InvalidateNode(Node: PVirtualNode): TRect; override; - function Path(Node: PVirtualNode; Column: TColumnIndex; Delimiter: Char): string; - procedure ReinitNode(Node: PVirtualNode; Recursive: Boolean); override; - procedure AddToSelection(Node: PVirtualNode; NotifySynced: Boolean); override; - procedure RemoveFromSelection(Node: PVirtualNode); override; - function SaveToCSVFile(const FileNameWithPath : TFileName; const IncludeHeading : Boolean) : Boolean; - /// Alternate text for images used in Accessibility. - property ImageText[Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex]: string read GetImageText; - property StaticText[Node: PVirtualNode; Column: TColumnIndex]: string read GetStaticText; - property Text[Node: PVirtualNode; Column: TColumnIndex]: string read GetText write SetText; - end; - - [ComponentPlatformsAttribute(pidWin32 or pidWin64)] - TVirtualStringTree = class(TCustomVirtualStringTree) - private - - function GetOptions: TStringTreeOptions; - procedure SetOptions(const Value: TStringTreeOptions); - protected - function GetOptionsClass: TTreeOptionsClass; override; - public - - property Canvas; - property RangeX; - property LastDragEffect; - property CheckImageKind; // should no more be published to make #622 fix working - published - property AccessibleName; - property Action; - property Align; - property Alignment; - property Anchors; - property AnimationDuration; - property AutoExpandDelay; - property AutoScrollDelay; - property AutoScrollInterval; - property Background; - property BackGroundImageTransparent; - property BackgroundOffsetX; - property BackgroundOffsetY; - property BiDiMode; - property BevelEdges; - property BevelInner; - property BevelOuter; - property BevelKind; - property BevelWidth; - property BorderStyle; - property BottomSpace; - property ButtonFillMode; - property ButtonStyle; - property BorderWidth; - property ChangeDelay; - property ClipboardFormats; - property Color; - property Colors; - property Constraints; - property Ctl3D; - property CustomCheckImages; - property DefaultNodeHeight; - property DefaultPasteMode; - property DefaultText; - property DragCursor; - property DragHeight; - property DragKind; - property DragImageKind; - property DragMode; - property DragOperations; - property DragType; - property DragWidth; - property DrawSelectionMode; - property EditDelay; - property EmptyListMessage; - property Enabled; - property Font; - property Header; - property HintMode; - property HotCursor; - property Images; - property IncrementalSearch; - property IncrementalSearchDirection; - property IncrementalSearchStart; - property IncrementalSearchTimeout; - property Indent; - property LineMode; - property LineStyle; - property Margin; - property NodeAlignment; - property NodeDataSize; - property OperationCanceled; - property ParentBiDiMode; - property ParentColor default False; - property ParentCtl3D; - property ParentFont; - property ParentShowHint; - property PopupMenu; - property RootNodeCount; - property ScrollBarOptions; - property SelectionBlendFactor; - property SelectionCurveRadius; - property ShowHint; - property StateImages; - property StyleElements; - property TabOrder; - property TabStop default True; - property TextMargin; - property TreeOptions: TStringTreeOptions read GetOptions write SetOptions; - property Visible; - property WantTabs; + property BottomSpace; + property ButtonFillMode; + property ButtonStyle; + property BorderWidth; + property ChangeDelay; + property ClipboardFormats; + property Color; + property Colors; + property Constraints; + property Ctl3D; + property CustomCheckImages; + property DefaultNodeHeight; + property DefaultPasteMode; + property DefaultText; + property DragCursor; + property DragHeight; + property DragKind; + property DragImageKind; + property DragMode; + property DragOperations; + property DragType; + property DragWidth; + property DrawSelectionMode; + property EditDelay; + property EmptyListMessage; + property Enabled; + property Font; + property Header; + property HintMode; + property HotCursor; + property Images; + property IncrementalSearch; + property IncrementalSearchDirection; + property IncrementalSearchStart; + property IncrementalSearchTimeout; + property Indent; + property LineMode; + property LineStyle; + property Margin; + property NodeAlignment; + property NodeDataSize; + property OperationCanceled; + property ParentBiDiMode; + property ParentColor default False; + property ParentCtl3D; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property RootNodeCount; + property ScrollBarOptions; + property SelectionBlendFactor; + property SelectionCurveRadius; + property ShowHint; + property StateImages; + property StyleElements; + {$if CompilerVersion >= 34}property StyleName;{$ifend} + property TabOrder; + property TabStop default True; + property TextMargin; + property TreeOptions: TStringTreeOptions read GetOptions write SetOptions; + property Visible; + property WantTabs; property OnAddToSelection; property OnAdvancedHeaderDraw; @@ -3610,11 +472,14 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property OnCanSplitterResizeHeader; property OnCanSplitterResizeNode; property OnChange; + property OnChangeCell; property OnChecked; property OnChecking; property OnClick; property OnCollapsed; property OnCollapsing; + property OnColumnChecked; + property OnColumnChecking; property OnColumnClick; property OnColumnDblClick; property OnColumnExport; @@ -3633,6 +498,7 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property OnDragDrop; property OnDrawHint; property OnDrawText; + property OnDrawTextEx; property OnEditCancelled; property OnEdited; property OnEditing; @@ -3714,29431 +580,67 @@ TVirtualStringTree = class(TCustomVirtualStringTree) property OnSaveNode; property OnSaveTree; property OnScroll; - property OnShortenString; - property OnShowScrollBar; - property OnBeforeGetCheckState; - property OnStartDock; - property OnStartDrag; - property OnStartOperation; - property OnStateChange; - property OnStructureChange; - property OnUpdating; - property OnCanResize; - property OnGesture; - property Touch; - end; - - TVTDrawNodeEvent = procedure(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo) of object; - TVTGetCellContentMarginEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; - Column: TColumnIndex; CellContentMarginType: TVTCellContentMarginType; var CellContentMargin: TPoint) of object; - TVTGetNodeWidthEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; - Column: TColumnIndex; var NodeWidth: Integer) of object; - - // Tree descendant to let an application draw its stuff itself. - TCustomVirtualDrawTree = class(TBaseVirtualTree) - private - FOnDrawNode: TVTDrawNodeEvent; - FOnGetCellContentMargin: TVTGetCellContentMarginEvent; - FOnGetNodeWidth: TVTGetNodeWidthEvent; - protected - function DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; - CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; override; - function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; override; - procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override; - function GetDefaultHintKind: TVTHintKind; override; - - property OnDrawNode: TVTDrawNodeEvent read FOnDrawNode write FOnDrawNode; - property OnGetCellContentMargin: TVTGetCellContentMarginEvent read FOnGetCellContentMargin write FOnGetCellContentMargin; - property OnGetNodeWidth: TVTGetNodeWidthEvent read FOnGetNodeWidth write FOnGetNodeWidth; - end; - - [ComponentPlatformsAttribute(pidWin32 or pidWin64)] - TVirtualDrawTree = class(TCustomVirtualDrawTree) - private - function GetOptions: TVirtualTreeOptions; - procedure SetOptions(const Value: TVirtualTreeOptions); - protected - function GetOptionsClass: TTreeOptionsClass; override; - public - property Canvas; - property LastDragEffect; - property CheckImageKind; // should no more be published to make #622 fix working - published - property Action; - property Align; - property Alignment; - property Anchors; - property AnimationDuration; - property AutoExpandDelay; - property AutoScrollDelay; - property AutoScrollInterval; - property Background; - property BackgroundOffsetX; - property BackgroundOffsetY; - property BiDiMode; - property BevelEdges; - property BevelInner; - property BevelOuter; - property BevelKind; - property BevelWidth; - property BorderStyle; - property BottomSpace; - property ButtonFillMode; - property ButtonStyle; - property BorderWidth; - property ChangeDelay; - property ClipboardFormats; - property Color; - property Colors; - property Constraints; - property Ctl3D; - property CustomCheckImages; - property DefaultNodeHeight; - property DefaultPasteMode; - property DragCursor; - property DragHeight; - property DragKind; - property DragImageKind; - property DragMode; - property DragOperations; - property DragType; - property DragWidth; - property DrawSelectionMode; - property EditDelay; - property Enabled; - property Font; - property Header; - property HintMode; - property HotCursor; - property Images; - property IncrementalSearch; - property IncrementalSearchDirection; - property IncrementalSearchStart; - property IncrementalSearchTimeout; - property Indent; - property LineMode; - property LineStyle; - property Margin; - property NodeAlignment; - property NodeDataSize; - property OperationCanceled; - property ParentBiDiMode; - property ParentColor default False; - property ParentCtl3D; - property ParentFont; - property ParentShowHint; - property PopupMenu; - property RootNodeCount; - property ScrollBarOptions; - property SelectionBlendFactor; - property SelectionCurveRadius; - property ShowHint; - property StateImages; - property TabOrder; - property TabStop default True; - property TextMargin; - property TreeOptions: TVirtualTreeOptions read GetOptions write SetOptions; - property Visible; - property WantTabs; - - property OnAddToSelection; - property OnAdvancedHeaderDraw; - property OnAfterAutoFitColumn; - property OnAfterAutoFitColumns; - property OnAfterCellPaint; - property OnAfterColumnExport; - property OnAfterColumnWidthTracking; - property OnAfterGetMaxColumnWidth; - property OnAfterHeaderExport; - property OnAfterHeaderHeightTracking; - property OnAfterItemErase; - property OnAfterItemPaint; - property OnAfterNodeExport; - property OnAfterPaint; - property OnAfterTreeExport; - property OnBeforeAutoFitColumn; - property OnBeforeAutoFitColumns; - property OnBeforeCellPaint; - property OnBeforeColumnExport; - property OnBeforeColumnWidthTracking; - property OnBeforeDrawTreeLine; - property OnBeforeGetMaxColumnWidth; - property OnBeforeHeaderExport; - property OnBeforeHeaderHeightTracking; - property OnBeforeItemErase; - property OnBeforeItemPaint; - property OnBeforeNodeExport; - property OnBeforePaint; - property OnBeforeTreeExport; - property OnCanSplitterResizeColumn; - property OnCanSplitterResizeHeader; - property OnCanSplitterResizeNode; - property OnChange; - property OnChecked; - property OnChecking; - property OnClick; - property OnCollapsed; - property OnCollapsing; - property OnColumnClick; - property OnColumnDblClick; - property OnColumnExport; - property OnColumnResize; - property OnColumnVisibilityChanged; - property OnColumnWidthDblClickResize; - property OnColumnWidthTracking; - property OnCompareNodes; - property OnContextPopup; - property OnCreateDataObject; - property OnCreateDragManager; - property OnCreateEditor; - property OnDblClick; - property OnDragAllowed; - property OnDragOver; - property OnDragDrop; - property OnDrawHint; - property OnDrawNode; - property OnEdited; - property OnEditing; - property OnEndDock; - property OnEndDrag; - property OnEndOperation; - property OnEnter; - property OnExit; - property OnExpanded; - property OnExpanding; - property OnFocusChanged; - property OnFocusChanging; - property OnFreeNode; - property OnGetCellIsEmpty; - property OnGetCursor; - property OnGetHeaderCursor; - property OnGetHelpContext; - property OnGetHintKind; - property OnGetHintSize; - property OnGetImageIndex; - property OnGetImageIndexEx; - property OnGetLineStyle; - property OnGetNodeDataSize; - property OnGetNodeWidth; - property OnGetPopupMenu; - property OnGetUserClipboardFormats; - property OnHeaderAddPopupItem; - property OnHeaderClick; - property OnHeaderDblClick; - property OnHeaderDragged; - property OnHeaderDraggedOut; - property OnHeaderDragging; - property OnHeaderDraw; - property OnHeaderDrawQueryElements; - property OnHeaderHeightTracking; - property OnHeaderHeightDblClickResize; - property OnHeaderMouseDown; - property OnHeaderMouseMove; - property OnHeaderMouseUp; - property OnHotChange; - property OnIncrementalSearch; - property OnInitChildren; - property OnInitNode; - property OnKeyAction; - property OnKeyDown; - property OnKeyPress; - property OnKeyUp; - property OnLoadNode; - property OnLoadTree; - property OnMeasureItem; - property OnMouseDown; - property OnMouseMove; - property OnMouseUp; - property OnMouseWheel; - property OnNodeClick; - property OnNodeCopied; - property OnNodeCopying; - property OnNodeDblClick; - property OnNodeExport; - property OnNodeHeightTracking; - property OnNodeHeightDblClickResize; - property OnNodeMoved; - property OnNodeMoving; - property OnPaintBackground; - property OnPrepareButtonBitmaps; - property OnRemoveFromSelection; - property OnRenderOLEData; - property OnResetNode; - property OnResize; - property OnSaveNode; - property OnSaveTree; - property OnScroll; - property OnShowScrollBar; - property OnStartDock; - property OnStartDrag; - property OnStartOperation; - property OnStateChange; - property OnStructureChange; - property OnUpdating; - property OnCanResize; - property OnGesture; - property Touch; - property StyleElements; - end; - - - -// utility routines -function TreeFromNode(Node: PVirtualNode): TBaseVirtualTree; - -//---------------------------------------------------------------------------------------------------------------------- - -implementation - -{$R VirtualTrees.res} - -uses - Vcl.Consts, - System.Math, - Vcl.AxCtrls, // TOLEStream - Winapi.MMSystem, // for animation timer (does not include further resources) - System.TypInfo, // for migration stuff - System.SyncObjs, - Vcl.ActnList, - Vcl.StdActns, // for standard action support - System.StrUtils, - Vcl.GraphUtil, // accessibility helper class - VirtualTrees.AccessibilityFactory, - VirtualTrees.StyleHooks, - VirtualTrees.Classes, - VirtualTrees.WorkerThread, - VirtualTrees.ClipBoard, - VirtualTrees.Utils, - VirtualTrees.Export, - VirtualTrees.HeaderPopup; - -resourcestring - // Localizable strings. - SEditLinkIsNil = 'Edit link must not be nil.'; - SWrongMoveError = 'Target node cannot be a child node of the node to be moved.'; - SWrongStreamFormat = 'Unable to load tree structure, the format is wrong.'; - SWrongStreamVersion = 'Unable to load tree structure, the version is unknown.'; - SStreamTooSmall = 'Unable to load tree structure, not enough data available.'; - SCorruptStream1 = 'Stream data corrupt. A node''s anchor chunk is missing.'; - SCorruptStream2 = 'Stream data corrupt. Unexpected data after node''s end position.'; - SClipboardFailed = 'Clipboard operation failed.'; - -const - ClipboardStates = [tsCopyPending, tsCutPending]; - DefaultScrollUpdateFlags = [suoRepaintHeader, suoRepaintScrollBars, suoScrollClientArea, suoUpdateNCArea]; - TreeNodeSize = (SizeOf(TVirtualNode) + (SizeOf(Pointer) - 1)) and not (SizeOf(Pointer) - 1); // used for node allocation and access to internal data - /// Default value of the DefaultText property - cDefaultText = 'Node'; - MouseButtonDown = [tsLeftButtonDown, tsMiddleButtonDown, tsRightButtonDown]; - - // Do not modify the copyright in any way! Usage of this unit is prohibited without the copyright notice - // in the compiled binary file. - Copyright: string = 'Virtual Treeview © 1999, 2010, 2016 Mike Lischke, Joachim Marder'; - -var - StandardOLEFormat: TFormatEtc = ( - // Format must later be set. - cfFormat: 0; - // No specific target device to render on. - ptd: nil; - // Normal content to render. - dwAspect: DVASPECT_CONTENT; - // No specific page of multipage data (we don't use multipage data by default). - lindex: -1; - // Acceptable storage formats are IStream and global memory. The first is preferred. - tymed: TYMED_ISTREAM or TYMED_HGLOBAL; - ); - -type - // protection against TRect record method that cause problems with with-statements - TWithSafeRect = record - case Integer of - 0: (Left, Top, Right, Bottom: Integer); - 1: (TopLeft, BottomRight: TPoint); - end; - -type // streaming support - TMagicID = array[0..5] of WideChar; - - TChunkHeader = record - ChunkType, - ChunkSize: Integer; // contains the size of the chunk excluding the header - end; - - // base information about a node - TBaseChunkBody = packed record - ChildCount, - NodeHeight: Cardinal; - States: TVirtualNodeStates; - Align: Byte; - CheckState: TCheckState; - CheckType: TCheckType; - Reserved: Cardinal; - end; - - TBaseChunk = packed record - Header: TChunkHeader; - Body: TBaseChunkBody; - end; - - // Toggle animation modes. - TToggleAnimationMode = ( - tamScrollUp, - tamScrollDown, - tamNoScroll - ); - - // Internally used data for animations. - TToggleAnimationData = record - Window: HWND; // copy of the tree's window handle - DC: HDC; // the DC of the window to erase uncovered parts - Brush: HBRUSH; // the brush to be used to erase uncovered parts - R1, - R2: TRect; // animation rectangles - Mode1, - Mode2: TToggleAnimationMode; // animation modes - ScaleFactor: Double; // the factor between the missing step size when doing two animations - MissedSteps: Double; - end; - - TCanvasEx = class(TCanvas); - -const - MagicID: TMagicID = (#$2045, 'V', 'T', WideChar(VTTreeStreamVersion), ' ', #$2046); - - // chunk IDs - NodeChunk = 1; - BaseChunk = 2; // chunk containing node state, check state, child node count etc. - // this chunk is immediately followed by all child nodes - CaptionChunk = 3; // used by the string tree to store a node's caption - UserChunk = 4; // used for data supplied by the application - - RTLFlag: array[Boolean] of Integer = (0, ETO_RTLREADING); - AlignmentToDrawFlag: array[TAlignment] of Cardinal = (DT_LEFT, DT_RIGHT, DT_CENTER); - - WideCR = Char(#13); - WideLF = Char(#10); - -var - gWatcher: TCriticalSection = nil; - gInitialized: Integer = 0; // >0 if global structures have been initialized; otherwise 0 - NeedToUnitialize: Boolean = False; // True if the OLE subsystem could be initialized successfully. - - -//---------------------------------------------------------------------------------------------------------------------- - -procedure ShowError(const Msg: string; HelpContext: Integer); - -begin - raise EVirtualTreeError.CreateHelp(Msg, HelpContext); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TreeFromNode(Node: PVirtualNode): TBaseVirtualTree; - -// Returns the tree the node currently belongs to or nil if the node is not attached to a tree. - -begin - Assert(Assigned(Node), 'Node must not be nil.'); - - // The root node is marked by having its NextSibling (and PrevSibling) pointing to itself. - while Assigned(Node) and (Node.NextSibling <> Node) do - Node := Node.Parent; - if Assigned(Node) then - Result := TBaseVirtualTree(Node.Parent) - else - Result := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - - -procedure QuickSort(const TheArray: TNodeArray; L, R: Integer); - -var - I, J: Integer; - P, T: Pointer; - -begin - repeat - I := L; - J := R; - P := TheArray[(L + R) shr 1]; - repeat - while PAnsiChar(TheArray[I]) < PAnsiChar(P) do - Inc(I); - while PAnsiChar(TheArray[J]) > PAnsiChar(P) do - Dec(J); - if I <= J then - begin - T := TheArray[I]; - TheArray[I] := TheArray[J]; - TheArray[J] := T; - Inc(I); - Dec(J); - end; - until I > J; - if L < J then - QuickSort(TheArray, L, J); - L := I; - until I >= R; -end; - - -//---------------------------------------------------------------------------------------------------------------------- - - - - -const - Grays: array[0..3] of TColor = (clWhite, clSilver, clGray, clBlack); - SysGrays: array[0..3] of TColor = (clWindow, clBtnFace, clBtnShadow, clBtnText); - -procedure ConvertImageList(IL: TImageList; const ImageName: string; ColorRemapping: Boolean = True); - -// Loads a bunch of images given by ImageName into IL. If ColorRemapping = True then a mapping of gray values to -// system colors is performed. - -var - lImages, - lOneImage: TBitmap; - I: Integer; - MaskColor: TColor; - Source, - Dest: TRect; - -begin - gWatcher.Enter(); - try - // Since we want the image list appearing in the correct system colors, we have to remap its colors. - lImages := TBitmap.Create; - lOneImage := TBitmap.Create; - if ColorRemapping then - lImages.Handle := CreateMappedRes(FindClassHInstance(TBaseVirtualTree), PChar(ImageName), Grays, SysGrays) - else - lImages.Handle := LoadBitmap(FindClassHInstance(TBaseVirtualTree), PChar(ImageName)); - - try - Assert(lImages.Height > 0, 'Internal image "' + ImageName + '" is missing or corrupt.'); - if lImages.Height = 0 then - Exit;// This should never happen, it prevents a division by zero exception below in the for loop, which we have seen in a few cases - // It is assumed that the image height determines also the width of one entry in the image list. - IL.Clear; - IL.Height := lImages.Height; - IL.Width := lImages.Height; - lOneImage.Width := IL.Width; - lOneImage.Height := IL.Height; - MaskColor := lImages.Canvas.Pixels[0, 0]; // this is usually clFuchsia - Dest := Rect(0, 0, IL.Width, IL.Height); - for I := 0 to (lImages.Width div lImages.Height) - 1 do - begin - Source := Rect(I * IL.Width, 0, (I + 1) * IL.Width, IL.Height); - lOneImage.Canvas.CopyRect(Dest, lImages.Canvas, Source); - IL.AddMasked(lOneImage, MaskColor); - end; - finally - lImages.Free; - lOneImage.Free; - end; - finally - gWatcher.Leave(); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function CreateSystemImageSet(pControl: TWinControl): TImageList; - -// Creates a system check image set. -// Note: the DarkCheckImages and FlatImages image lists must already be filled, as some images from them are copied here. - -const - MaskColor: TColor = clRed; - cFlags = ILC_COLOR32 or ILC_MASK; - -var - BM: TBitmap; - Theme: HTHEME; - Details: TThemedElementDetails; - - //--------------------------------------------------------------------------- - - procedure AddSystemImage(IL: TImageList; Index: Integer); - const - States: array [0..19] of Integer = ( - RBS_UNCHECKEDNORMAL, RBS_UNCHECKEDHOT, RBS_UNCHECKEDPRESSED, RBS_UNCHECKEDDISABLED, - RBS_CHECKEDNORMAL, RBS_CHECKEDHOT, RBS_CHECKEDPRESSED, RBS_CHECKEDDISABLED, - CBS_UNCHECKEDNORMAL, CBS_UNCHECKEDHOT, CBS_UNCHECKEDPRESSED, CBS_UNCHECKEDDISABLED, - CBS_CHECKEDNORMAL, CBS_CHECKEDHOT, CBS_CHECKEDPRESSED, CBS_CHECKEDDISABLED, - CBS_MIXEDNORMAL, CBS_MIXEDHOT, CBS_MIXEDPRESSED, CBS_MIXEDDISABLED); - var - ButtonState: Cardinal; - ButtonType: Cardinal; - - begin - BM.Canvas.FillRect(Rect(0, 0, BM.Width, BM.Height)); - if StyleServices.Enabled and StyleServices.IsSystemStyle then - begin - if Index < 8 then - Details.Part := BP_RADIOBUTTON - else - Details.Part := BP_CHECKBOX; - Details.State := States[Index]; - DrawThemeBackground(Theme, BM.Canvas.Handle, Details.Part, Details.State, Rect(0, 0, BM.Width, BM.Height), nil); - end - else - begin - if Index < 8 then - ButtonType := DFCS_BUTTONRADIO - else - ButtonType := DFCS_BUTTONCHECK; - if Index >= 16 then - ButtonType := ButtonType or DFCS_BUTTON3STATE; - - case Index mod 4 of - 0: - ButtonState := 0; - 1: - ButtonState := DFCS_HOT; - 2: - ButtonState := DFCS_PUSHED; - else - ButtonState := DFCS_INACTIVE; - end; - if Index in [4..7, 12..19] then - ButtonState := ButtonState or DFCS_CHECKED; -// if Flat then -// ButtonState := ButtonState or DFCS_FLAT; - DrawFrameControl(BM.Canvas.Handle, Rect(0, 0, BM.Width, BM.Height), DFC_BUTTON, ButtonType or ButtonState); - end; - IL.AddMasked(BM, MaskColor); - end; - - //--------------- end local functions --------------------------------------- - -var - I: Integer; - lSize: TSize; - Res: Boolean; -begin - BM := TBitmap.Create; // Create a temporary bitmap, which holds the intermediate images. - try - Res := False; - // Retrieve the checkbox image size, prefer theme if available, fall back to GetSystemMetrics() otherwise, but this returns odd results on Windows 8 and higher in high-dpi scenarios. - if StyleServices.Enabled then - if StyleServices.IsSystemStyle then - begin - if Assigned(pControl) then - Theme := OpenThemeData(pControl.Handle, 'BUTTON') - else - Theme := OpenThemeData(Application.Handle, 'BUTTON'); - Details := StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal); - Res := GetThemePartSize(Theme, BM.Canvas.Handle, Details.Part, Details.State, nil, TS_TRUE, lSize) = S_OK; - end - else - Res := StyleServices.GetElementSize(BM.Canvas.Handle, StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal), TElementSize.esActual, lSize); - if not Res then - lSize := TSize.Create(GetSystemMetrics(SM_CXMENUCHECK), GetSystemMetrics(SM_CYMENUCHECK)); - - Result := TImageList.CreateSize(lSize.cx, lSize.cy); - with Result do - Handle := ImageList_Create(Width, Height, cFlags, 0, AllocBy); - Result.Masked := True; - Result.BkColor := clWhite; - - // Make the bitmap the same size as the image list is to avoid problems when adding. - BM.SetSize(Result.Width, Result.Height); - BM.Canvas.Brush.Color := MaskColor; - BM.Canvas.Brush.Style := bsSolid; - BM.Canvas.FillRect(Rect(0, 0, BM.Width, BM.Height)); - Result.AddMasked(BM, MaskColor); - - // Add the 20 system checkbox and radiobutton images. - for I := 0 to 19 do - AddSystemImage(Result, I); - if StyleServices.Enabled and StyleServices.IsSystemStyle then - CloseThemeData(Theme); - - finally - BM.Free; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - - - - - -procedure InitializeGlobalStructures(); - -// initialization of stuff global to the unit -begin - if (gInitialized > 0) or (InterlockedIncrement(gInitialized) <> 1) then // Ensure threadsafe that this code is executed only once - exit; - - // This watcher is used whenever a global structure could be modified by more than one thread. - gWatcher := TCriticalSection.Create(); - - IsWinVistaOrAbove := (Win32MajorVersion >= 6); - - // 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. - CF_VTREFERENCE := RegisterClipboardFormat(CFSTR_VTREFERENCE); - - // Delphi (at least version 6 and lower) does not provide a standard split cursor. - // Hence we have to load our own. - Screen.Cursors[crHeaderSplit] := LoadCursor(HInstance, 'VT_HEADERSPLIT'); - Screen.Cursors[crVertSplit] := LoadCursor(HInstance, 'VT_VERTSPLIT'); - - // Clipboard format registration. - // Native clipboard format. Needs a new identifier and has an average priority to allow other formats to take over. - // This format is supposed to use the IStream storage format but unfortunately this does not work when - // OLEFlushClipboard is used. Hence it is disabled until somebody finds a solution. - CF_VIRTUALTREE := RegisterVTClipboardFormat(CFSTR_VIRTUALTREE, TBaseVirtualTree, 50, TYMED_HGLOBAL {or TYMED_ISTREAM}); - // Specialized string tree formats. - CF_HTML := RegisterVTClipboardFormat(CFSTR_HTML, TCustomVirtualStringTree, 80); - CF_VRTFNOOBJS := RegisterVTClipboardFormat(CFSTR_RTFNOOBJS, TCustomVirtualStringTree, 84); - CF_VRTF := RegisterVTClipboardFormat(CFSTR_RTF, TCustomVirtualStringTree, 85); - CF_CSV := RegisterVTClipboardFormat(CFSTR_CSV, TCustomVirtualStringTree, 90); - // Predefined clipboard formats. Just add them to the internal list. - RegisterVTClipboardFormat(CF_TEXT, TCustomVirtualStringTree, 100); - RegisterVTClipboardFormat(CF_UNICODETEXT, TCustomVirtualStringTree, 95); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure FinalizeGlobalStructures(); - -var - HintWasEnabled: Boolean; - -begin - if gInitialized = 0 then - exit; // Was not initialized - - if NeedToUnitialize then - OleUninitialize; - - // If VT is used in a package and its special hint window was used then the last instance of this - // window is not freed correctly (bug in the VCL). We explicitely tell the application to free it - // otherwise an AV is raised due to access to an invalid memory area. - if ModuleIsPackage then - begin - HintWasEnabled := Application.ShowHint; - Application.ShowHint := False; - if HintWasEnabled then - Application.ShowHint := True; - end; - gWatcher.Free; - gWatcher := nil; -end; - - - - -//----------------- TCustomVirtualTreeOptions -------------------------------------------------------------------------- - -constructor TCustomVirtualTreeOptions.Create(AOwner: TBaseVirtualTree); - -begin - FOwner := AOwner; - - FPaintOptions := DefaultPaintOptions; - FAnimationOptions := DefaultAnimationOptions; - FAutoOptions := DefaultAutoOptions; - FSelectionOptions := DefaultSelectionOptions; - FMiscOptions := DefaultMiscOptions; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TCustomVirtualTreeOptions.SetAnimationOptions(const Value: TVTAnimationOptions); - -begin - FAnimationOptions := Value; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TCustomVirtualTreeOptions.SetAutoOptions(const Value: TVTAutoOptions); - -var - ChangedOptions: TVTAutoOptions; - -begin - if FAutoOptions <> Value then - begin - // Exclusive ORing to get all entries wich are in either set but not in both. - ChangedOptions := FAutoOptions + Value - (FAutoOptions * Value); - FAutoOptions := Value; - with FOwner do - if (toAutoSpanColumns in ChangedOptions) and not (csLoading in ComponentState) and HandleAllocated then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TCustomVirtualTreeOptions.SetMiscOptions(const Value: TVTMiscOptions); - -var - ToBeSet, - ToBeCleared: TVTMiscOptions; - -begin - if FMiscOptions <> Value then - begin - ToBeSet := Value - FMiscOptions; - ToBeCleared := FMiscOptions - Value; - FMiscOptions := Value; - - with FOwner do - if not (csLoading in ComponentState) and HandleAllocated then - begin - if toCheckSupport in ToBeSet + ToBeCleared then - Invalidate; - if toEditOnDblClick in ToBeSet then - FMiscOptions := FMiscOptions - [toToggleOnDblClick]; // In order for toEditOnDblClick to take effect, we need to remove toToggleOnDblClick which is handled with priority. See issue #747 - - 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(); - try - ReInitNode(nil, True); - finally - EndUpdate(); - end;//try..finally - end;//if toVariableNodeHeight - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TCustomVirtualTreeOptions.SetPaintOptions(const Value: TVTPaintOptions); - -var - ToBeSet, - ToBeCleared: TVTPaintOptions; - Run: PVirtualNode; - HandleWasAllocated: Boolean; - -begin - if FPaintOptions <> Value then - begin - ToBeSet := Value - FPaintOptions; - ToBeCleared := FPaintOptions - Value; - FPaintOptions := Value; - if (toFixedIndent in ToBeSet) then - begin - // Fixes issue #388 - Include(FPaintOptions, toShowRoot); - Include(ToBeSet, toShowRoot); - end;//if - with FOwner do - begin - HandleWasAllocated := HandleAllocated; - - if not (csLoading in ComponentState) and (toShowFilteredNodes in ToBeSet + ToBeCleared) then - begin - if HandleWasAllocated then - BeginUpdate; - InterruptValidation; - Run := GetFirstNoInit; - while Assigned(Run) do - begin - if (vsFiltered in Run.States) then - begin - if FullyVisible[Run] then - begin - if toShowFilteredNodes in ToBeSet then - Inc(FVisibleCount) - else - Dec(FVisibleCount); - end; - if toShowFilteredNodes in ToBeSet then - AdjustTotalHeight(Run, Run.NodeHeight, True) - else - AdjustTotalHeight(Run, -Run.NodeHeight, True); - end; - Run := GetNextNoInit(Run); - end; - if HandleWasAllocated then - EndUpdate; - end; - - if HandleAllocated then - begin - if IsWinVistaOrAbove and ((tsUseThemes in FStates) or - ((toThemeAware in ToBeSet) and StyleServices.Enabled)) and - (toUseExplorerTheme in (ToBeSet + ToBeCleared)) and not VclStyleEnabled then - begin - if (toUseExplorerTheme in ToBeSet) then - begin - SetWindowTheme('explorer'); - DoStateChange([tsUseExplorerTheme]); - end - else - if toUseExplorerTheme in ToBeCleared then - begin - SetWindowTheme(''); - DoStateChange([], [tsUseExplorerTheme]); - end; - end; - - if not (csLoading in ComponentState) then - begin - if ((toThemeAware in ToBeSet + ToBeCleared) or (toUseExplorerTheme in ToBeSet + ToBeCleared) or VclStyleEnabled) then - begin - if ((toThemeAware in ToBeSet) and StyleServices.Enabled) then - DoStateChange([tsUseThemes]) - else - if (toThemeAware in ToBeCleared) then - DoStateChange([], [tsUseThemes]); - - PrepareBitmaps(True, False); - RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_VALIDATE or RDW_FRAME); - end; - - if toChildrenAbove in ToBeSet + ToBeCleared then - begin - InvalidateCache; - if FUpdateCount = 0 then - begin - ValidateCache; - Invalidate; - end; - end; - - Invalidate; - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TCustomVirtualTreeOptions.SetSelectionOptions(const Value: TVTSelectionOptions); - -var - ToBeSet, - ToBeCleared: TVTSelectionOptions; - -begin - if FSelectionOptions <> Value then - begin - ToBeSet := Value - FSelectionOptions; - ToBeCleared := FSelectionOptions - Value; - FSelectionOptions := Value; - - with FOwner do - begin - if (toMultiSelect in (ToBeCleared + ToBeSet)) or - ([toLevelSelectConstraint, toSiblingSelectConstraint] * ToBeSet <> []) then - ClearSelection; - - if (toExtendedFocus in ToBeCleared) and (FFocusedColumn > 0) and HandleAllocated then - begin - FFocusedColumn := FHeader.MainColumn; - Invalidate; - end; - - if not (toExtendedFocus in FSelectionOptions) then - FFocusedColumn := FHeader.MainColumn; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TCustomVirtualTreeOptions.AssignTo(Dest: TPersistent); - -begin - if Dest is TCustomVirtualTreeOptions then - begin - with Dest as TCustomVirtualTreeOptions do - begin - PaintOptions := Self.PaintOptions; - AnimationOptions := Self.AnimationOptions; - AutoOptions := Self.AutoOptions; - SelectionOptions := Self.SelectionOptions; - MiscOptions := Self.MiscOptions; - end; - end - else - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -// OLE drag and drop support classes -// This is quite heavy stuff (compared with the VCL implementation) but is much better suited to fit the needs -// of DD'ing various kinds of virtual data and works also between applications. - -//----------------- TEnumFormatEtc ------------------------------------------------------------------------------------- - -constructor TEnumFormatEtc.Create(Tree: TBaseVirtualTree; const AFormatEtcArray: TFormatEtcArray); - -var - I: Integer; - -begin - inherited Create; - - FTree := Tree; - // Make a local copy of the format data. - SetLength(FFormatEtcArray, Length(AFormatEtcArray)); - for I := 0 to High(AFormatEtcArray) do - FFormatEtcArray[I] := AFormatEtcArray[I]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TEnumFormatEtc.Clone(out Enum: IEnumFormatEtc): HResult; - -var - AClone: TEnumFormatEtc; - -begin - Result := S_OK; - try - AClone := TEnumFormatEtc.Create(nil, FFormatEtcArray); - AClone.FCurrentIndex := FCurrentIndex; - Enum := AClone as IEnumFormatEtc; - except - Result := E_FAIL; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TEnumFormatEtc.Next(celt: Integer; out elt; pceltFetched: PLongint): HResult; - -var - CopyCount: Integer; - -begin - Result := S_FALSE; - CopyCount := Length(FFormatEtcArray) - FCurrentIndex; - if celt < CopyCount then - CopyCount := celt; - if CopyCount > 0 then - begin - Move(FFormatEtcArray[FCurrentIndex], elt, CopyCount * SizeOf(TFormatEtc)); - Inc(FCurrentIndex, CopyCount); - Result := S_OK; - end; - if Assigned(pceltFetched) then - pceltFetched^ := CopyCount; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TEnumFormatEtc.Reset: HResult; - -begin - FCurrentIndex := 0; - Result := S_OK; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TEnumFormatEtc.Skip(celt: Integer): HResult; - -begin - if FCurrentIndex + celt < High(FFormatEtcArray) then - begin - Inc(FCurrentIndex, celt); - Result := S_Ok; - end - else - Result := S_FALSE; -end; - -//----------------- TVTDataObject -------------------------------------------------------------------------------------- - -constructor TVTDataObject.Create(AOwner: TBaseVirtualTree; ForClipboard: Boolean); - -begin - inherited Create; - - FOwner := AOwner; - FForClipboard := ForClipboard; - FOwner.GetNativeClipboardFormats(FFormatEtcArray); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -destructor TVTDataObject.Destroy; - -var - I: Integer; - StgMedium: PStgMedium; - -begin - // Cancel a pending clipboard operation if this data object was created for the clipboard and - // is freed because something else is placed there. - if FForClipboard and not (tsClipboardFlushing in FOwner.FStates) then - FOwner.CancelCutOrCopy; - - // Release any internal clipboard formats - for I := 0 to High(FormatEtcArray) do - begin - StgMedium := FindInternalStgMedium(FormatEtcArray[I].cfFormat); - if Assigned(StgMedium) then - ReleaseStgMedium(StgMedium^); - end; - - FormatEtcArray := nil; - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.CanonicalIUnknown(const TestUnknown: IUnknown): IUnknown; - -// Uses COM object identity: An explicit call to the IUnknown::QueryInterface method, requesting the IUnknown -// interface, will always return the same pointer. - -begin - if Assigned(TestUnknown) then - begin - if TestUnknown.QueryInterface(IUnknown, Result) = 0 then - Result._Release // Don't actually need it just need the pointer value - else - Result := TestUnknown; - end - else - Result := TestUnknown; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.EqualFormatEtc(FormatEtc1, FormatEtc2: TFormatEtc): Boolean; - -begin - Result := (FormatEtc1.cfFormat = FormatEtc2.cfFormat) and (FormatEtc1.ptd = FormatEtc2.ptd) and - (FormatEtc1.dwAspect = FormatEtc2.dwAspect) and (FormatEtc1.lindex = FormatEtc2.lindex) and - (FormatEtc1.tymed and FormatEtc2.tymed <> 0); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.FindFormatEtc(TestFormatEtc: TFormatEtc; const FormatEtcArray: TFormatEtcArray): integer; - -var - I: integer; - -begin - Result := -1; - for I := 0 to High(FormatEtcArray) do - begin - if EqualFormatEtc(TestFormatEtc, FormatEtcArray[I]) then - begin - Result := I; - Break; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.FindInternalStgMedium(Format: TClipFormat): PStgMedium; - -var - I: integer; -begin - Result := nil; - for I := 0 to High(InternalStgMediumArray) do - begin - if Format = InternalStgMediumArray[I].Format then - begin - Result := @InternalStgMediumArray[I].Medium; - Break; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.HGlobalClone(HGlobal: THandle): THandle; - -// Returns a global memory block that is a copy of the passed memory block. - -var - Size: Cardinal; - Data, - NewData: PByte; - -begin - Size := GlobalSize(HGlobal); - Result := GlobalAlloc(GPTR, Size); - Data := GlobalLock(hGlobal); - try - NewData := GlobalLock(Result); - try - Move(Data^, NewData^, Size); - finally - GlobalUnLock(Result); - end; - finally - GlobalUnLock(hGlobal); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.RenderInternalOLEData(const FormatEtcIn: TFormatEtc; var Medium: TStgMedium; - var OLEResult: HResult): Boolean; - -// Tries to render one of the formats which have been stored via the SetData method. -// Since this data is already there it is just copied or its reference count is increased (depending on storage medium). - -var - InternalMedium: PStgMedium; - -begin - Result := True; - InternalMedium := FindInternalStgMedium(FormatEtcIn.cfFormat); - if Assigned(InternalMedium) then - OLEResult := StgMediumIncRef(InternalMedium^, Medium, False, Self as IDataObject) - else - Result := False; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.StgMediumIncRef(const InStgMedium: TStgMedium; var OutStgMedium: TStgMedium; - CopyInMedium: Boolean; const DataObject: IDataObject): HRESULT; - -// InStgMedium is the data that is requested, OutStgMedium is the data that we are to return either a copy of or -// increase the IDataObject's reference and send ourselves back as the data (unkForRelease). The InStgMedium is usually -// the result of a call to find a particular FormatEtc that has been stored locally through a call to SetData. -// If CopyInMedium is not true we already have a local copy of the data when the SetData function was called (during -// that call the CopyInMedium must be true). Then as the caller asks for the data through GetData we do not have to make -// copy of the data for the caller only to have them destroy it then need us to copy it again if necessary. -// This way we increase the reference count to ourselves and pass the STGMEDIUM structure initially stored in SetData. -// This way when the caller frees the structure it sees the unkForRelease is not nil and calls Release on the object -// instead of destroying the actual data. - -var - Len: Integer; - -begin - Result := S_OK; - - // Simply copy all fields to start with. - OutStgMedium := InStgMedium; - // The data handled here always results from a call of SetData we got. This ensures only one storage format - // is indicated and hence the case statement below is safe (IDataObject.GetData can optionally use several - // storage formats). - case InStgMedium.tymed of - TYMED_HGLOBAL: - begin - if CopyInMedium then - begin - // Generate a unique copy of the data passed - OutStgMedium.hGlobal := HGlobalClone(InStgMedium.hGlobal); - if OutStgMedium.hGlobal = 0 then - Result := E_OUTOFMEMORY; - end - else - // Don't generate a copy just use ourselves and the copy previously saved. - OutStgMedium.unkForRelease := Pointer(DataObject); // Does not increase RefCount. - end; - TYMED_FILE: - begin - Len := lstrLenW(InStgMedium.lpszFileName) + 1; // Don't forget the terminating null character. - OutStgMedium.lpszFileName := CoTaskMemAlloc(2 * Len); - Move(InStgMedium.lpszFileName^, OutStgMedium.lpszFileName^, 2 * Len); - end; - TYMED_ISTREAM: - IUnknown(OutStgMedium.stm)._AddRef; - TYMED_ISTORAGE: - IUnknown(OutStgMedium.stg)._AddRef; - TYMED_GDI: - if not CopyInMedium then - // Don't generate a copy just use ourselves and the previously saved data. - OutStgMedium.unkForRelease := Pointer(DataObject) // Does not increase RefCount. - else - Result := DV_E_TYMED; // Don't know how to copy GDI objects right now. - TYMED_MFPICT: - if not CopyInMedium then - // Don't generate a copy just use ourselves and the previously saved data. - OutStgMedium.unkForRelease := Pointer(DataObject) // Does not increase RefCount. - else - Result := DV_E_TYMED; // Don't know how to copy MetaFile objects right now. - TYMED_ENHMF: - if not CopyInMedium then - // Don't generate a copy just use ourselves and the previously saved data. - OutStgMedium.unkForRelease := Pointer(DataObject) // Does not increase RefCount. - else - Result := DV_E_TYMED; // Don't know how to copy enhanced metafiles objects right now. - else - Result := DV_E_TYMED; - end; - - if (Result = S_OK) and Assigned(OutStgMedium.unkForRelease) then - IUnknown(OutStgMedium.unkForRelease)._AddRef; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.DAdvise(const FormatEtc: TFormatEtc; advf: Integer; const advSink: IAdviseSink; - out dwConnection: Integer): HResult; - -// Advise sink management is greatly simplified by the IDataAdviseHolder interface. -// We use this interface and forward all concerning calls to it. - -begin - Result := S_OK; - if FAdviseHolder = nil then - Result := CreateDataAdviseHolder(FAdviseHolder); - if Result = S_OK then - Result := FAdviseHolder.Advise(Self as IDataObject, FormatEtc, advf, advSink, dwConnection); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.DUnadvise(dwConnection: Integer): HResult; - -begin - if FAdviseHolder = nil then - Result := E_NOTIMPL - else - Result := FAdviseHolder.Unadvise(dwConnection); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult; - -begin - if FAdviseHolder = nil then - Result := OLE_E_ADVISENOTSUPPORTED - else - Result := FAdviseHolder.EnumAdvise(enumAdvise); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.EnumFormatEtc(Direction: Integer; out EnumFormatEtc: IEnumFormatEtc): HResult; - -var - NewList: TEnumFormatEtc; - -begin - Result := E_FAIL; - if Direction = DATADIR_GET then - begin - NewList := TEnumFormatEtc.Create(FOwner, FormatEtcArray); - EnumFormatEtc := NewList as IEnumFormatEtc; - Result := S_OK; - end - else - EnumFormatEtc := nil; - if EnumFormatEtc = nil then - Result := OLE_S_USEREG; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.GetCanonicalFormatEtc(const FormatEtc: TFormatEtc; out FormatEtcOut: TFormatEtc): HResult; - -begin - Result := DATA_S_SAMEFORMATETC; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.GetData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium): HResult; - -// Data is requested by clipboard or drop target. This method dispatchs the call -// depending on the data being requested. - -var - I: Integer; - Data: PVTReference; - -begin - // The tree reference format is always supported and returned from here. - if FormatEtcIn.cfFormat = CF_VTREFERENCE 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. - if tsClipboardFlushing in FOwner.FStates then - Result := E_FAIL - else - begin - Medium.hGlobal := GlobalAlloc(GHND or GMEM_SHARE, SizeOf(TVTReference)); - Data := GlobalLock(Medium.hGlobal); - Data.Process := GetCurrentProcessID; - Data.Tree := FOwner; - GlobalUnlock(Medium.hGlobal); - Medium.tymed := TYMED_HGLOBAL; - Medium.unkForRelease := nil; - Result := 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 - begin - for I := 0 to High(FormatEtcArray) do - begin - if EqualFormatEtc(FormatEtcIn, FormatEtcArray[I]) then - begin - if not RenderInternalOLEData(FormatEtcIn, Medium, Result) then - Result := FOwner.RenderOLEData(FormatEtcIn, Medium, FForClipboard); - Break; - end; - end; - end; - except - ZeroMemory (@Medium, SizeOf(Medium)); - Result := E_FAIL; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.GetDataHere(const FormatEtc: TFormatEtc; out Medium: TStgMedium): HResult; - -begin - Result := E_NOTIMPL; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.QueryGetData(const FormatEtc: TFormatEtc): HResult; - -var - I: Integer; - -begin - Result := DV_E_CLIPFORMAT; - for I := 0 to High(FFormatEtcArray) do - begin - if FormatEtc.cfFormat = FFormatEtcArray[I].cfFormat then - begin - if (FormatEtc.tymed and FFormatEtcArray[I].tymed) <> 0 then - begin - if FormatEtc.dwAspect = FFormatEtcArray[I].dwAspect then - begin - if FormatEtc.lindex = FFormatEtcArray[I].lindex then - begin - Result := S_OK; - Break; - end - else - Result := DV_E_LINDEX; - end - else - Result := DV_E_DVASPECT; - end - else - Result := DV_E_TYMED; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDataObject.SetData(const FormatEtc: TFormatEtc; var Medium: TStgMedium; DoRelease: BOOL): HResult; - -// Allows dynamic adding to the IDataObject during its existance. Most noteably it is used to implement -// IDropSourceHelper and allows to set a special format for optimized moves during a shell transfer. - -var - Index: Integer; - LocalStgMedium: PStgMedium; - -begin - // See if we already have a format of that type available. - Index := FindFormatEtc(FormatEtc, FormatEtcArray); - if Index > - 1 then - begin - // Just use the TFormatEct in the array after releasing the data. - LocalStgMedium := FindInternalStgMedium(FormatEtcArray[Index].cfFormat); - if Assigned(LocalStgMedium) then - begin - ReleaseStgMedium(LocalStgMedium^); - ZeroMemory(LocalStgMedium, SizeOf(LocalStgMedium^)); - end; - end - else - begin - // It is a new format so create a new TFormatCollectionItem, copy the - // FormatEtc parameter into the new object and and put it in the list. - SetLength(FFormatEtcArray, Length(FormatEtcArray) + 1); - FormatEtcArray[High(FormatEtcArray)] := FormatEtc; - - // Create a new InternalStgMedium and initialize it and associate it with the format. - SetLength(FInternalStgMediumArray, Length(InternalStgMediumArray) + 1); - InternalStgMediumArray[High(InternalStgMediumArray)].Format := FormatEtc.cfFormat; - LocalStgMedium := @InternalStgMediumArray[High(InternalStgMediumArray)].Medium; - ZeroMemory(LocalStgMedium, SizeOf(LocalStgMedium^)); - end; - - if DoRelease then - begin - // We are simply being given the data and we take control of it. - LocalStgMedium^ := Medium; - Result := S_OK; - end - else - begin - // We need to reference count or copy the data and keep our own references to it. - Result := StgMediumIncRef(Medium, LocalStgMedium^, True, Self as IDataObject); - - // Can get a circular reference if the client calls GetData then calls SetData with the same StgMedium. - // Because the unkForRelease for the IDataObject can be marshalled it is necessary to get pointers that - // can be correctly compared. See the IDragSourceHelper article by Raymond Chen at MSDN. - if Assigned(LocalStgMedium.unkForRelease) then - begin - if CanonicalIUnknown(Self) = CanonicalIUnknown(IUnknown(LocalStgMedium.unkForRelease)) then - IUnknown(LocalStgMedium.unkForRelease) := nil; // release the interface - end; - end; - - // Tell all registered advice sinks about the data change. - if Assigned(FAdviseHolder) then - FAdviseHolder.SendOnDataChange(Self as IDataObject, 0, 0); -end; - -//----------------- TVTDragManager ------------------------------------------------------------------------------------- - -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; - -//---------------------------------------------------------------------------------------------------------------------- - -destructor TVTDragManager.Destroy; - -begin - // Set the owner's reference to us to nil otherwise it will access an invalid pointer - // after our desctruction is complete. - Pointer(FOwner.FDragManager) := nil; - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragManager.GetDataObject: IDataObject; - -begin - // When the owner tree starts a drag operation then it gets a data object here to pass it to the OLE subsystem. - // In this case there is no local reference to a data object and one is created (but not stored). - // If there is a local reference then the owner tree is currently the drop target and the stored interface is - // that of the drag initiator. - if Assigned(FDataObject) then - Result := FDataObject - else - begin - Result := FOwner.DoCreateDataObject; - if (Result = nil) and not Assigned(FOwner.OnCreateDataObject) then - // Do not create a TVTDataObject if the event handler explicitely decided not to supply one, issue #736. - Result := TVTDataObject.Create(FOwner, False) as IDataObject; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragManager.GetDragSource: TBaseVirtualTree; - -begin - Result := FDragSource; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragManager.GetDropTargetHelperSupported: Boolean; - -begin - Result := Assigned(FDropTargetHelper); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragManager.GetIsDropTarget: Boolean; - -begin - Result := FIsDropTarget; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragManager.DragEnter(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; - var Effect: Integer): HResult; - -begin - FDataObject := DataObject; - FIsDropTarget := True; - - SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @FFullDragging, 0); - // If full dragging of window contents is disabled in the system then our tree windows will be locked - // and cannot be updated during a drag operation. With the following call painting is again enabled. - if not FFullDragging then - LockWindowUpdate(0); - if Assigned(FDropTargetHelper) and FFullDragging then begin - if toAutoScroll in Self.FOwner.TreeOptions.AutoOptions 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 := FOwner.GetTreeFromDataObject(DataObject); - Result := FOwner.DragEnter(KeyState, Pt, Effect); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragManager.DragLeave: HResult; - -begin - if Assigned(FDropTargetHelper) and FFullDragging then - FDropTargetHelper.DragLeave; - - FOwner.DragLeave; - FIsDropTarget := False; - FDragSource := nil; - FDataObject := nil; - Result := NOERROR; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragManager.DragOver(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; - -begin - if Assigned(FDropTargetHelper) and FFullDragging then - FDropTargetHelper.DragOver(Pt, Effect); - - Result := FOwner.DragOver(FDragSource, KeyState, dsDragMove, Pt, Effect); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragManager.Drop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; - var Effect: Integer): HResult; - -begin - if Assigned(FDropTargetHelper) and FFullDragging then - FDropTargetHelper.Drop(DataObject, Pt, Effect); - - Result := FOwner.DragDrop(DataObject, KeyState, Pt, Effect); - FIsDropTarget := False; - FDataObject := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTDragManager.ForceDragLeave; - -// Some drop targets, e.g. Internet Explorer leave a drag image on screen instead removing it when they receive -// a drop action. This method calls the drop target helper's DragLeave method to ensure it removes the drag image from -// screen. Unfortunately, sometimes not even this does help (e.g. when dragging text from VT to a text field in IE). - -begin - if Assigned(FDropTargetHelper) and FFullDragging then - FDropTargetHelper.DragLeave; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragManager.GiveFeedback(Effect: Integer): HResult; - -begin - Result := DRAGDROP_S_USEDEFAULTCURSORS; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; - -var - RButton, - LButton: Boolean; - -begin - LButton := (KeyState and MK_LBUTTON) <> 0; - RButton := (KeyState and MK_RBUTTON) <> 0; - - // Drag'n drop canceled by pressing both mouse buttons or Esc? - if (LButton and RButton) or EscapePressed then - Result := DRAGDROP_S_CANCEL - else - // Drag'n drop finished? - if not (LButton or RButton) then - Result := DRAGDROP_S_DROP - else - Result := S_OK; -end; - - -//----------------- TVirtualTreeHintWindow ----------------------------------------------------------------------------- - -procedure TVirtualTreeHintWindow.CMTextChanged(var Message: TMessage); - -begin - // swallow this message to prevent the ancestor from resizing the window (we don't use the caption anyway) -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeHintWindow.WMEraseBkgnd(var Message: TWMEraseBkgnd); - -// The control is fully painted by own code so don't erase its background as this causes flickering. - -begin - Message.Result := 1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeHintWindow.CreateParams(var Params: TCreateParams); - -begin - inherited CreateParams(Params); - - with Params do - begin - Style := WS_POPUP; - ExStyle := ExStyle and not WS_EX_CLIENTEDGE; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeHintWindow.Paint(); -var - R: TRect; - Y: Integer; - S: string; - DrawFormat: Cardinal; - HintKind: TVTHintKind; - LClipRect: TRect; - - LColor: TColor; - LDetails: TThemedElementDetails; - LGradientStart: TColor; - LGradientEnd: TColor; - -begin - with FHintData do - begin - // Do actual painting only in the very first run. - // If the given node is nil then we have to display a header hint. - if (Node = nil) or (Tree.FHintMode <> hmToolTip) then - begin - Canvas.Font := Screen.HintFont; - Y := 2; - end - else - begin - Tree.GetTextInfo(Node, Column, Canvas.Font, R, S); - if LineBreakStyle = hlbForceMultiLine then - Y := 1 - else - Y := (R.Top - R.Bottom + Self.Height) div 2; - end; - - R := Rect(0, 0, Width, Height); - - HintKind := vhkText; - if Assigned(Node) then - Tree.DoGetHintKind(Node, Column, HintKind); - - if HintKind = vhkOwnerDraw then - begin - Tree.DoDrawHint(Canvas, Node, R, Column); - end - else - with Canvas do - begin - if Tree.VclStyleEnabled then - begin - LDetails := StyleServices.GetElementDetails(thHintNormal); - if StyleServices.GetElementColor(LDetails, ecGradientColor1, LColor) and (LColor <> clNone) then - LGradientStart := LColor - else - LGradientStart := clInfoBk; - if StyleServices.GetElementColor(LDetails, ecGradientColor2, LColor) and (LColor <> clNone) then - LGradientEnd := LColor - else - LGradientEnd := clInfoBk; - if StyleServices.GetElementColor(LDetails, ecTextColor, LColor) and (LColor <> clNone) then - Font.Color := LColor - else - Font.Color := Screen.HintFont.Color; - GradientFillCanvas(Canvas, LGradientStart, LGradientEnd, R, gdVertical); - end - else - begin - // Still force tooltip back and text color. - Font.Color := clInfoText; - Pen.Color := clBlack; - Brush.Color := clInfoBk; - if IsWinVistaOrAbove and StyleServices.Enabled and ((toThemeAware in Tree.TreeOptions.PaintOptions) or - (toUseExplorerTheme in Tree.TreeOptions.PaintOptions)) then - begin - if toUseExplorerTheme in Tree.TreeOptions.PaintOptions then // ToolTip style - StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tttStandardNormal), R) - else - begin // Hint style - LClipRect := R; - InflateRect(R, 4, 4); - StyleServices.DrawElement(Handle, StyleServices.GetElementDetails(tttStandardNormal), R, @LClipRect); - R := LClipRect; - StyleServices.DrawEdge(Handle, StyleServices.GetElementDetails(twWindowRoot), R, [eeRaisedOuter], [efRect]); - end; - end - else - if Tree.VclStyleEnabled then - StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tttStandardNormal), R) - else - Rectangle(R); - end; - // Determine text position and don't forget the border. - InflateRect(R, -1, -1); - DrawFormat := DT_TOP or DT_NOPREFIX; - SetBkMode(Handle, Winapi.Windows.TRANSPARENT); - R.Top := Y; - R.Left := R.Left + 3; // Make the text more centered - if Assigned(Node) and (LineBreakStyle = hlbForceMultiLine) then - DrawFormat := DrawFormat or DT_WORDBREAK; - Winapi.Windows.DrawTextW(Handle, PWideChar(HintText), Length(HintText), R, DrawFormat); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; - -var - TM: TTextMetric; - R: TRect; - -begin - try - if AData = nil then - // Defensive approach, it *can* happen that AData is nil. Maybe when several user defined hint classes are used. - Result := Rect(0, 0, 0, 0) - else - begin - // The hint window does not need any bidi mode setting but the caller of this method (TApplication.ActivateHint) - // does some unneccessary actions if the hint window is not left-to-right. - // The text alignment is based on the bidi mode passed in the hint data, hence we can - // simply set the window's mode to left-to-right (it might have been modified by the caller, if the - // tree window is right-to-left aligned). - BidiMode := bdLeftToRight; - - FHintData := PVTHintData(AData)^; - - with FHintData do - begin - // The draw tree gets its hint size by the application (but only if not a header hint is about to show). - // If the user will be drawing the hint, it gets its hint size by the application - // (but only if not a header hint is about to show). - // This size has already been determined in CMHintShow. - if Assigned(Node) and (not IsRectEmpty(HintRect)) then - Result := HintRect - else - begin - if Column <= NoColumn then - begin - BidiMode := Tree.BidiMode; - Alignment := Tree.Alignment; - end - else - begin - BidiMode := Tree.Header.Columns[Column].BidiMode; - Alignment := Tree.Header.Columns[Column].Alignment; - end; - - if BidiMode <> bdLeftToRight then - ChangeBidiModeAlignment(Alignment); - - if (Node = nil) or (Tree.FHintMode <> hmToolTip) then - Canvas.Font := Screen.HintFont - else - begin - Canvas.Font := Tree.Font; - if Tree is TCustomVirtualStringTree then - with TCustomVirtualStringTree(Tree) do - DoPaintText(Node, Self.Canvas, Column, ttNormal); - end; - - GetTextMetrics(Canvas.Handle, TM); - FTextHeight := TM.tmHeight; - LineBreakStyle := hlbDefault; - - if Length(HintText) = 0 then - Result := Rect(0, 0, 0, 0) - else - begin - if Assigned(Node) and (Tree.FHintMode = hmToolTip) then - begin - // Determine actual line break style depending on what was returned by the methods and what's in the node. - if LineBreakStyle = hlbDefault then - if vsMultiline in Node.States then - LineBreakStyle := hlbForceMultiLine - else - LineBreakStyle := hlbForceSingleLine; - - // Hint for a node. - if LineBreakStyle = hlbForceMultiLine then - begin - // Multiline tooltips use the columns width but extend the bottom border to fit the whole caption. - Result := Tree.GetDisplayRect(Node, Column, True, False); - R := Result; - - // On Windows NT/2K/XP the behavior of the tooltip is slightly different to that on Windows 9x/Me. - // We don't have Unicode word wrap on the latter so the tooltip gets as wide as the largest line - // in the caption (limited by carriage return), which results in unoptimal overlay of the tooltip. - Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), R, DT_CALCRECT or DT_WORDBREAK); - if BidiMode = bdLeftToRight then - Result.Right := R.Right + Tree.FTextMargin - else - Result.Left := R.Left - Tree.FTextMargin + 1; - Result.Bottom := R.Bottom; - - Inc(Result.Right); - - // If the node height and the column width are both already large enough to cover the entire text, - // then we don't need the hint, though. - // However if the text is partially scrolled out of the client area then a hint is useful as well. - if (Tree.Header.Columns.Count > 0) and ((Integer(Tree.NodeHeight[Node]) + 2) >= (Result.Bottom - Result.Top)) and - ((Tree.Header.Columns[Column].Width + 2) >= (Result.Right - Result.Left)) and not - ((Result.Left < 0) or (Result.Right > Tree.ClientWidth + 3) or - (Result.Top < 0) or (Result.Bottom > Tree.ClientHeight + 3)) then - begin - Result := Rect(0, 0, 0, 0); - Exit; - end; - end - else - begin - Result := Tree.FLastHintRect; // = Tree.GetDisplayRect(Node, Column, True, True, True); see TBaseVirtualTree.CMHintShow - - { Fixes issue #623 - - Measure the rectangle to draw the text. The width of the result - is always adjusted according to the hint text because it may - be a custom hint coming in which can be larger or smaller than - the node text. - Earlier logic was using the current width of the node that was - either cutting off the hint text or producing undesired space - on the right. - } - R := Rect(0, 0, MaxWidth, FTextHeight); - Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), R, DT_CALCRECT or DT_TOP or DT_NOPREFIX or DT_WORDBREAK); - if R.Right <> result.right - result.left then - begin - result.Right := result.Left + r.Right; - - //Space on right--taken from the code in the hmHint branch below. - if Assigned(Tree) then - Inc(Result.Right, Tree.FTextMargin + Tree.FMargin + Tree.ScaledPixels(4)); - end; - // Fix ends. - - if toShowHorzGridLines in Tree.TreeOptions.PaintOptions then - Dec(Result.Bottom); - end; - - // Include a one pixel border. - InflateRect(Result, 1, 1); - - // Make the coordinates relative. They will again be offset by the caller code. - OffsetRect(Result, -Result.Left - 1, -Result.Top - 1); - end - else - begin - // Hint for a header or non-tooltip hint. - - // Start with the base size of the hint in client coordinates. - Result := Rect(0, 0, MaxWidth, FTextHeight); - // Calculate the true size of the text rectangle. - Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), Result, DT_CALCRECT or DT_TOP or DT_NOPREFIX or DT_WORDBREAK); - // The height of the text plus 2 pixels vertical margin plus the border determine the hint window height. - // Minus 4 because THintWindow.ActivateHint adds 4 to Rect.Bottom anyway. Note that it is not scaled because the RTL itself does not do any scaling either. - Inc(Result.Bottom, Tree.ScaledPixels(6) - 4); - // The text is centered horizontally with usual text margin for left and right borders (plus border). - if not Assigned(Tree) then - Exit; // Workaround, because we have seen several exceptions here caught by Eurekalog. Submitted as issue #114 to http://code.google.com/p/virtual-treeview/ - { Issue #623 Fix for strange space on the right. - Original logic was adding FTextHeight. Changed it to add FMargin instead and - it looks OK even if the hint font is larger. - } - Inc(Result.Right, Tree.FTextMargin - + Tree.FMargin + Tree.ScaledPixels(4)); //Issue #623 space on right - //+ FTextHeight); // Old code: We are extending the width here, but the text height scales with the text width and has a similar value as AveCharWdith * 2. - end; - end; - end; - end; - end; - except - Application.HandleException(Self); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeHintWindow.IsHintMsg(var Msg: TMsg): Boolean; - -// The VCL is a bit too generous when telling that an existing hint can be cancelled. Need to specify further here. - -begin - Result := inherited IsHintMsg(Msg) and HandleAllocated and IsWindowVisible(Handle); - // Avoid that mouse moves over the non-client area or cursor key presses cancel the current hint. - if Result and ((Msg.Message = WM_NCMOUSEMOVE) or ((Msg.Message >= WM_KEYFIRST) and (Msg.Message <= WM_KEYLAST) and (Msg.wparam in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT]))) then - Result := False; -end; - -//----------------- TVTDragImage --------------------------------------------------------------------------------------- - -constructor TVTDragImage.Create(AOwner: TBaseVirtualTree); - -begin - FOwner := AOwner; - FTransparency := 128; - FPreBlendBias := 0; - FPostBlendBias := 0; - FFade := False; - FRestriction := dmrNone; - FColorKey := clNone; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -destructor TVTDragImage.Destroy; - -begin - EndDrag; - - inherited; -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); - - 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 - with TWithSafeRect(RDraw2) do - BitBlt(ScreenDC, FImagePosition.X + Left, FImagePosition.Y + Top, Right, Bottom, Handle, Left, Top, - SRCCOPY); - end - else - begin - if DeltaY = 0 then - begin - with TWithSafeRect(RDraw1) do - BitBlt(ScreenDC, FImagePosition.X + Left, FImagePosition.Y + Top, Right, Bottom, Handle, Left, Top, - SRCCOPY); - end - else - begin - with TWithSafeRect(RDraw1) do - BitBlt(ScreenDC, FImagePosition.X + Left, FImagePosition.Y + Top, Right, Bottom, Handle, Left, Top, - SRCCOPY); - with TWithSafeRect(RDraw2) do - BitBlt(ScreenDC, FImagePosition.X + Left, FImagePosition.Y + Top, Right, Bottom, Handle, Left, 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 - with TWithSafeRect(RSamp2) do - BitBlt(Handle, Left, Top, Right, Bottom, ScreenDC, FImagePosition.X + Left, FImagePosition.Y + Top, - SRCCOPY); - end - else - if DeltaY = 0 then - begin - with TWithSafeRect(RSamp1) do - BitBlt(Handle, Left, Top, Right, Bottom, ScreenDC, FImagePosition.X + Left, FImagePosition.Y + Top, - SRCCOPY); - end - else - begin - with TWithSafeRect(RSamp1) do - BitBlt(Handle, Left, Top, Right, Bottom, ScreenDC, FImagePosition.X + Left, FImagePosition.Y + Top, - SRCCOPY); - with TWithSafeRect(RSamp2) do - BitBlt(Handle, Left, Top, Right, Bottom, ScreenDC, FImagePosition.X + Left, FImagePosition.Y + 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; - FDragImage := nil; - FAlphaImage.Free; - FAlphaImage := nil; -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); - -// 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. -// This method also determines whether the system supports drag images natively. If so then only minimal structures -// are created. - -var - Width, - Height: Integer; - DragSourceHelper: IDragSourceHelper; - DragInfo: TSHDragImage; - lDragSourceHelper2: IDragSourceHelper2;// Needed to get Windows Vista+ style drag hints. - lNullPoint: TPoint; -begin - Width := DragImage.Width; - Height := DragImage.Height; - - // 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 - // First let the system try to initialze the DragSourceHelper, this works fine for file system objects (CF_HDROP) - StandardOLEFormat.cfFormat := CF_HDROP; - if not Succeeded(DataObject.QueryGetData(StandardOLEFormat)) or not Succeeded(DragSourceHelper.InitializeFromWindow(0, lNullPoint, DataObject)) then - 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.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: TBaseVirtualTree; 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, -Tree.FOffsetX, -Tree.FOffsetY); - - // 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); - 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; - -//----------------- TVTVirtualNodeEnumerator --------------------------------------------------------------------------- - -function TVTVirtualNodeEnumerator.GetCurrent: PVirtualNode; - -begin - Result := FNode; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTVirtualNodeEnumerator.MoveNext: Boolean; - -begin - Result := FCanMoveNext; - if Result then - begin - FNode := FEnumeration.GetNext(FNode); - Result := FNode <> nil; - FCanMoveNext := Result; - end; -end; - -//----------------- TVTVirtualNodeEnumeration -------------------------------------------------------------------------- - -function TVTVirtualNodeEnumeration.GetEnumerator: TVTVirtualNodeEnumerator; - -begin - Result.FNode := nil; - Result.FCanMoveNext := True; - Result.FEnumeration := @Self; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTVirtualNodeEnumeration.GetNext(Node: PVirtualNode): PVirtualNode; -begin - case FMode of - vneAll: - if Node = nil then - Result := FTree.GetFirst(FConsiderChildrenAbove) - else - Result := FTree.GetNext(Node, FConsiderChildrenAbove); - - vneChecked: - if Node = nil then - Result := FTree.GetFirstChecked(FState, FConsiderChildrenAbove) - else - Result := FTree.GetNextChecked(Node, FState, FConsiderChildrenAbove); - - vneChild: - if Node = nil then - Result := FTree.GetFirstChild(FNode) - else - Result := FTree.GetNextSibling(Node); - - vneCutCopy: - if Node = nil then - Result := FTree.GetFirstCutCopy(FConsiderChildrenAbove) - else - Result := FTree.GetNextCutCopy(Node, FConsiderChildrenAbove); - - vneInitialized: - if Node = nil then - Result := FTree.GetFirstInitialized(FConsiderChildrenAbove) - else - Result := FTree.GetNextInitialized(Node, FConsiderChildrenAbove); - - vneLeaf: - if Node = nil then - Result := FTree.GetFirstLeaf - else - Result := FTree.GetNextLeaf(Node); - - vneLevel: - if Node = nil then - Result := FTree.GetFirstLevel(FNodeLevel) - else - Result := FTree.GetNextLevel(Node, FNodeLevel); - - vneNoInit: - if Node = nil then - Result := FTree.GetFirstNoInit(FConsiderChildrenAbove) - else - Result := FTree.GetNextNoInit(Node, FConsiderChildrenAbove); - - vneSelected: - if Node = nil then - Result := FTree.GetFirstSelected(FConsiderChildrenAbove) - else - Result := FTree.GetNextSelected(Node, FConsiderChildrenAbove); - - vneVisible: - begin - if Node = nil then - begin - Result := FTree.GetFirstVisible(FNode, FConsiderChildrenAbove, FIncludeFiltered); - if FIncludeFiltered or not FTree.IsEffectivelyFiltered[Result] then - Exit; - end; - repeat - Result := FTree.GetNextVisible(Node{, FConsiderChildrenAbove}); - until not Assigned(Result) or FIncludeFiltered or not FTree.IsEffectivelyFiltered[Result]; - end; - - vneVisibleChild: - if Node = nil then - Result := FTree.GetFirstVisibleChild(FNode, FIncludeFiltered) - else - Result := FTree.GetNextVisibleSibling(Node, FIncludeFiltered); - - vneVisibleNoInitChild: - if Node = nil then - Result := FTree.GetFirstVisibleChildNoInit(FNode, FIncludeFiltered) - else - Result := FTree.GetNextVisibleSiblingNoInit(Node, FIncludeFiltered); - - vneVisibleNoInit: - begin - if Node = nil then - begin - Result := FTree.GetFirstVisibleNoInit(FNode, FConsiderChildrenAbove, FIncludeFiltered); - if FIncludeFiltered or not FTree.IsEffectivelyFiltered[Result] then - Exit; - end; - repeat - Result := FTree.GetNextVisibleNoInit(Node, FConsiderChildrenAbove); - until not Assigned(Result) or FIncludeFiltered or not FTree.IsEffectivelyFiltered[Result]; - end; - else - Result := nil; - end; -end; - -//----------------- TVirtualTreeColumn --------------------------------------------------------------------------------- - -constructor TVirtualTreeColumn.Create(Collection: TCollection); - -begin - FMinWidth := 10; - FMaxWidth := 10000; - FImageIndex := -1; - FMargin := 4; - FSpacing := 3; - FText := ''; - FOptions := DefaultColumnOptions; - FAlignment := taLeftJustify; - FBiDiMode := bdLeftToRight; - FColor := clWindow; - FLayout := blGlyphLeft; - FBonusPixel := False; - FCaptionAlignment := taLeftJustify; - FCheckType := ctCheckBox; - FCheckState := csUncheckedNormal; - FCheckBox := False; - FHasImage := False; - FDefaultSortDirection := sdAscending; - fEditNextColumn := -1; - - inherited Create(Collection); - - FWidth := Owner.FDefaultWidth; - FLastWidth := Owner.FDefaultWidth; - FPosition := Owner.Count - 1; - // Read parent bidi mode and color values as default values. - ParentBiDiModeChanged; - ParentColorChanged; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -destructor TVirtualTreeColumn.Destroy; - -var - I: Integer; - - //--------------- local function --------------------------------------------- - - procedure AdjustColumnIndex(var ColumnIndex: TColumnIndex); - - begin - if Index = ColumnIndex then - ColumnIndex := NoColumn - else - if Index < ColumnIndex then - Dec(ColumnIndex); - end; - - //--------------- end local function ----------------------------------------- - -begin - // Check if this column is somehow referenced by its collection parent or the header. - with Owner do - begin - // If the columns collection object is currently deleting all columns - // then we don't need to check the various cached indices individually. - if not FClearing then - begin - Header.Treeview.CancelEditNode; - IndexChanged(Index, -1); - - AdjustColumnIndex(FHoverIndex); - AdjustColumnIndex(FDownIndex); - AdjustColumnIndex(FTrackIndex); - AdjustColumnIndex(FClickIndex); - - with Header do - begin - AdjustColumnIndex(FAutoSizeIndex); - if Index = FMainColumn then - begin - // If the current main column is about to be destroyed then we have to find a new main column. - FMainColumn := NoColumn; - for I := 0 to Count - 1 do - if I <> Index then - begin - FMainColumn := I; - Break; - end; - end; - AdjustColumnIndex(FSortColumn); - end; - end; - end; - - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumn.GetCaptionAlignment: TAlignment; - -begin - if coUseCaptionAlignment in FOptions then - Result := FCaptionAlignment - else - Result := FAlignment; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumn.GetLeft: Integer; - -begin - Result := FLeft; - if [coVisible, coFixed] * FOptions <> [coVisible, coFixed] then - Dec(Result, Owner.Header.Treeview.FEffectiveOffsetX); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumn.IsBiDiModeStored: Boolean; - -begin - Result := not (coParentBiDiMode in FOptions); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumn.IsCaptionAlignmentStored: Boolean; - -begin - Result := coUseCaptionAlignment in FOptions; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumn.IsColorStored: Boolean; - -begin - Result := not (coParentColor in FOptions); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetAlignment(const Value: TAlignment); - -begin - if FAlignment <> Value then - begin - FAlignment := Value; - Changed(False); - // Setting the alignment affects also the tree, hence invalidate it too. - Owner.Header.TreeView.Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetBiDiMode(Value: TBiDiMode); - -begin - if Value <> FBiDiMode then - begin - FBiDiMode := Value; - Exclude(FOptions, coParentBiDiMode); - Changed(False); - // Setting the alignment affects also the tree, hence invalidate it too. - Owner.Header.TreeView.Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetCaptionAlignment(const Value: TAlignment); - -begin - if not (coUseCaptionAlignment in FOptions) or (FCaptionAlignment <> Value) then - begin - FCaptionAlignment := Value; - Include(FOptions, coUseCaptionAlignment); - // Setting the alignment affects also the tree, hence invalidate it too. - Owner.Header.Invalidate(Self); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetColor(const Value: TColor); - -begin - if FColor <> Value then - begin - FColor := Value; - Exclude(FOptions, coParentColor); - Changed(False); - Owner.Header.TreeView.Invalidate; - end; -end; - -function TVirtualTreeColumn.GetEffectiveColor(): TColor; -// Returns the color that should effectively be used as background color for this -// column considering all flags in the TVirtualTreeColumn.Options property -begin - if (coParentColor in Options) or ((coStyleColor in Options) and Owner.Header.TreeView.VclStyleEnabled) then - Result := Owner.Header.TreeView.FColors.BackGroundColor - else - Result := Self.Color; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetCheckBox(Value: Boolean); - -begin - if Value <> FCheckBox then - begin - FCheckBox := Value; - if Value and (csDesigning in Owner.Header.Treeview.ComponentState) then - Owner.Header.Options := Owner.Header.Options + [hoShowImages]; - Changed(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetCheckState(Value: TCheckState); - -begin - if Value <> FCheckState then - begin - FCheckState := Value; - Changed(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetCheckType(Value: TCheckType); - -begin - if Value <> FCheckType then - begin - FCheckType := Value; - Changed(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetImageIndex(Value: TImageIndex); - -begin - if Value <> FImageIndex then - begin - FImageIndex := Value; - Changed(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetLayout(Value: TVTHeaderColumnLayout); - -begin - if FLayout <> Value then - begin - FLayout := Value; - Changed(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetMargin(Value: Integer); - -begin - // Compatibility setting for -1. - if Value < 0 then - Value := 4; - if FMargin <> Value then - begin - FMargin := Value; - Changed(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetMaxWidth(Value: Integer); - -begin - if Value < FMinWidth then - Value := FMinWidth; - FMaxWidth := Value; - SetWidth(FWidth); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetMinWidth(Value: Integer); - -begin - if Value < 0 then - Value := 0; - if Value > FMaxWidth then - Value := FMaxWidth; - FMinWidth := Value; - SetWidth(FWidth); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetOptions(Value: TVTColumnOptions); - -var - ToBeSet, - ToBeCleared: TVTColumnOptions; - VisibleChanged, - ColorChanged: Boolean; - lTreeView: TBaseVirtualTree; -begin - if FOptions <> Value then - begin - ToBeCleared := FOptions - Value; - ToBeSet := Value - FOptions; - - FOptions := Value; - - VisibleChanged := coVisible in (ToBeSet + ToBeCleared); - ColorChanged := coParentColor in ToBeSet; - - if coParentBidiMode in ToBeSet then - ParentBiDiModeChanged; - if ColorChanged then - ParentColorChanged; - - if coAutoSpring in ToBeSet then - FSpringRest := 0; - - if ((coFixed in ToBeSet) or (coFixed in ToBeCleared)) and (coVisible in FOptions) then - Owner.Header.RescaleHeader; - - Changed(False); - // Need to repaint and adjust the owner tree too. - lTreeView := Owner.Header.Treeview; - if not (csLoading in lTreeview.ComponentState) and (VisibleChanged or ColorChanged) and (Owner.UpdateCount = 0) and - lTreeView.HandleAllocated then - begin - lTreeview.Invalidate(); - if VisibleChanged then begin - lTreeview.DoColumnVisibilityChanged(Self.Index, coVisible in ToBeSet); - lTreeview.UpdateHorizontalScrollBar(False); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetPosition(Value: TColumnPosition); - -var - Temp: TColumnIndex; - -begin - if (csLoading in Owner.Header.Treeview.ComponentState) or (Owner.UpdateCount > 0) then - // Only cache the position for final fixup when loading from DFM. - FPosition := Value - else - begin - if Value >= TColumnPosition(Collection.Count) then - Value := Collection.Count - 1; - if FPosition <> Value then - begin - with Owner do - begin - InitializePositionArray; - Header.Treeview.CancelEditNode; - AdjustPosition(Self, Value); - Self.Changed(False); - - // Need to repaint. - with Header do - begin - if (UpdateCount = 0) and Treeview.HandleAllocated then - begin - Invalidate(Self); - Treeview.Invalidate; - end; - end; - end; - - // If the moved column is now within the fixed columns then we make it fixed as well. If it's not - // we clear the fixed state (in case that fixed column is moved outside fixed area). - if (coFixed in FOptions) and (FPosition > 0) then - Temp := Owner.ColumnFromPosition(FPosition - 1) - else - Temp := Owner.ColumnFromPosition(FPosition + 1); - - if Temp <> NoColumn then - begin - if coFixed in Owner[Temp].Options then - Options := Options + [coFixed] - else - Options := Options - [coFixed]; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetSpacing(Value: Integer); - -begin - if FSpacing <> Value then - begin - FSpacing := Value; - Changed(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetStyle(Value: TVirtualTreeColumnStyle); - -begin - if FStyle <> Value then - begin - FStyle := Value; - Changed(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetText(const Value: string); - -begin - if FText <> Value then - begin - FText := Value; - FCaptionText := ''; - Changed(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SetWidth(Value: Integer); - -var - EffectiveMaxWidth, - EffectiveMinWidth, - TotalFixedMaxWidth, - TotalFixedMinWidth: Integer; - I: TColumnIndex; - -begin - if not (hsScaling in Owner.FHeader.FStates) then - if ([coVisible, coFixed] * FOptions = [coVisible, coFixed]) then - begin - with Owner, FHeader, FFixedAreaConstraints, TreeView do - begin - TotalFixedMinWidth := 0; - TotalFixedMaxWidth := 0; - for I := 0 to FColumns.Count - 1 do - if ([coVisible, coFixed] * FColumns[I].FOptions = [coVisible, coFixed]) then - begin - Inc(TotalFixedMaxWidth, FColumns[I].FMaxWidth); - Inc(TotalFixedMinWidth, FColumns[I].FMinWidth); - end; - - // The percentage values have precedence over the pixel values. - If FMaxWidthPercent > 0 then - TotalFixedMinWidth:= Min((ClientWidth * FMaxWidthPercent) div 100, TotalFixedMinWidth); - If FMinWidthPercent > 0 then - TotalFixedMaxWidth := Max((ClientWidth * FMinWidthPercent) div 100, TotalFixedMaxWidth); - - EffectiveMaxWidth := Min(TotalFixedMaxWidth - (GetVisibleFixedWidth - Self.FWidth), FMaxWidth); - EffectiveMinWidth := Max(TotalFixedMinWidth - (GetVisibleFixedWidth - Self.FWidth), FMinWidth); - Value := Min(Max(Value, EffectiveMinWidth), EffectiveMaxWidth); - - if FMinWidthPercent > 0 then - Value := Max((ClientWidth * FMinWidthPercent) div 100 - GetVisibleFixedWidth + Self.FWidth, Value); - if FMaxWidthPercent > 0 then - Value := Min((ClientWidth * FMaxWidthPercent) div 100 - GetVisibleFixedWidth + Self.FWidth, Value); - end; - end - else - Value := Min(Max(Value, FMinWidth), FMaxWidth); - - if FWidth <> Value then - begin - FLastWidth := FWidth; - if not (hsResizing in Owner.Header.States) then - FBonusPixel := False; - if not (hoAutoResize in Owner.Header.Options) or (Index <> Owner.Header.AutoSizeIndex) then - begin - FWidth := Value; - Owner.UpdatePositions; - end; - if not (csLoading in Owner.Header.Treeview.ComponentState) and (Owner.UpdateCount = 0) then - begin - if hoAutoResize in Owner.Header.Options then - Owner.AdjustAutoSize(Index); - Owner.Header.Treeview.DoColumnResize(Index); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.ComputeHeaderLayout(var PaintInfo: THeaderPaintInfo; DrawFormat: Cardinal; CalculateTextRect: Boolean = False); - -// The layout of a column header is determined by a lot of factors. This method takes them all into account and -// determines all necessary positions and bounds: -// - for the header text -// - the header glyph -// - the sort glyph - -var - TextSize: TSize; - TextPos, - ClientSize, - HeaderGlyphSize: TPoint; - CurrentAlignment: TAlignment; - MinLeft, - MaxRight, - TextSpacing: Integer; - UseText: Boolean; - R: TRect; - Theme: HTHEME; - -begin - UseText := Length(FText) > 0; - // If nothing is to show then don't waste time with useless preparation. - if not (UseText or PaintInfo.ShowHeaderGlyph or PaintInfo.ShowSortGlyph) then - Exit; - - CurrentAlignment := CaptionAlignment; - if FBiDiMode <> bdLeftToRight then - ChangeBiDiModeAlignment(CurrentAlignment); - - // Calculate sizes of the involved items. - ClientSize := Point(PaintInfo.PaintRectangle.Right - PaintInfo.PaintRectangle.Left, PaintInfo.PaintRectangle.Bottom - PaintInfo.PaintRectangle.Top); - with Owner, Header do - begin - if PaintInfo.ShowHeaderGlyph then - if not FCheckBox then - HeaderGlyphSize := Point(FImages.Width, FImages.Height) - else - with Self.Owner.Header.Treeview do - begin - if Assigned(FCheckImages) then - HeaderGlyphSize := Point(FCheckImages.Width, FCheckImages.Height); - end - else - HeaderGlyphSize := Point(0, 0); - if PaintInfo.ShowSortGlyph then - begin - if tsUseExplorerTheme in FHeader.Treeview.FStates then - begin - R := Rect(0, 0, 100, 100); - Theme := OpenThemeData(FHeader.Treeview.Handle, 'HEADER'); - GetThemePartSize(Theme, PaintInfo.TargetCanvas.Handle, HP_HEADERSORTARROW, HSAS_SORTEDUP, @R, TS_TRUE, PaintInfo.SortGlyphSize); - CloseThemeData(Theme); - end - else - begin - PaintInfo.SortGlyphSize.cx := Header.Treeview.ScaledPixels(16); - PaintInfo.SortGlyphSize.cy := Header.Treeview.ScaledPixels(4); - end; - - // In any case, the sort glyph is vertically centered. - PaintInfo.SortGlyphPos.Y := (ClientSize.Y - PaintInfo.SortGlyphSize.cy) div 2; - end - else - begin - PaintInfo.SortGlyphSize.cx := 0; - PaintInfo.SortGlyphSize.cy := 0; - end; - end; - - if UseText then - begin - if not (coWrapCaption in FOptions) then - begin - FCaptionText := FText; - GetTextExtentPoint32W(PaintInfo.TargetCanvas.Handle, PWideChar(FText), Length(FText), TextSize); - Inc(TextSize.cx, 2); - PaintInfo.TextRectangle := Rect(0, 0, TextSize.cx, TextSize.cy); - end - else - begin - R := PaintInfo.PaintRectangle; - if FCaptionText = '' then - FCaptionText := WrapString(PaintInfo.TargetCanvas.Handle, FText, R, DT_RTLREADING and DrawFormat <> 0, DrawFormat); - - GetStringDrawRect(PaintInfo.TargetCanvas.Handle, FCaptionText, R, DrawFormat); - TextSize.cx := PaintInfo.PaintRectangle.Right - PaintInfo.PaintRectangle.Left; - TextSize.cy := R.Bottom - R.Top; - PaintInfo.TextRectangle := Rect(0, 0, TextSize.cx, TextSize.cy); - end; - TextSpacing := FSpacing; - end - else - begin - TextSpacing := 0; - TextSize.cx := 0; - TextSize.cy := 0; - end; - - // Check first for the special case where nothing is shown except the sort glyph. - if PaintInfo.ShowSortGlyph and not (UseText or PaintInfo.ShowHeaderGlyph) then - begin - // Center the sort glyph in the available area if nothing else is there. - PaintInfo.SortGlyphPos := Point((ClientSize.X - PaintInfo.SortGlyphSize.cx) div 2, (ClientSize.Y - PaintInfo.SortGlyphSize.cy) div 2); - end - else - begin - // Determine extents of text and glyph and calculate positions which are clear from the layout. - if (Layout in [blGlyphLeft, blGlyphRight]) or not PaintInfo.ShowHeaderGlyph then - begin - PaintInfo.GlyphPos.Y := (ClientSize.Y - HeaderGlyphSize.Y) div 2; - // If the text is taller than the given height, perform no vertical centration as this - // would make the text even less readable. - //Using Max() fixes badly positioned text if Extra Large fonts have been activated in the Windows display options - TextPos.Y := Max(-5, (ClientSize.Y - TextSize.cy) div 2); - end - else - begin - if Layout = blGlyphTop then - begin - PaintInfo.GlyphPos.Y := (ClientSize.Y - HeaderGlyphSize.Y - TextSize.cy - TextSpacing) div 2; - TextPos.Y := PaintInfo.GlyphPos.Y + HeaderGlyphSize.Y + TextSpacing; - end - else - begin - TextPos.Y := (ClientSize.Y - HeaderGlyphSize.Y - TextSize.cy - TextSpacing) div 2; - PaintInfo.GlyphPos.Y := TextPos.Y + TextSize.cy + TextSpacing; - end; - end; - - // Each alignment needs special consideration. - case CurrentAlignment of - taLeftJustify: - begin - MinLeft := FMargin; - if PaintInfo.ShowSortGlyph and (FBiDiMode <> bdLeftToRight) then - begin - // In RTL context is the sort glyph placed on the left hand side. - PaintInfo.SortGlyphPos.X := MinLeft; - Inc(MinLeft, PaintInfo.SortGlyphSize.cx + FSpacing); - end; - if Layout in [blGlyphTop, blGlyphBottom] then - begin - // Header glyph is above or below text, so both must be considered when calculating - // the left positition of the sort glyph (if it is on the right hand side). - TextPos.X := MinLeft; - if PaintInfo.ShowHeaderGlyph then - begin - PaintInfo.GlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) div 2; - if PaintInfo.GlyphPos.X < MinLeft then - PaintInfo.GlyphPos.X := MinLeft; - MinLeft := Max(TextPos.X + TextSize.cx + TextSpacing, PaintInfo.GlyphPos.X + HeaderGlyphSize.X + FSpacing); - end - else - MinLeft := TextPos.X + TextSize.cx + TextSpacing; - end - else - begin - // Everything is lined up. TextSpacing might be 0 if there is no text. - // This simplifies the calculation because no extra tests are necessary. - if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphLeft) then - begin - PaintInfo.GlyphPos.X := MinLeft; - Inc(MinLeft, HeaderGlyphSize.X + FSpacing); - end; - TextPos.X := MinLeft; - Inc(MinLeft, TextSize.cx + TextSpacing); - if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphRight) then - begin - PaintInfo.GlyphPos.X := MinLeft; - Inc(MinLeft, HeaderGlyphSize.X + FSpacing); - end; - end; - if PaintInfo.ShowSortGlyph and (FBiDiMode = bdLeftToRight) then - PaintInfo.SortGlyphPos.X := MinLeft; - end; - taCenter: - begin - if Layout in [blGlyphTop, blGlyphBottom] then - begin - PaintInfo.GlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) div 2; - TextPos.X := (ClientSize.X - TextSize.cx) div 2; - if PaintInfo.ShowSortGlyph then - Dec(TextPos.X, PaintInfo.SortGlyphSize.cx div 2); - end - else - begin - MinLeft := (ClientSize.X - HeaderGlyphSize.X - TextSpacing - TextSize.cx) div 2; - if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphLeft) then - begin - PaintInfo.GlyphPos.X := MinLeft; - Inc(MinLeft, HeaderGlyphSize.X + TextSpacing); - end; - TextPos.X := MinLeft; - Inc(MinLeft, TextSize.cx + TextSpacing); - if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphRight) then - PaintInfo.GlyphPos.X := MinLeft; - end; - if PaintInfo.ShowHeaderGlyph then - begin - MinLeft := Min(PaintInfo.GlyphPos.X, TextPos.X); - MaxRight := Max(PaintInfo.GlyphPos.X + HeaderGlyphSize.X, TextPos.X + TextSize.cx); - end - else - begin - MinLeft := TextPos.X; - MaxRight := TextPos.X + TextSize.cx; - end; - // Place the sort glyph directly to the left or right of the larger item. - if PaintInfo.ShowSortGlyph then - if FBiDiMode = bdLeftToRight then - begin - // Sort glyph on the right hand side. - PaintInfo.SortGlyphPos.X := MaxRight + FSpacing; - end - else - begin - // Sort glyph on the left hand side. - PaintInfo.SortGlyphPos.X := MinLeft - FSpacing - PaintInfo.SortGlyphSize.cx; - end; - end; - else - // taRightJustify - MaxRight := ClientSize.X - FMargin; - if PaintInfo.ShowSortGlyph and (FBiDiMode = bdLeftToRight) then - begin - // In LTR context is the sort glyph placed on the right hand side. - Dec(MaxRight, PaintInfo.SortGlyphSize.cx); - PaintInfo.SortGlyphPos.X := MaxRight; - Dec(MaxRight, FSpacing); - end; - if Layout in [blGlyphTop, blGlyphBottom] then - begin - TextPos.X := MaxRight - TextSize.cx; - if PaintInfo.ShowHeaderGlyph then - begin - PaintInfo.GlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) div 2; - if PaintInfo.GlyphPos.X + HeaderGlyphSize.X + FSpacing > MaxRight then - PaintInfo.GlyphPos.X := MaxRight - HeaderGlyphSize.X - FSpacing; - MaxRight := Min(TextPos.X - TextSpacing, PaintInfo.GlyphPos.X - FSpacing); - end - else - MaxRight := TextPos.X - TextSpacing; - end - else - begin - // Everything is lined up. TextSpacing might be 0 if there is no text. - // This simplifies the calculation because no extra tests are necessary. - if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphRight) then - begin - PaintInfo.GlyphPos.X := MaxRight - HeaderGlyphSize.X; - MaxRight := PaintInfo.GlyphPos.X - FSpacing; - end; - TextPos.X := MaxRight - TextSize.cx; - MaxRight := TextPos.X - TextSpacing; - if PaintInfo.ShowHeaderGlyph and (Layout = blGlyphLeft) then - begin - PaintInfo.GlyphPos.X := MaxRight - HeaderGlyphSize.X; - MaxRight := PaintInfo.GlyphPos.X - FSpacing; - end; - end; - if PaintInfo.ShowSortGlyph and (FBiDiMode <> bdLeftToRight) then - PaintInfo.SortGlyphPos.X := MaxRight - PaintInfo.SortGlyphSize.cx; - end; - end; - - // Once the position of each element is determined there remains only one but important step. - // The horizontal positions of every element must be adjusted so that it always fits into the - // given header area. This is accomplished by shorten the text appropriately. - - // These are the maximum bounds. Nothing goes beyond them. - MinLeft := FMargin; - MaxRight := ClientSize.X - FMargin; - if PaintInfo.ShowSortGlyph then - begin - if FBiDiMode = bdLeftToRight then - begin - // Sort glyph on the right hand side. - if PaintInfo.SortGlyphPos.X + PaintInfo.SortGlyphSize.cx > MaxRight then - PaintInfo.SortGlyphPos.X := MaxRight - PaintInfo.SortGlyphSize.cx; - MaxRight := PaintInfo.SortGlyphPos.X - FSpacing; - end; - - // Consider also the left side of the sort glyph regardless of the bidi mode. - if PaintInfo.SortGlyphPos.X < MinLeft then - PaintInfo.SortGlyphPos.X := MinLeft; - // Left border needs only adjustment if the sort glyph marks the left border. - if FBiDiMode <> bdLeftToRight then - MinLeft := PaintInfo.SortGlyphPos.X + PaintInfo.SortGlyphSize.cx + FSpacing; - - // Finally transform sort glyph to its actual position. - Inc(PaintInfo.SortGlyphPos.X, PaintInfo.PaintRectangle.Left); - Inc(PaintInfo.SortGlyphPos.Y, PaintInfo.PaintRectangle.Top); - end; - if PaintInfo.ShowHeaderGlyph then - begin - if PaintInfo.GlyphPos.X + HeaderGlyphSize.X > MaxRight then - PaintInfo.GlyphPos.X := MaxRight - HeaderGlyphSize.X; - if Layout = blGlyphRight then - MaxRight := PaintInfo.GlyphPos.X - FSpacing; - if PaintInfo.GlyphPos.X < MinLeft then - PaintInfo.GlyphPos.X := MinLeft; - if Layout = blGlyphLeft then - MinLeft := PaintInfo.GlyphPos.X + HeaderGlyphSize.X + FSpacing; - if FCheckBox and (Owner.Header.MainColumn = Self.Index) then - Dec(PaintInfo.GlyphPos.X, 2) - else - if Owner.Header.MainColumn <> Self.Index then - Dec(PaintInfo.GlyphPos.X, 2); - - // Finally transform header glyph to its actual position. - Inc(PaintInfo.GlyphPos.X, PaintInfo.PaintRectangle.Left); - Inc(PaintInfo.GlyphPos.Y, PaintInfo.PaintRectangle.Top); - end; - if UseText then - begin - if TextPos.X < MinLeft then - TextPos.X := MinLeft; - OffsetRect(PaintInfo.TextRectangle, TextPos.X, TextPos.Y); - if PaintInfo.TextRectangle.Right > MaxRight then - PaintInfo.TextRectangle.Right := MaxRight; - OffsetRect(PaintInfo.TextRectangle, PaintInfo.PaintRectangle.Left, PaintInfo.PaintRectangle.Top); - - if coWrapCaption in FOptions then - begin - // Wrap the column caption if necessary. - R := PaintInfo.TextRectangle; - FCaptionText := WrapString(PaintInfo.TargetCanvas.Handle, FText, R, DT_RTLREADING and DrawFormat <> 0, DrawFormat); - GetStringDrawRect(PaintInfo.TargetCanvas.Handle, FCaptionText, R, DrawFormat); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.DefineProperties(Filer: TFiler); - -begin - inherited; - - // These properites are remains from non-Unicode Delphi versions, readers remain for backward compatibility. - Filer.DefineProperty('WideText', ReadText, nil, False); - Filer.DefineProperty('WideHint', ReadHint, nil, False); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.GetAbsoluteBounds(var Left, Right: Integer); - -// Returns the column's left and right bounds in header coordinates, that is, independant of the scrolling position. - -begin - Left := FLeft; - Right := FLeft + FWidth; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumn.GetDisplayName: string; - -// Returns the column text if it only contains ANSI characters, otherwise the column id is returned because the IDE -// still cannot handle Unicode strings. - -var - I: Integer; - -begin - // Check if the text of the column contains characters > 255 - I := 1; - while I <= Length(FText) do - begin - if Ord(FText[I]) > 255 then - Break; - Inc(I); - end; - - if I > Length(FText) then - Result := FText // implicit conversion - else - Result := Format('Column %d', [Index]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumn.GetOwner: TVirtualTreeColumns; - -begin - Result := Collection as TVirtualTreeColumns; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.ReadText(Reader: TReader); - -begin - case Reader.NextValue of - vaLString, vaString: - SetText(Reader.ReadString); - else - SetText(Reader.ReadString); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.ReadHint(Reader: TReader); - -begin - case Reader.NextValue of - vaLString, vaString: - FHint := Reader.ReadString; - else - FHint := Reader.ReadString; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.Assign(Source: TPersistent); - -var - OldOptions: TVTColumnOptions; - -begin - if Source is TVirtualTreeColumn then - begin - OldOptions := FOptions; - FOptions := []; - - BiDiMode := TVirtualTreeColumn(Source).BiDiMode; - ImageIndex := TVirtualTreeColumn(Source).ImageIndex; - Layout := TVirtualTreeColumn(Source).Layout; - Margin := TVirtualTreeColumn(Source).Margin; - MaxWidth := TVirtualTreeColumn(Source).MaxWidth; - MinWidth := TVirtualTreeColumn(Source).MinWidth; - Position := TVirtualTreeColumn(Source).Position; - Spacing := TVirtualTreeColumn(Source).Spacing; - Style := TVirtualTreeColumn(Source).Style; - Text := TVirtualTreeColumn(Source).Text; - Hint := TVirtualTreeColumn(Source).Hint; - Width := TVirtualTreeColumn(Source).Width; - Alignment := TVirtualTreeColumn(Source).Alignment; - CaptionAlignment := TVirtualTreeColumn(Source).CaptionAlignment; - Color := TVirtualTreeColumn(Source).Color; - Tag := TVirtualTreeColumn(Source).Tag; - EditOptions := TVirtualTreeColumn(Source).EditOptions; - EditNextColumn := TVirtualTreeColumn(Source).EditNextColumn; - - // Order is important. Assign options last. - FOptions := OldOptions; - Options := TVirtualTreeColumn(Source).Options; - - Changed(False); - end - else - inherited Assign(Source); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumn.Equals(OtherColumnObj: TObject): Boolean; -var - OtherColumn : TVirtualTreeColumn; -begin - if OtherColumnObj is TVirtualTreeColumn then - begin - OtherColumn := TVirtualTreeColumn (OtherColumnObj); - Result := (BiDiMode = OtherColumn.BiDiMode) and - (ImageIndex = OtherColumn.ImageIndex) and - (Layout = OtherColumn.Layout) and - (Margin = OtherColumn.Margin) and - (MaxWidth = OtherColumn.MaxWidth) and - (MinWidth = OtherColumn.MinWidth) and - (Position = OtherColumn.Position) and - (Spacing = OtherColumn.Spacing) and - (Style = OtherColumn.Style) and - (Text = OtherColumn.Text) and - (Hint = OtherColumn.Hint) and - (Width = OtherColumn.Width) and - (Alignment = OtherColumn.Alignment) and - (CaptionAlignment = OtherColumn.CaptionAlignment) and - (Color = OtherColumn.Color) and - (Tag = OtherColumn.Tag) and - (Options = OtherColumn.Options); - end - else - Result := False; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumn.GetRect: TRect; - -// Returns the rectangle this column occupies in the header (relative to (0, 0) of the non-client area). - -begin - with TVirtualTreeColumns(GetOwner).FHeader do - Result := Treeview.FHeaderRect; - Inc(Result.Left, FLeft); - Result.Right := Result.Left + FWidth; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -// [IPK] -function TVirtualTreeColumn.GetText: string; - -begin - Result := FText; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.LoadFromStream(const Stream: TStream; Version: Integer); -var - Dummy: Integer; - S: string; - -begin - with Stream do - begin - ReadBuffer(Dummy, SizeOf(Dummy)); - SetLength(S, Dummy); - ReadBuffer(PWideChar(S)^, 2 * Dummy); - Text := S; - ReadBuffer(Dummy, SizeOf(Dummy)); - SetLength(FHint, Dummy); - ReadBuffer(PWideChar(FHint)^, 2 * Dummy); - ReadBuffer(Dummy, SizeOf(Dummy)); - Width := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - MinWidth := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - MaxWidth := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - Style := TVirtualTreeColumnStyle(Dummy); - ReadBuffer(Dummy, SizeOf(Dummy)); - ImageIndex := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - Layout := TVTHeaderColumnLayout(Dummy); - ReadBuffer(Dummy, SizeOf(Dummy)); - Margin := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - Spacing := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - BiDiMode := TBiDiMode(Dummy); - - ReadBuffer(Dummy, SizeOf(Dummy)); - if Version >= 3 then - Options := TVTColumnOptions(Dummy); - - if Version > 0 then - begin - // Parts which have been introduced/changed with header stream version 1+. - ReadBuffer(Dummy, SizeOf(Dummy)); - Tag := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - Alignment := TAlignment(Dummy); - - if Version > 1 then - begin - ReadBuffer(Dummy, SizeOf(Dummy)); - Color := TColor(Dummy); - end; - - if Version > 5 then - begin - if coUseCaptionAlignment in FOptions then - begin - ReadBuffer(Dummy, SizeOf(Dummy)); - CaptionAlignment := TAlignment(Dummy); - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.ParentBiDiModeChanged; - -var - Columns: TVirtualTreeColumns; - -begin - if coParentBiDiMode in FOptions then - begin - Columns := GetOwner as TVirtualTreeColumns; - if Assigned(Columns) and (FBiDiMode <> Columns.FHeader.Treeview.BiDiMode) then - begin - FBiDiMode := Columns.FHeader.Treeview.BiDiMode; - Changed(False); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.ParentColorChanged; - -var - Columns: TVirtualTreeColumns; - -begin - if coParentColor in FOptions then - begin - Columns := GetOwner as TVirtualTreeColumns; - if Assigned(Columns) and (FColor <> Columns.FHeader.Treeview.Color) then - begin - FColor := Columns.FHeader.Treeview.Color; - Changed(False); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.RestoreLastWidth; - -begin - TVirtualTreeColumns(GetOwner).AnimatedResize(Index, FLastWidth); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumn.SaveToStream(const Stream: TStream); - -var - Dummy: Integer; - -begin - with Stream do - begin - Dummy := Length(FText); - WriteBuffer(Dummy, SizeOf(Dummy)); - WriteBuffer(PWideChar(FText)^, 2 * Dummy); - Dummy := Length(FHint); - WriteBuffer(Dummy, SizeOf(Dummy)); - WriteBuffer(PWideChar(FHint)^, 2 * Dummy); - WriteBuffer(FWidth, SizeOf(FWidth)); - WriteBuffer(FMinWidth, SizeOf(FMinWidth)); - WriteBuffer(FMaxWidth, SizeOf(FMaxWidth)); - Dummy := Ord(FStyle); - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := FImageIndex; - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Ord(FLayout); - WriteBuffer(Dummy, SizeOf(Dummy)); - WriteBuffer(FMargin, SizeOf(FMargin)); - WriteBuffer(FSpacing, SizeOf(FSpacing)); - Dummy := Ord(FBiDiMode); - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Integer(FOptions); - WriteBuffer(Dummy, SizeOf(Dummy)); - - // parts introduced with stream version 1 - WriteBuffer(FTag, SizeOf(Dummy)); - Dummy := Cardinal(FAlignment); - WriteBuffer(Dummy, SizeOf(Dummy)); - - // parts introduced with stream version 2 - Dummy := Integer(FColor); - WriteBuffer(Dummy, SizeOf(Dummy)); - - // parts introduced with stream version 6 - if coUseCaptionAlignment in FOptions then - begin - Dummy := Cardinal(FCaptionAlignment); - WriteBuffer(Dummy, SizeOf(Dummy)); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumn.UseRightToLeftReading: Boolean; - -begin - Result := FBiDiMode <> bdLeftToRight; -end; - -//----------------- TVirtualTreeColumns -------------------------------------------------------------------------------- - -constructor TVirtualTreeColumns.Create(AOwner: TVTHeader); - -var - ColumnClass: TVirtualTreeColumnClass; - -begin - FHeader := AOwner; - - // Determine column class to be used in the header. - ColumnClass := AOwner.FOwner.GetColumnClass; - // The owner tree always returns the default tree column class if not changed by application/descendants. - inherited Create(ColumnClass); - - FHeaderBitmap := TBitmap.Create; - FHeaderBitmap.PixelFormat := pf32Bit; - - FHoverIndex := NoColumn; - FDownIndex := NoColumn; - FClickIndex := NoColumn; - FDropTarget := NoColumn; - FTrackIndex := NoColumn; - FDefaultWidth := 50; - Self.FColumnPopupMenu := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -destructor TVirtualTreeColumns.Destroy; - -begin - FreeAndNil(FColumnPopupMenu); - FreeAndNil(FHeaderBitmap); - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetCount: Integer; - -begin - Result := inherited Count; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetItem(Index: TColumnIndex): TVirtualTreeColumn; - -begin - Result := TVirtualTreeColumn(inherited GetItem(Index)); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetNewIndex(P: TPoint; var OldIndex: TColumnIndex): Boolean; - -var - NewIndex: Integer; - -begin - Result := False; - // convert to local coordinates - Inc(P.Y, FHeader.FHeight); - NewIndex := ColumnFromPosition(P); - if NewIndex <> OldIndex then - begin - if OldIndex > NoColumn then - FHeader.Invalidate(Items[OldIndex], False, True); - OldIndex := NewIndex; - if OldIndex > NoColumn then - FHeader.Invalidate(Items[OldIndex], False, True); - Result := True; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.SetDefaultWidth(Value: Integer); - -begin - FDefaultWidth := Value; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.SetItem(Index: TColumnIndex; Value: TVirtualTreeColumn); - -begin - inherited SetItem(Index, Value); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.AdjustAutoSize(CurrentIndex: TColumnIndex; Force: Boolean = False); - -// Called only if the header is in auto-size mode which means a column needs to be so large -// that it fills all the horizontal space not occupied by the other columns. -// CurrentIndex (if not InvalidColumn) describes which column has just been resized. - -var - NewValue, - AutoIndex, - Index, - RestWidth: Integer; - WasUpdating: Boolean; -begin - if Count > 0 then - begin - // Determine index to be used for auto resizing. This is usually given by the owner's AutoSizeIndex, but - // could be different if the column whose resize caused the invokation here is either the auto column itself - // or visually to the right of the auto size column. - AutoIndex := FHeader.FAutoSizeIndex; - if (AutoIndex < 0) or (AutoIndex >= Count) then - AutoIndex := Count - 1; - - if AutoIndex >= 0 then - begin - with FHeader.Treeview do - begin - if HandleAllocated then - RestWidth := ClientWidth - else - RestWidth := Width; - end; - - // Go through all columns and calculate the rest space remaining. - for Index := 0 to Count - 1 do - if (Index <> AutoIndex) and (coVisible in Items[Index].FOptions) then - Dec(RestWidth, Items[Index].Width); - - with Items[AutoIndex] do - begin - NewValue := Max(MinWidth, Min(MaxWidth, RestWidth)); - if Force or (FWidth <> NewValue) then - begin - FWidth := NewValue; - UpdatePositions; - WasUpdating := csUpdating in FHeader.Treeview.ComponentState; - if not WasUpdating then - FHeader.Treeview.Updating();// Fixes #398 - try - FHeader.Treeview.DoColumnResize(AutoIndex); - finally - if not WasUpdating then - FHeader.Treeview.Updated(); - end; - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.AdjustDownColumn(P: TPoint): TColumnIndex; - -// Determines the column from the given position and returns it. If this column is allowed to be clicked then -// it is also kept for later use. - -begin - // Convert to local coordinates. - Inc(P.Y, FHeader.FHeight); - Result := ColumnFromPosition(P); - if (Result > NoColumn) and (Result <> FDownIndex) and (coAllowClick in Items[Result].FOptions) and - (coEnabled in Items[Result].FOptions) then - begin - if FDownIndex > NoColumn then - FHeader.Invalidate(Items[FDownIndex]); - FDownIndex := Result; - FCheckBoxHit := Items[Result].FHasImage and PtInRect(Items[Result].FImageRect, P) and Items[Result].CheckBox; - FHeader.Invalidate(Items[FDownIndex]); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.AdjustHoverColumn(P: TPoint): Boolean; - -// Determines the new hover column index and returns True if the index actually changed else False. - -begin - Result := GetNewIndex(P, FHoverIndex); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.AdjustPosition(Column: TVirtualTreeColumn; Position: Cardinal); - -// Reorders the column position array so that the given column gets the given position. - -var - OldPosition: Cardinal; - -begin - OldPosition := Column.Position; - if OldPosition <> Position then - begin - if OldPosition < Position then - begin - // column will be moved up so move down other entries - Move(FPositionToIndex[OldPosition + 1], FPositionToIndex[OldPosition], (Position - OldPosition) * SizeOf(Cardinal)); - end - else - begin - // column will be moved down so move up other entries - Move(FPositionToIndex[Position], FPositionToIndex[Position + 1], (OldPosition - Position) * SizeOf(Cardinal)); - end; - FPositionToIndex[Position] := Column.Index; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.CanSplitterResize(P: TPoint; Column: TColumnIndex): Boolean; - -begin - Result := (Column > NoColumn) and ([coResizable, coVisible] * Items[Column].FOptions = [coResizable, coVisible]); - DoCanSplitterResize(P, Column, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.DoCanSplitterResize(P: TPoint; Column: TColumnIndex; var Allowed: Boolean); - -begin - if Assigned(FHeader.Treeview.FOnCanSplitterResizeColumn) then - FHeader.Treeview.FOnCanSplitterResizeColumn(FHeader, P, Column, Allowed); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.DrawButtonText(DC: HDC; Caption: string; Bounds: TRect; Enabled, Hot: Boolean; - DrawFormat: Cardinal; WrapCaption: Boolean); - -var - TextSpace: Integer; - Size: TSize; - -begin - if not WrapCaption then - begin - // Do we need to shorten the caption due to limited space? - GetTextExtentPoint32W(DC, PWideChar(Caption), Length(Caption), Size); - TextSpace := Bounds.Right - Bounds.Left; - if TextSpace < Size.cx then - Caption := ShortenString(DC, Caption, TextSpace); - end; - - SetBkMode(DC, TRANSPARENT); - if not Enabled then - if FHeader.Treeview.VclStyleEnabled then - begin - SetTextColor(DC, ColorToRGB(FHeader.Treeview.FColors.HeaderFontColor)); - Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); - end - else - begin - OffsetRect(Bounds, 1, 1); - SetTextColor(DC, ColorToRGB(clBtnHighlight)); - Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); - OffsetRect(Bounds, -1, -1); - SetTextColor(DC, ColorToRGB(clBtnShadow)); - Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); - end - else - begin - if Hot then - SetTextColor(DC, ColorToRGB(FHeader.Treeview.FColors.HeaderHotColor)) - else - SetTextColor(DC, ColorToRGB(FHeader.Treeview.FColors.HeaderFontColor)); - Winapi.Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.FixPositions; - -// Fixes column positions after loading from DFM or Bidi mode change. - -var - I: Integer; - -begin - for I := 0 to Count - 1 do - FPositionToIndex[Items[I].Position] := I; - - FNeedPositionsFix := False; - UpdatePositions(True); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: Integer; - Relative: Boolean = True): Integer; - -// Returns the column where the mouse is currently in as well as the left and right bound of -// this column (Left and Right are undetermined if no column is involved). - -var - I: Integer; - -begin - Result := InvalidColumn; - if Relative and (P.X >= Header.Columns.GetVisibleFixedWidth) then - ColumnLeft := -FHeader.Treeview.FEffectiveOffsetX - else - ColumnLeft := 0; - - if FHeader.Treeview.UseRightToLeftAlignment then - Inc(ColumnLeft, FHeader.Treeview.ComputeRTLOffset(True)); - - for I := 0 to Count - 1 do - with Items[FPositionToIndex[I]] do - if coVisible in FOptions then - begin - ColumnRight := ColumnLeft + FWidth; - - //fix: in right to left alignment, X can be in the - //area on the left of first column which is OUT. - if (P.X < ColumnLeft) and (I = 0) then - begin - Result := InvalidColumn; - exit; - end; - if P.X < ColumnRight then - begin - Result := FPositionToIndex[I]; - Exit; - end; - ColumnLeft := ColumnRight; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetOwner: TPersistent; - -begin - Result := FHeader; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; Force, DblClick: Boolean): Boolean; - -// Generates a click event if the mouse button has been released over the same column it was pressed first. -// Alternatively, Force might be set to True to indicate that the down index does not matter (right, middle and -// double click). -// Returns true if the click was handled, False otherwise. - -var - HitInfo: TVTHeaderHitInfo; - NewClickIndex: Integer; - Menu: TPopupMenu; -begin - Result := False; - if (csDesigning in Header.Treeview.ComponentState) then - exit; - // Convert vertical position to local coordinates. - Inc(P.Y, FHeader.FHeight); - NewClickIndex := ColumnFromPosition(P); - with HitInfo do - begin - X := P.X; - Y := P.Y; - Shift := FHeader.GetShiftState; - if DblClick then - Shift := Shift + [ssDouble]; - end; - HitInfo.Button := Button; - - if (NewClickIndex > NoColumn) and (coAllowClick in Items[NewClickIndex].FOptions) and - ((NewClickIndex = FDownIndex) or Force) then - begin - FClickIndex := NewClickIndex; - HitInfo.Column := NewClickIndex; - HitInfo.HitPosition := [hhiOnColumn]; - - if Items[NewClickIndex].FHasImage and PtInRect(Items[NewClickIndex].FImageRect, P) then - begin - Include(HitInfo.HitPosition, hhiOnIcon); - if Items[NewClickIndex].CheckBox then - begin - if Button = mbLeft then - FHeader.Treeview.UpdateColumnCheckState(Items[NewClickIndex]); - Include(HitInfo.HitPosition, hhiOnCheckbox); - end; - end; - end - else - begin - FClickIndex := NoColumn; - HitInfo.Column := NoColumn; - HitInfo.HitPosition := [hhiNoWhere]; - end; - - if DblClick then - FHeader.Treeview.DoHeaderDblClick(HitInfo) - else begin - if (hoHeaderClickAutoSort in Header.Options) and (HitInfo.Button = mbLeft) and not (hhiOnCheckbox in HitInfo.HitPosition) and (HitInfo.Column >= 0) then - begin - // handle automatic setting of SortColumn and toggling of the sort order - if HitInfo.Column <> Header.SortColumn then - begin - // set sort column - Header.DoSetSortColumn(HitInfo.Column, Self[HitInfo.Column].DefaultSortDirection); - end//if - else - begin - // toggle sort direction - if Header.SortDirection = sdDescending then - Header.SortDirection := sdAscending - else - Header.SortDirection := sdDescending; - end;//else - Result := True; - end;//if - - if (Button = mbRight) then - begin - Dec(P.Y, FHeader.FHeight); // popup menus at actual clicked point - FreeAndNil(fColumnPopupMenu);// Attention: Do not free the TVTHeaderPopupMenu at the end of this method, otherwise the clikc events of the menu item will not be fired. - Self.FDownIndex := NoColumn; - Self.FTrackIndex := NoColumn; - Self.FCheckBoxHit := False; - Menu := Header.DoGetPopupMenu(Self.ColumnFromPosition(Point(P.X, P.Y + Integer(Header.Treeview.Height))), P); - if Assigned(Menu) then - begin - Header.Treeview.StopTimer(ScrollTimer); - Header.Treeview.StopTimer(HeaderTimer); - Header.FColumns.FHoverIndex := NoColumn; - Header.Treeview.DoStateChange([], [tsScrollPending, tsScrolling]); - - Menu.PopupComponent := Header.Treeview; - With Header.Treeview.ClientToScreen(P) do - Menu.Popup(X, Y); - Result := True; - end - else if (hoAutoColumnPopupMenu in Header.Options) then - begin - fColumnPopupMenu := TVTHeaderPopupMenu.Create(Header.TreeView); - TVTHeaderPopupMenu(fColumnPopupMenu).OnAddHeaderPopupItem := HeaderPopupMenuAddHeaderPopupItem; - TVTHeaderPopupMenu(fColumnPopupMenu).OnColumnChange := HeaderPopupMenuColumnChange; - fColumnPopupMenu.PopupComponent := Header.Treeview; - if (hoDblClickResize in Header.Options) and (Header.Treeview.ChildCount[nil] > 0) then - TVTHeaderPopupMenu(fColumnPopupMenu).Options := TVTHeaderPopupMenu(fColumnPopupMenu).Options + [poResizeToFitItem] - else - TVTHeaderPopupMenu(fColumnPopupMenu).Options := TVTHeaderPopupMenu(fColumnPopupMenu).Options - [poResizeToFitItem]; - With Header.Treeview.ClientToScreen(P) do - fColumnPopupMenu.Popup(X, Y); - Result := True; - end; // if hoAutoColumnPopupMenu - end;//if mbRight - FHeader.Treeview.DoHeaderClick(HitInfo); - end;//else (not DblClick) - - if not (hhiNoWhere in HitInfo.HitPosition) then - FHeader.Invalidate(Items[NewClickIndex]); - if (FClickIndex > NoColumn) and (FClickIndex <> NewClickIndex) then - FHeader.Invalidate(Items[FClickIndex]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.HeaderPopupMenuAddHeaderPopupItem(const Sender: TBaseVirtualTree; const Column: TColumnIndex; - var Cmd: TAddPopupItemType); -begin - Sender.DoHeaderAddPopupItem(Column, Cmd); -end; - -//---------------------------------------------------------------------------------------------------------------------- - - -procedure TVirtualTreeColumns.HeaderPopupMenuColumnChange(const Sender: TBaseVirtualTree; const Column: TColumnIndex; Visible: Boolean); -begin - Sender.DoColumnVisibilityChanged(Column, Visible); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.IndexChanged(OldIndex, NewIndex: Integer); - -// Called by a column when its index in the collection changes. If NewIndex is -1 then the column is -// about to be removed, otherwise it is moved to a new index. -// The method will then update the position array to reflect the change. - -var - I: Integer; - Increment: Integer; - Lower, - Upper: Integer; - -begin - if NewIndex = -1 then - begin - // Find position in the array with the old index. - Upper := High(FPositionToIndex); - for I := 0 to Upper do - begin - if FPositionToIndex[I] = OldIndex then - begin - // Index found. Move all higher entries one step down and remove the last entry. - if I < Upper then - Move(FPositionToIndex[I + 1], FPositionToIndex[I], (Upper - I) * SizeOf(TColumnIndex)); - end; - // Decrease all indices, which are greater than the index to be deleted. - if FPositionToIndex[I] > OldIndex then - Dec(FPositionToIndex[I]); - end; - SetLength(FPositionToIndex, High(FPositionToIndex)); - end - else - begin - if OldIndex < NewIndex then - Increment := -1 - else - Increment := 1; - - Lower := Min(OldIndex, NewIndex); - Upper := Max(OldIndex, NewIndex); - for I := 0 to High(FPositionToIndex) do - begin - if (FPositionToIndex[I] >= Lower) and (FPositionToIndex[I] < Upper) then - Inc(FPositionToIndex[I], Increment) - else - if FPositionToIndex[I] = OldIndex then - FPositionToIndex[I] := NewIndex; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.InitializePositionArray; - -// Ensures that the column position array contains as many entries as columns are defined. -// The array is resized and initialized with default values if needed. - -var - I, OldSize: Integer; - Changed: Boolean; - -begin - if Count <> Length(FPositionToIndex) then - begin - OldSize := Length(FPositionToIndex); - SetLength(FPositionToIndex, Count); - if Count > OldSize then - begin - // New items have been added, just set their position to the same as their index. - for I := OldSize to Count - 1 do - FPositionToIndex[I] := I; - end - else - begin - // Items have been deleted, so reindex remaining entries by decrementing values larger than the highest - // possible index until no entry is higher than this limit. - repeat - Changed := False; - for I := 0 to Count - 1 do - if FPositionToIndex[I] >= Count then - begin - Dec(FPositionToIndex[I]); - Changed := True; - end; - until not Changed; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.Notify(Item: TCollectionItem; Action: System.Classes.TCollectionNotification); - -begin - if Action in [cnExtracting, cnDeleting] then - with Header.Treeview do - if not (csLoading in ComponentState) and (FFocusedColumn = Item.Index) then - FFocusedColumn := NoColumn; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.ReorderColumns(RTL: Boolean); - -var - I: Integer; - -begin - if RTL then - begin - for I := 0 to Count - 1 do - FPositionToIndex[I] := Count - I - 1; - end - else - begin - for I := 0 to Count - 1 do - FPositionToIndex[I] := I; - end; - - UpdatePositions(True); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.EndUpdate; -begin - InitializePositionArray(); - FixPositions(); // Accept the cuurent order. See issue #753 - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.Update(Item: TCollectionItem); - -begin - // This is the only place which gets notified when a new column has been added or removed - // and we need this event to adjust the column position array. - InitializePositionArray; - if csLoading in Header.Treeview.ComponentState then - FNeedPositionsFix := True - else - UpdatePositions; - - // The first column which is created is by definition also the main column. - if (Count > 0) and (Header.FMainColumn < 0) then - FHeader.FMainColumn := 0; - - if not (csLoading in Header.Treeview.ComponentState) and not (hsLoading in FHeader.FStates) then - begin - with FHeader do - begin - if hoAutoResize in FOptions then - AdjustAutoSize(InvalidColumn); - if Assigned(Item) then - Invalidate(Item as TVirtualTreeColumn) - else - if Treeview.HandleAllocated then - begin - Treeview.UpdateHorizontalScrollBar(False); - Invalidate(nil); - Treeview.Invalidate; - end; - - if not (tsUpdating in Treeview.FStates) then - // This is mainly to let the designer know when a change occurs at design time which - // doesn't involve the object inspector (like column resizing with the mouse). - // This does NOT include design time code as the communication is done via an interface. - Treeview.UpdateDesigner; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.UpdatePositions(Force: Boolean = False); - -// Recalculates the left border of every column and updates their position property according to the -// PostionToIndex array which primarily determines where each column is placed visually. - -var - I, RunningPos: Integer; - -begin - if not (csDestroying in FHeader.Treeview.ComponentState) and not FNeedPositionsFix and (Force or (UpdateCount = 0)) then - begin - RunningPos := 0; - for I := 0 to High(FPositionToIndex) do - with Items[FPositionToIndex[I]] do - begin - FPosition := I; - FLeft := RunningPos; - if coVisible in FOptions then - Inc(RunningPos, FWidth); - end; - FHeader.Treeview.UpdateHorizontalScrollBar(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.Add: TVirtualTreeColumn; - -begin - Assert(GetCurrentThreadId = MainThreadId, 'UI controls may only be chnaged in UI thread.'); - Result := TVirtualTreeColumn(inherited Add); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.AnimatedResize(Column: TColumnIndex; NewWidth: Integer); - -// Resizes the given column animated by scrolling the window DC. - -var - OldWidth: Integer; - DC: HDC; - I, - Steps, - DX: Integer; - HeaderScrollRect, - ScrollRect, - R: TRect; - - NewBrush, - LastBrush: HBRUSH; - -begin - if not IsValidColumn(Column) then - Exit; // Just in case. - - // Make sure the width constrains are considered. - if NewWidth < Items[Column].FMinWidth then - NewWidth := Items[Column].FMinWidth; - if NewWidth > Items[Column].FMaxWidth then - NewWidth := Items[Column].FMaxWidth; - - OldWidth := Items[Column].Width; - // Nothing to do if the width is the same. - if OldWidth <> NewWidth then - begin - if not ( (hoDisableAnimatedResize in FHeader.Options) or - (coDisableAnimatedResize in Items[Column].Options) ) then - begin - DC := GetWindowDC(FHeader.Treeview.Handle); - with FHeader.Treeview do - try - Steps := 32; - DX := (NewWidth - OldWidth) div Steps; - - // Determination of the scroll rectangle is a bit complicated since we neither want - // to scroll the scrollbars nor the border of the treeview window. - HeaderScrollRect := FHeaderRect; - ScrollRect := HeaderScrollRect; - // Exclude the header itself from scrolling. - ScrollRect.Top := ScrollRect.Bottom; - ScrollRect.Bottom := ScrollRect.Top + ClientHeight; - ScrollRect.Right := ScrollRect.Left + ClientWidth; - with Items[Column] do - Inc(ScrollRect.Left, FLeft + FWidth); - HeaderScrollRect.Left := ScrollRect.Left; - HeaderScrollRect.Right := ScrollRect.Right; - - // When the new width is larger then avoid artefacts on the left hand side - // by deleting a small stripe - if NewWidth > OldWidth then - begin - R := ScrollRect; - NewBrush := CreateSolidBrush(ColorToRGB(Color)); - LastBrush := SelectObject(DC, NewBrush); - R.Right := R.Left + DX; - FillRect(DC, R, NewBrush); - SelectObject(DC, LastBrush); - DeleteObject(NewBrush); - end - else - begin - Inc(HeaderScrollRect.Left, DX); - Inc(ScrollRect.Left, DX); - end; - - for I := 0 to Steps - 1 do - begin - ScrollDC(DC, DX, 0, HeaderScrollRect, HeaderScrollRect, 0, nil); - Inc(HeaderScrollRect.Left, DX); - ScrollDC(DC, DX, 0, ScrollRect, ScrollRect, 0, nil); - Inc(ScrollRect.Left, DX); - Sleep(1); - end; - finally - ReleaseDC(Handle, DC); - end; - end; - Items[Column].Width := NewWidth; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.Assign(Source: TPersistent); - -begin - // Let the collection class assign the items. - inherited; - - if Source is TVirtualTreeColumns then - begin - // Copying the position array is the only needed task here. - FPositionToIndex := Copy(TVirtualTreeColumns(Source).FPositionToIndex, 0, MaxInt); - - // Make sure the left edges are correct after assignment. - FNeedPositionsFix := False; - UpdatePositions(True); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.Clear; - -begin - FClearing := True; - try - Header.Treeview.CancelEditNode; - - // Since we're freeing all columns, the following have to be true when we're done. - FHoverIndex := NoColumn; - FDownIndex := NoColumn; - FTrackIndex := NoColumn; - FClickIndex := NoColumn; - FCheckBoxHit := False; - - with Header do - if not (hsLoading in FStates) then - begin - FAutoSizeIndex := NoColumn; - FMainColumn := NoColumn; - FSortColumn := NoColumn; - end; - - with Header.Treeview do - if not (csLoading in ComponentState) then - FFocusedColumn := NoColumn; - - inherited Clear; - finally - FClearing := False; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.ColumnFromPosition(P: TPoint; Relative: Boolean = True): TColumnIndex; - -// Determines the current column based on the position passed in P. - -var - I, Sum: Integer; - -begin - Result := InvalidColumn; - - // The position must be within the header area, but we extend the vertical bounds to the entire treeview area. - if (P.X >= 0) and (P.Y >= 0) and (P.Y <= FHeader.TreeView.Height) then - with FHeader, Treeview do - begin - if Relative and (P.X >= GetVisibleFixedWidth) then - Sum := -FEffectiveOffsetX - else - Sum := 0; - - if UseRightToLeftAlignment then - Inc(Sum, ComputeRTLOffset(True)); - - for I := 0 to Count - 1 do - if coVisible in Items[FPositionToIndex[I]].FOptions then - begin - Inc(Sum, Items[FPositionToIndex[I]].Width); - if P.X < Sum then - begin - Result := FPositionToIndex[I]; - Break; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.ColumnFromPosition(PositionIndex: TColumnPosition): TColumnIndex; - -// Returns the index of the column at the given position. - -begin - if Integer(PositionIndex) < Length(FPositionToIndex) then - Result := FPositionToIndex[PositionIndex] - else - Result := NoColumn; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.Equals(OtherColumnsObj: TObject): Boolean; - -// Compares itself with the given set of columns and returns True if all published properties are the same -// (including column order), otherwise False is returned. - -var - I: Integer; - OtherColumns : TVirtualTreeColumns; - -begin - if not (OtherColumnsObj is TVirtualTreeColumns) then - begin - Result := False; - Exit; - end; - - OtherColumns := TVirtualTreeColumns (OtherColumnsObj); - - // Same number of columns? - Result := OtherColumns.Count = Count; - if Result then - begin - // Same order of columns? - Result := CompareMem(Pointer(FPositionToIndex), Pointer(OtherColumns.FPositionToIndex), - Length(FPositionToIndex) * SizeOf(TColumnIndex)); - if Result then - begin - for I := 0 to Count - 1 do - if not Items[I].Equals(OtherColumns[I]) then - begin - Result := False; - Break; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.GetColumnBounds(Column: TColumnIndex; var Left, Right: Integer); - -// Returns the left and right bound of the given column. If Column is NoColumn then the entire client width is returned. - -begin - if Column <= NoColumn then - begin - Left := 0; - Right := FHeader.Treeview.ClientWidth; - end - else - begin - Left := Items[Column].Left; - Right := Left + Items[Column].Width; - if FHeader.Treeview.UseRightToLeftAlignment then - begin - Inc(Left, FHeader.Treeview.ComputeRTLOffset(True)); - Inc(Right, FHeader.Treeview.ComputeRTLOffset(True)); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetScrollWidth: Integer; - -// Returns the average width of all visible, non-fixed columns. If there is no such column the indent is returned. - -var - I: Integer; - ScrollColumnCount: Integer; - -begin - - Result := 0; - - ScrollColumnCount := 0; - for I := 0 to FHeader.Columns.Count - 1 do - begin - if ([coVisible, coFixed] * FHeader.Columns[I].Options = [coVisible]) then - begin - Inc(Result, FHeader.Columns[I].Width); - Inc(ScrollColumnCount); - end; - end; - - if ScrollColumnCount > 0 then // use average width - Result := Round(Result / ScrollColumnCount) - else // use indent - Result := Integer(FHeader.Treeview.FIndent); - -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetFirstVisibleColumn(ConsiderAllowFocus: Boolean = False): TColumnIndex; - -// Returns the index of the first visible column or "InvalidColumn" if either no columns are defined or -// all columns are hidden. -// If ConsiderAllowFocus is True then the column has not only to be visible but also focus has to be allowed. - -var - I: Integer; - -begin - Result := InvalidColumn; - if (UpdateCount > 0) or (csLoading in Header.TreeView.ComponentState) then - exit; // See issue #760 - for I := 0 to Count - 1 do - if (coVisible in Items[FPositionToIndex[I]].FOptions) and - ( (not ConsiderAllowFocus) or - (coAllowFocus in Items[FPositionToIndex[I]].FOptions) - ) then - begin - Result := FPositionToIndex[I]; - Break; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetLastVisibleColumn(ConsiderAllowFocus: Boolean = False): TColumnIndex; - -// Returns the index of the last visible column or "InvalidColumn" if either no columns are defined or -// all columns are hidden. -// If ConsiderAllowFocus is True then the column has not only to be visible but also focus has to be allowed. - -var - I: Integer; - -begin - Result := InvalidColumn; - if (UpdateCount > 0) or (csLoading in Header.TreeView.ComponentState) then - exit; // See issue #760 - for I := Count - 1 downto 0 do - if (coVisible in Items[FPositionToIndex[I]].FOptions) and - ( (not ConsiderAllowFocus) or - (coAllowFocus in Items[FPositionToIndex[I]].FOptions) - ) then - begin - Result := FPositionToIndex[I]; - Break; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetFirstColumn: TColumnIndex; - -// Returns the first column in display order. - -begin - if Count = 0 then - Result := InvalidColumn - else - Result := FPositionToIndex[0]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetNextColumn(Column: TColumnIndex): TColumnIndex; - -// Returns the next column in display order. Column is the index of an item in the collection (a column). - -var - Position: Integer; - -begin - if Column < 0 then - Result := InvalidColumn - else - begin - Position := Items[Column].Position; - if Position < Count - 1 then - Result := FPositionToIndex[Position + 1] - else - Result := InvalidColumn; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetNextVisibleColumn(Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex; - -// Returns the next visible column in display order, Column is an index into the columns list. -// If ConsiderAllowFocus is True then the column has not only to be visible but also focus has to be allowed. - -begin - Result := Column; - repeat - Result := GetNextColumn(Result); - until (Result = InvalidColumn) or - ( (coVisible in Items[Result].FOptions) and - ( (not ConsiderAllowFocus) or - (coAllowFocus in Items[Result].FOptions) - ) - ); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetPreviousColumn(Column: TColumnIndex): TColumnIndex; - -// Returns the previous column in display order, Column is an index into the columns list. - -var - Position: Integer; - -begin - if Column < 0 then - Result := InvalidColumn - else - begin - Position := Items[Column].Position; - if Position > 0 then - Result := FPositionToIndex[Position - 1] - else - Result := InvalidColumn; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetPreviousVisibleColumn(Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex; - -// Returns the previous visible column in display order, Column is an index into the columns list. -// If ConsiderAllowFocus is True then the column has not only to be visible but also focus has to be allowed. - -begin - Result := Column; - repeat - Result := GetPreviousColumn(Result); - until (Result = InvalidColumn) or - ( (coVisible in Items[Result].FOptions) and - ( (not ConsiderAllowFocus) or - (coAllowFocus in Items[Result].FOptions) - ) - ); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetVisibleColumns: TColumnsArray; - -// Returns a list of all currently visible columns in actual order. - -var - I, Counter: Integer; - -begin - SetLength(Result, Count); - Counter := 0; - - for I := 0 to Count - 1 do - if coVisible in Items[FPositionToIndex[I]].FOptions then - begin - Result[Counter] := Items[FPositionToIndex[I]]; - Inc(Counter); - end; - // Set result length to actual visible count. - SetLength(Result, Counter); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.GetVisibleFixedWidth: Integer; - -// Determines the horizontal space all visible and fixed columns occupy. - -var - I: Integer; - -begin - Result := 0; - for I := 0 to Count - 1 do - begin - if Items[I].Options * [coVisible, coFixed] = [coVisible, coFixed] then - Inc(Result, Items[I].Width); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.IsValidColumn(Column: TColumnIndex): Boolean; - -// Determines whether the given column is valid or not, that is, whether it is one of the current columns. - -begin - Result := (Column > NoColumn) and (Column < Count); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.LoadFromStream(const Stream: TStream; Version: Integer); - -var - I, - ItemCount: Integer; - -begin - Clear; - Stream.ReadBuffer(ItemCount, SizeOf(ItemCount)); - // number of columns - if ItemCount > 0 then - begin - BeginUpdate; - try - for I := 0 to ItemCount - 1 do - Add.LoadFromStream(Stream, Version); - SetLength(FPositionToIndex, ItemCount); - Stream.ReadBuffer(FPositionToIndex[0], ItemCount * SizeOf(TColumnIndex)); - UpdatePositions(True); - finally - EndUpdate; - end; - end; - - // Data introduced with header stream version 5 - if Version > 4 then - Stream.ReadBuffer(FDefaultWidth, SizeOf(FDefaultWidth)); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.PaintHeader(DC: HDC; R: TRect; HOffset: Integer); - -// Backward compatible header paint method. This method takes care of visually moving floating columns - -var - VisibleFixedWidth: Integer; - RTLOffset: Integer; - - procedure PaintFixedArea; - - begin - if VisibleFixedWidth > 0 then - PaintHeader(FHeaderBitmap.Canvas, - Rect(0, 0, Min(R.Right, VisibleFixedWidth), R.Bottom - R.Top), - Point(R.Left, R.Top), RTLOffset); - end; - -begin - // Adjust size of the header bitmap - with TWithSafeRect(FHeader.Treeview.FHeaderRect) do - begin - FHeaderBitmap.SetSize(Max(Right, R.Right - R.Left), Bottom); - end; - - VisibleFixedWidth := GetVisibleFixedWidth; - - // Consider right-to-left directionality. - if FHeader.TreeView.UseRightToLeftAlignment then - RTLOffset := FHeader.Treeview.ComputeRTLOffset - else - RTLOffset := 0; - - if RTLOffset = 0 then - PaintFixedArea; - - // Paint the floating part of the header. - PaintHeader(FHeaderBitmap.Canvas, - Rect(VisibleFixedWidth - HOffset, 0, R.Right + VisibleFixedWidth - HOffset, R.Bottom - R.Top), - Point(R.Left + VisibleFixedWidth, R.Top), RTLOffset); - - // In case of right-to-left directionality we paint the fixed part last. - if RTLOffset <> 0 then - PaintFixedArea; - - // Blit the result to target. - with TWithSafeRect(R) do - BitBlt(DC, Left, Top, Right - Left, Bottom - Top, FHeaderBitmap.Canvas.Handle, Left, Top, SRCCOPY); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.PaintHeader(TargetCanvas: TCanvas; R: TRect; const Target: TPoint; - RTLOffset: Integer = 0); - -// Main paint method to draw the header. -// This procedure will paint the a slice (given in R) out of HeaderRect into TargetCanvas starting at position Target. -// This function does not offer the option to visually move floating columns due to scrolling. To accomplish this you -// need to call this method twice. - -var - Run: TColumnIndex; - RightBorderFlag, - NormalButtonStyle, - NormalButtonFlags, - PressedButtonStyle, - PressedButtonFlags, - RaisedButtonStyle, - RaisedButtonFlags: Cardinal; - Images: TCustomImageList; - OwnerDraw, - AdvancedOwnerDraw: Boolean; - PaintInfo: THeaderPaintInfo; - RequestedElements, - ActualElements: THeaderPaintElements; - - //--------------- local functions ------------------------------------------- - - procedure PrepareButtonStyles; - - // Prepare the button styles and flags for later usage. - - begin - RaisedButtonStyle := 0; - RaisedButtonFlags := 0; - case FHeader.Style of - hsThickButtons: - begin - NormalButtonStyle := BDR_RAISEDINNER or BDR_RAISEDOUTER; - NormalButtonFlags := BF_LEFT or BF_TOP or BF_BOTTOM or BF_MIDDLE or BF_SOFT or BF_ADJUST; - PressedButtonStyle := BDR_RAISEDINNER or BDR_RAISEDOUTER; - PressedButtonFlags := NormalButtonFlags or BF_RIGHT or BF_FLAT or BF_ADJUST; - end; - hsFlatButtons: - begin - NormalButtonStyle := BDR_RAISEDINNER; - NormalButtonFlags := BF_LEFT or BF_TOP or BF_BOTTOM or BF_MIDDLE or BF_ADJUST; - PressedButtonStyle := BDR_SUNKENOUTER; - PressedButtonFlags := BF_RECT or BF_MIDDLE or BF_ADJUST; - end; - else - // hsPlates or hsXPStyle, values are not used in the latter case - begin - NormalButtonStyle := BDR_RAISEDINNER; - NormalButtonFlags := BF_RECT or BF_MIDDLE or BF_SOFT or BF_ADJUST; - PressedButtonStyle := BDR_SUNKENOUTER; - PressedButtonFlags := BF_RECT or BF_MIDDLE or BF_ADJUST; - RaisedButtonStyle := BDR_RAISEDINNER; - RaisedButtonFlags := BF_LEFT or BF_TOP or BF_BOTTOM or BF_MIDDLE or BF_ADJUST; - end; - end; - end; - - //--------------------------------------------------------------------------- - - procedure DrawBackground; - - // Draw the header background. - - var - BackgroundRect: TRect; - Details: TThemedElementDetails; - Theme: HTheme; - begin - BackgroundRect := Rect(Target.X, Target.Y, Target.X + R.Right - R.Left, Target.Y + FHeader.Height); - - with TargetCanvas do - begin - if hpeBackground in RequestedElements then - begin - PaintInfo.PaintRectangle := BackgroundRect; - FHeader.Treeview.DoAdvancedHeaderDraw(PaintInfo, [hpeBackground]); - end - else - begin - if (FHeader.Treeview.VclStyleEnabled and (seClient in FHeader.FOwner.StyleElements)) then - begin - Details := StyleServices.GetElementDetails(thHeaderItemRightNormal); - StyleServices.DrawElement(Handle, Details, BackgroundRect, @BackgroundRect); - end - else - if tsUseThemes in FHeader.Treeview.FStates then - begin - Theme := OpenThemeData(FHeader.Treeview.Handle, 'HEADER'); - DrawThemeBackground(Theme, Handle, HP_HEADERITEM, HIS_NORMAL, BackgroundRect, nil); - CloseThemeData(THeme); - end - else - begin - Brush.Color := FHeader.FBackgroundColor; - FillRect(BackgroundRect); - end; - end; - end; - end; - - //--------------------------------------------------------------------------- - - procedure PaintColumnHeader(AColumn: TColumnIndex; ATargetRect: TRect); - - // Draw a single column to TargetRect. The clipping rect needs to be set before - // this procedure is called. - - var - SavedDC: Integer; - ColCaptionText: string; - ColImageInfo: TVTImageInfo; - Glyph: TThemedHeader; - Details: TThemedElementDetails; - WrapCaption: Boolean; - DrawFormat: Cardinal; - Pos: TRect; - DrawHot: Boolean; - ImageWidth: Integer; - Theme: HTheme; - IdState: Integer; - begin - ColImageInfo.Ghosted := False; - PaintInfo.Column := Items[AColumn]; - with PaintInfo, Column do - begin - IsHoverIndex := (AColumn = FHoverIndex) and (hoHotTrack in FHeader.FOptions) and (coEnabled in FOptions); - IsDownIndex := (AColumn = FDownIndex) and not FCheckBoxHit; - - if (coShowDropMark in FOptions) and (AColumn = FDropTarget) and (AColumn <> FDragIndex) then - begin - if FDropBefore then - DropMark := dmmLeft - else - DropMark := dmmRight; - end - else - DropMark := dmmNone; - - //Fix for issue 643 - //Do not show the left drop mark if the position to drop is just preceding the target which means - //the dragged column will stay where it is - if (DropMark = dmmLeft) and (Items[FDragIndex].Position = TColumnPosition(Max(Integer(Items[FDropTarget].Position) - 1, 0))) - then - DropMark := dmmNone - else - //Do not show the right drop mark if the position to drop is just following the target which means - //the dragged column will stay where it is - if (DropMark = dmmRight) and (Items[FDragIndex].Position = Items[FDropTarget].Position + 1) - then - DropMark := dmmNone; - - IsEnabled := (coEnabled in FOptions) and (FHeader.Treeview.Enabled); - ShowHeaderGlyph := (hoShowImages in FHeader.FOptions) and ((Assigned(Images) and (FImageIndex > -1)) or FCheckBox); - ShowSortGlyph := (AColumn = FHeader.FSortColumn) and (hoShowSortGlyphs in FHeader.FOptions); - WrapCaption := coWrapCaption in FOptions; - - PaintRectangle := ATargetRect; - - // This path for text columns or advanced owner draw. - if (Style = vsText) or not OwnerDraw or AdvancedOwnerDraw then - begin - // See if the application wants to draw part of the header itself. - RequestedElements := []; - if AdvancedOwnerDraw then - begin - PaintInfo.Column := Items[AColumn]; - FHeader.Treeview.DoHeaderDrawQueryElements(PaintInfo, RequestedElements); - end; - - if ShowRightBorder or (AColumn < Count - 1) then - RightBorderFlag := BF_RIGHT - else - RightBorderFlag := 0; - - if hpeBackground in RequestedElements then - FHeader.Treeview.DoAdvancedHeaderDraw(PaintInfo, [hpeBackground]) - else - begin - if FHeader.Treeview.VclStyleEnabled and (seClient in FHeader.FOwner.StyleElements) then - begin - if IsDownIndex then - Details := StyleServices.GetElementDetails(thHeaderItemPressed) - else - if IsHoverIndex then - Details := StyleServices.GetElementDetails(thHeaderItemHot) - else - Details := StyleServices.GetElementDetails(thHeaderItemNormal); - StyleServices.DrawElement(TargetCanvas.Handle, Details, PaintRectangle, @PaintRectangle); - end - else - begin - if tsUseThemes in FHeader.Treeview.FStates then - begin - Theme := OpenThemeData(FHeader.Treeview.Handle, 'HEADER'); - if IsDownIndex then - IdState := HIS_PRESSED - else - if IsHoverIndex then - IdState := HIS_HOT - else - IdState := HIS_NORMAL; - DrawThemeBackground(Theme, TargetCanvas.Handle, HP_HEADERITEM, IdState, PaintRectangle, nil); - CloseThemeData(Theme); - end - else - if IsDownIndex then - DrawEdge(TargetCanvas.Handle, PaintRectangle, PressedButtonStyle, PressedButtonFlags) - else - // Plates have the special case of raising on mouse over. - if (FHeader.Style = hsPlates) and IsHoverIndex and - (coAllowClick in FOptions) and (coEnabled in FOptions) then - DrawEdge(TargetCanvas.Handle, PaintRectangle, RaisedButtonStyle, - RaisedButtonFlags or RightBorderFlag) - else - DrawEdge(TargetCanvas.Handle, PaintRectangle, NormalButtonStyle, - NormalButtonFlags or RightBorderFlag); - end; - end; - - PaintRectangle := ATargetRect; - - // calculate text and glyph position - InflateRect(PaintRectangle, -2, -2); - DrawFormat := DT_TOP or DT_NOPREFIX; - case CaptionAlignment of - taLeftJustify : DrawFormat := DrawFormat or DT_LEFT; - taRightJustify : DrawFormat := DrawFormat or DT_RIGHT; - taCenter : DrawFormat := DrawFormat or DT_CENTER; - end; - if UseRightToLeftReading then - DrawFormat := DrawFormat + DT_RTLREADING; - ComputeHeaderLayout(PaintInfo, DrawFormat); - - // Move glyph and text one pixel to the right and down to simulate a pressed button. - if IsDownIndex then - begin - OffsetRect(TextRectangle, 1, 1); - Inc(GlyphPos.X); - Inc(GlyphPos.Y); - Inc(SortGlyphPos.X); - Inc(SortGlyphPos.Y); - end; - - // Advanced owner draw allows to paint elements, which would normally not be painted (because of space - // limitations, empty captions etc.). - ActualElements := RequestedElements * [hpeHeaderGlyph, hpeSortGlyph, hpeDropMark, hpeText, hpeOverlay]; - - // main glyph - FHasImage := False; - if Assigned(Images) then - ImageWidth := Images.Width - else - ImageWidth := 0; - - if not (hpeHeaderGlyph in ActualElements) and ShowHeaderGlyph and - (not ShowSortGlyph or (FBiDiMode <> bdLeftToRight) or (GlyphPos.X + ImageWidth <= SortGlyphPos.X) ) then - begin - if not FCheckBox then - begin - ColImageInfo.Images := Images; - Images.Draw(TargetCanvas, GlyphPos.X, GlyphPos.Y, FImageIndex, IsEnabled); - end - else - begin - with Header.Treeview do - begin - ColImageInfo.Images := FCheckImages; - ColImageInfo.Index := GetCheckImage(nil, FCheckType, FCheckState, IsEnabled); - ColImageInfo.XPos := GlyphPos.X; - ColImageInfo.YPos := GlyphPos.Y; - PaintCheckImage(TargetCanvas, ColImageInfo, False); - end; - end; - - FHasImage := True; - with TWithSafeRect(FImageRect) do - begin - Left := GlyphPos.X; - Top := GlyphPos.Y; - Right := Left + ColImageInfo.Images.Width; - Bottom := Top + ColImageInfo.Images.Height; - end; - end; - - // caption - if WrapCaption then - ColCaptionText := FCaptionText - else - ColCaptionText := Text; - if IsHoverIndex and FHeader.Treeview.VclStyleEnabled then - DrawHot := True - else - DrawHot := (IsHoverIndex and (hoHotTrack in FHeader.FOptions) and not(tsUseThemes in FHeader.Treeview.FStates)); - if not(hpeText in ActualElements) and (Length(Text) > 0) then - DrawButtonText(TargetCanvas.Handle, ColCaptionText, TextRectangle, IsEnabled, DrawHot, DrawFormat, WrapCaption); - - // sort glyph - if not (hpeSortGlyph in ActualElements) and ShowSortGlyph then - begin - if tsUseExplorerTheme in FHeader.Treeview.FStates then - begin - Pos.TopLeft := SortGlyphPos; - Pos.Right := Pos.Left + SortGlyphSize.cx; - Pos.Bottom := Pos.Top + SortGlyphSize.cy; - if FHeader.FSortDirection = sdAscending then - Glyph := thHeaderSortArrowSortedUp - else - Glyph := thHeaderSortArrowSortedDown; - Details := StyleServices.GetElementDetails(Glyph); - StyleServices.DrawElement(TargetCanvas.Handle, Details, Pos, @Pos); - end - else - begin - PaintInfo.DrawSortArrow(FHeader.FSortDirection); - end; - end; - - // Show an indication if this column is the current drop target in a header drag operation. - if not (hpeDropMark in ActualElements) and (DropMark <> dmmNone) then - begin - PaintInfo.DrawDropMark(); - end; - - if ActualElements <> [] then - begin - SavedDC := SaveDC(TargetCanvas.Handle); - FHeader.Treeview.DoAdvancedHeaderDraw(PaintInfo, ActualElements); - RestoreDC(TargetCanvas.Handle, SavedDC); - end; - end - else // Let application draw the header. - FHeader.Treeview.DoHeaderDraw(TargetCanvas, Items[AColumn], PaintRectangle, IsHoverIndex, IsDownIndex, - DropMark); - end; - end; - - //--------------- end local functions --------------------------------------- - -var - TargetRect: TRect; - MaxX: Integer; - -begin - if IsRectEmpty(R) then - Exit; - - // If both draw posibillities are specified then prefer the advanced way. - AdvancedOwnerDraw := (hoOwnerDraw in FHeader.FOptions) and Assigned(FHeader.Treeview.FOnAdvancedHeaderDraw) and - Assigned(FHeader.Treeview.FOnHeaderDrawQueryElements) and not (csDesigning in FHeader.Treeview.ComponentState); - OwnerDraw := (hoOwnerDraw in FHeader.FOptions) and Assigned(FHeader.Treeview.FOnHeaderDraw) and - not (csDesigning in FHeader.Treeview.ComponentState) and not AdvancedOwnerDraw; - - ZeroMemory(@PaintInfo, SizeOf(PaintInfo)); - PaintInfo.TargetCanvas := TargetCanvas; - - with PaintInfo, TargetCanvas do - begin - // Use shortcuts for the images and the font. - Images := FHeader.FImages; - Font := FHeader.FFont; - - PrepareButtonStyles; - - // At first, query the application which parts of the header it wants to draw on its own. - RequestedElements := []; - if AdvancedOwnerDraw then - begin - PaintRectangle := R; - Column := nil; - FHeader.Treeview.DoHeaderDrawQueryElements(PaintInfo, RequestedElements); - end; - - // Draw the background. - DrawBackground; - - // Now that we have drawn the background, we apply the header's dimensions to R. - R := Rect(Max(R.Left, 0), Max(R.Top, 0), Min(R.Right, TotalWidth), Min(R.Bottom, Header.Height)); - - // Determine where to stop. - MaxX := Target.X + R.Right - R.Left - //Fixes issues #544, #427 -- MaxX should also shift on BidiMode bdRightToLeft - + RTLOffset; //added for fix - - // Determine the start column. - Run := ColumnFromPosition(Point(R.Left + RTLOffset, 0), False); - if Run <= NoColumn then - Exit; - - TargetRect.Top := Target.Y; - TargetRect.Bottom := Target.Y + R.Bottom - R.Top; - TargetRect.Left := Target.X - R.Left + Items[Run].FLeft + RTLOffset; - // TargetRect.Right will be set in the loop - - ShowRightBorder := (FHeader.Style = hsThickButtons) or not (hoAutoResize in FHeader.FOptions) or - (FHeader.Treeview.BevelKind = bkNone); - - // Now go for each button. - while (Run > NoColumn) and (TargetRect.Left < MaxX) do - begin - TargetRect.Right := TargetRect.Left + Items[Run].FWidth; - - // create a clipping rect to limit painting to button area - ClipCanvas(TargetCanvas, Rect(Max(TargetRect.Left, Target.X), Target.Y + R.Top, - Min(TargetRect.Right, MaxX), TargetRect.Bottom)); - - PaintColumnHeader(Run, TargetRect); - - SelectClipRgn(Handle, 0); - - TargetRect.Left := TargetRect.Right; - Run := GetNextVisibleColumn(Run); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualTreeColumns.SaveToStream(const Stream: TStream); - -var - I: Integer; - -begin - I := Count; - Stream.WriteBuffer(I, SizeOf(I)); - if I > 0 then - begin - for I := 0 to Count - 1 do - TVirtualTreeColumn(Items[I]).SaveToStream(Stream); - - Stream.WriteBuffer(FPositionToIndex[0], Count * SizeOf(TColumnIndex)); - end; - - // Data introduced with header stream version 5. - Stream.WriteBuffer(DefaultWidth, SizeOf(DefaultWidth)); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualTreeColumns.TotalWidth: Integer; - -var - LastColumn: TColumnIndex; - -begin - Result := 0; - if (Count > 0) and (Length(FPositionToIndex) > 0) then - begin - LastColumn := FPositionToIndex[Count - 1]; - if not (coVisible in Items[LastColumn].FOptions) then - LastColumn := GetPreviousVisibleColumn(LastColumn); - if LastColumn > NoColumn then - with Items[LastColumn] do - Result := FLeft + FWidth; - end; -end; - -//----------------- TVTFixedAreaConstraints ---------------------------------------------------------------------------- - -constructor TVTFixedAreaConstraints.Create(AOwner: TVTHeader); - -begin - inherited Create; - - FHeader := AOwner; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTFixedAreaConstraints.SetConstraints(Index: Integer; Value: TVTConstraintPercent); - -begin - case Index of - 0: - if Value <> FMaxHeightPercent then - begin - FMaxHeightPercent := Value; - if (Value > 0) and (Value < FMinHeightPercent) then - FMinHeightPercent := Value; - Change; - end; - 1: - if Value <> FMaxWidthPercent then - begin - FMaxWidthPercent := Value; - if (Value > 0) and (Value < FMinWidthPercent) then - FMinWidthPercent := Value; - Change; - end; - 2: - if Value <> FMinHeightPercent then - begin - FMinHeightPercent := Value; - if (FMaxHeightPercent > 0) and (Value > FMaxHeightPercent) then - FMaxHeightPercent := Value; - Change; - end; - 3: - if Value <> FMinWidthPercent then - begin - FMinWidthPercent := Value; - if (FMaxWidthPercent > 0) and (Value > FMaxWidthPercent) then - FMaxWidthPercent := Value; - Change; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTFixedAreaConstraints.Change; - -begin - if Assigned(FOnChange) then - FOnChange(Self); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTFixedAreaConstraints.Assign(Source: TPersistent); - -begin - if Source is TVTFixedAreaConstraints then - begin - FMaxHeightPercent := TVTFixedAreaConstraints(Source).FMaxHeightPercent; - FMaxWidthPercent := TVTFixedAreaConstraints(Source).FMaxWidthPercent; - FMinHeightPercent := TVTFixedAreaConstraints(Source).FMinHeightPercent; - FMinWidthPercent := TVTFixedAreaConstraints(Source).FMinWidthPercent; - Change; - end - else - inherited; -end; - -//----------------- TVTHeader ----------------------------------------------------------------------------------------- - -constructor TVTHeader.Create(AOwner: TBaseVirtualTree); - -begin - inherited Create; - FOwner := AOwner; - FColumns := GetColumnsClass.Create(Self); - FHeight := 19; - FDefaultHeight := FHeight; - FMinHeight := 10; - FMaxHeight := 10000; - FFont := TFont.Create; - FFont.OnChange := FontChanged; - FParentFont := True; - FBackgroundColor := clBtnFace; - FOptions := [hoColumnResize, hoDrag, hoShowSortGlyphs]; - - FImageChangeLink := TChangeLink.Create; - FImageChangeLink.OnChange := ImageListChange; - - FSortColumn := NoColumn; - FSortDirection := sdAscending; - 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; - - FDoingAutoFitColumns := false; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -destructor TVTHeader.Destroy; - -begin - FDragImage.Free; - FFixedAreaConstraints.Free; - FImageChangeLink.Free; - FFont.Free; - FColumns.Clear; // TCollection's Clear method is not virtual, so we have to call our own Clear method manually. - FColumns.Free; - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.FontChanged(Sender: TObject); -var - I: Integer; - lMaxHeight: Integer; -begin - if toAutoChangeScale in Treeview.TreeOptions.AutoOptions then - begin - // Find the largest Columns[].Spacing - lMaxHeight := 0; - for I := 0 to Self.Columns.Count - 1 do - lMaxHeight := Max(lMaxHeight, Columns[I].Spacing); - // Calculate the required size based on the font, this is important as the use migth just vave increased the size of the icon font - with TBitmap.Create do - try - Canvas.Font.Assign(FFont); - lMaxHeight := lMaxHeight {top spacing} + (lMaxHeight div 2) {minimum bottom spacing} + Canvas.TextHeight('Q'); - finally - Free; - end; - // Get the maximum of the scaled original value an - lMaxHeight := Max(lMaxHeight, FHeight); - // Set the calculated size - Self.SetHeight(lMaxHeight); - end; - Invalidate(nil); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.GetMainColumn: TColumnIndex; - -begin - if FColumns.Count > 0 then - Result := FMainColumn - else - Result := NoColumn; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.GetUseColumns: Boolean; - -begin - Result := FColumns.Count > 0; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.IsFontStored: Boolean; - -begin - Result := not ParentFont; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetAutoSizeIndex(Value: TColumnIndex); - -begin - if FAutoSizeIndex <> Value then - begin - FAutoSizeIndex := Value; - if hoAutoResize in FOptions then - Columns.AdjustAutoSize(InvalidColumn); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetBackground(Value: TColor); - -begin - if FBackgroundColor <> Value then - begin - FBackgroundColor := Value; - Invalidate(nil); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetColumns(Value: TVirtualTreeColumns); - -begin - FColumns.Assign(Value); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetDefaultHeight(Value: Integer); - -begin - if Value < FMinHeight then - Value := FMinHeight; - if Value > FMaxHeight then - Value := FMaxHeight; - - if FHeight = FDefaultHeight then - SetHeight(Value); - FDefaultHeight := Value; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetFont(const Value: TFont); - -begin - FFont.Assign(Value); - FParentFont := False; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetHeight(Value: Integer); - -var - RelativeMaxHeight, - RelativeMinHeight, - EffectiveMaxHeight, - EffectiveMinHeight: Integer; - -begin - if not TreeView.HandleAllocated then - begin - FHeight := Value; - Include(FStates, hsNeedScaling); - end - else - begin - with FFixedAreaConstraints do - begin - RelativeMaxHeight := ((Treeview.ClientHeight + FHeight) * FMaxHeightPercent) div 100; - RelativeMinHeight := ((Treeview.ClientHeight + FHeight) * FMinHeightPercent) div 100; - - EffectiveMinHeight := IfThen(FMaxHeightPercent > 0, Min(RelativeMaxHeight, FMinHeight), FMinHeight); - EffectiveMaxHeight := IfThen(FMinHeightPercent > 0, Max(RelativeMinHeight, FMaxHeight), FMaxHeight); - - Value := Min(Max(Value, EffectiveMinHeight), EffectiveMaxHeight); - if FMinHeightPercent > 0 then - Value := Max(RelativeMinHeight, Value); - if FMaxHeightPercent > 0 then - Value := Min(RelativeMaxHeight, Value); - end; - - if FHeight <> Value then - begin - FHeight := Value; - if not (csLoading in Treeview.ComponentState) and not (hsScaling in FStates) then - RecalculateHeader; - Treeview.Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetImages(const Value: TCustomImageList); - -begin - if FImages <> Value then - begin - if Assigned(FImages) then - begin - FImages.UnRegisterChanges(FImageChangeLink); - FImages.RemoveFreeNotification(FOwner); - end; - FImages := Value; - if Assigned(FImages) then - begin - FImages.RegisterChanges(FImageChangeLink); - FImages.FreeNotification(FOwner); - end; - if not (csLoading in Treeview.ComponentState) then - Invalidate(nil); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetMainColumn(Value: TColumnIndex); - -begin - if csLoading in Treeview.ComponentState then - FMainColumn := Value - else - begin - if Value < 0 then - Value := 0; - if Value > FColumns.Count - 1 then - Value := FColumns.Count - 1; - if Value <> FMainColumn then - begin - FMainColumn := Value; - if not (csLoading in Treeview.ComponentState) then - begin - Treeview.MainColumnChanged; - if not (toExtendedFocus in Treeview.FOptions.FSelectionOptions) then - Treeview.FocusedColumn := FMainColumn; - Treeview.Invalidate; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetMaxHeight(Value: Integer); - -begin - if Value < FMinHeight then - Value := FMinHeight; - FMaxHeight := Value; - SetHeight(FHeight); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetMinHeight(Value: Integer); - -begin - if Value < 0 then - Value := 0; - if Value > FMaxHeight then - Value := FMaxHeight; - FMinHeight := Value; - SetHeight(FHeight); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetOptions(Value: TVTHeaderOptions); - -var - ToBeSet, - ToBeCleared: TVTHeaderOptions; - -begin - ToBeSet := Value - FOptions; - ToBeCleared := FOptions - Value; - FOptions := Value; - - if (hoAutoResize in (ToBeSet + ToBeCleared)) and (FColumns.Count > 0) then - begin - FColumns.AdjustAutoSize(InvalidColumn); - if Treeview.HandleAllocated then - begin - Treeview.UpdateHorizontalScrollBar(False); - if hoAutoResize in ToBeSet then - Treeview.Invalidate; - end; - end; - - if not (csLoading in Treeview.ComponentState) and Treeview.HandleAllocated then - begin - if hoVisible in (ToBeSet + ToBeCleared) then - RecalculateHeader; - Invalidate(nil); - Treeview.Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetParentFont(Value: Boolean); - -begin - if FParentFont <> Value then - begin - FParentFont := Value; - if FParentFont then - FFont.Assign(FOwner.Font); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetSortColumn(Value: TColumnIndex); - -begin - if csLoading in Treeview.ComponentState then - FSortColumn := Value - else - DoSetSortColumn(Value, FSortDirection); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetSortDirection(const Value: TSortDirection); - -begin - if Value <> FSortDirection then - begin - FSortDirection := Value; - Invalidate(nil); - if ((toAutoSort in Treeview.FOptions.FAutoOptions) or (hoHeaderClickAutoSort in Options)) and (Treeview.FUpdateCount = 0) then - Treeview.SortTree(FSortColumn, FSortDirection, True); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.CanSplitterResize(P: TPoint): Boolean; - -begin - Result := hoHeightResize in FOptions; - DoCanSplitterResize(P, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SetStyle(Value: TVTHeaderStyle); - -begin - if FStyle <> Value then - begin - FStyle := Value; - if not (csLoading in Treeview.ComponentState) then - Invalidate(nil); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.CanWriteColumns: Boolean; - -// descendants may override this to optionally prevent column writing (e.g. if they are build dynamically). - -begin - Result := True; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.ChangeScale(M, D: Integer); -var - I: Integer; -begin - // This method is only executed if toAutoChangeScale is set - Self.Height := MulDiv(FHeight, M, D); - if not ParentFont then - Font.Height := MulDiv(Font.Height, M, D); - // Scale the columns widths too - for I := 0 to FColumns.Count - 1 do - begin - Self.FColumns[I].Width := MulDiv(Self.FColumns[I].Width, M, D); - end;//for I -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.DetermineSplitterIndex(P: TPoint): Boolean; - -// Tries to find the index of that column whose right border corresponds to P. -// Result is True if column border was hit (with -3..+5 pixels tolerance). -// For continuous resizing the current track index and the column's left/right border are set. -// Note: The hit test is checking from right to left (or left to right in RTL mode) to make enlarging of zero-sized -// columns possible. - -var - VisibleFixedWidth: Integer; - SplitPoint: Integer; - - //--------------- local function -------------------------------------------- - - function IsNearBy(IsFixedCol: Boolean; LeftTolerance, RightTolerance: Integer): Boolean; - - begin - if IsFixedCol then - Result := (P.X < SplitPoint + Treeview.FEffectiveOffsetX + RightTolerance) and (P.X > SplitPoint + Treeview.FEffectiveOffsetX - LeftTolerance) - else - Result := (P.X > VisibleFixedWidth) and (P.X < SplitPoint + RightTolerance) and (P.X > SplitPoint - LeftTolerance); - end; - - //--------------- end local function ---------------------------------------- - -var - I: Integer; - LeftTolerance: Integer; // The area left of the column divider which allows column resizing -begin - Result := False; - - if FColumns.Count > 0 then - begin - FColumns.FTrackIndex := NoColumn; - VisibleFixedWidth := FColumns.GetVisibleFixedWidth; - LeftTolerance := Round(SplitterHitTolerance * 0.6); - if Treeview.UseRightToLeftAlignment then - begin - SplitPoint := -Treeview.FEffectiveOffsetX; - if FColumns.TotalWidth < Treeview.ClientWidth then - Inc(SplitPoint, Treeview.ClientWidth - FColumns.TotalWidth); - - for I := 0 to FColumns.Count - 1 do - with FColumns, Items[FPositionToIndex[I]] do - if coVisible in FOptions then - begin - if IsNearBy(coFixed in FOptions, LeftTolerance, SplitterHitTolerance - LeftTolerance) then - begin - if CanSplitterResize(P, FPositionToIndex[I]) then - begin - Result := True; - FTrackIndex := FPositionToIndex[I]; - - // Keep the right border of this column. This and the current mouse position - // directly determine the current column width. - FTrackPoint.X := SplitPoint + IfThen(coFixed in FOptions, Treeview.FEffectiveOffsetX) + FWidth; - FTrackPoint.Y := P.Y; - Break; - end; - end; - Inc(SplitPoint, FWidth); - end; - end - else - begin - SplitPoint := -Treeview.FEffectiveOffsetX + FColumns.TotalWidth; - - for I := FColumns.Count - 1 downto 0 do - with FColumns, Items[FPositionToIndex[I]] do - if coVisible in FOptions then - begin - if IsNearBy(coFixed in FOptions, SplitterHitTolerance - LeftTolerance, LeftTolerance) then - begin - if CanSplitterResize(P, FPositionToIndex[I]) then - begin - Result := True; - FTrackIndex := FPositionToIndex[I]; - - // Keep the left border of this column. This and the current mouse position - // directly determine the current column width. - FTrackPoint.X := SplitPoint + IfThen(coFixed in FOptions, Treeview.FEffectiveOffsetX) - FWidth; - FTrackPoint.Y := P.Y; - Break; - end; - end; - Dec(SplitPoint, FWidth); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.DoAfterAutoFitColumn(Column: TColumnIndex); - -begin - if Assigned(TreeView.FOnAfterAutoFitColumn) then - TreeView.FOnAfterAutoFitColumn(Self, Column); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.DoAfterColumnWidthTracking(Column: TColumnIndex); - -// Tell the application that a column width tracking operation has been finished. - -begin - if Assigned(TreeView.FOnAfterColumnWidthTracking) then - TreeView.FOnAfterColumnWidthTracking(Self, Column); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.DoAfterHeightTracking; - -// Tell the application that a height tracking operation has been finished. - -begin - if Assigned(TreeView.FOnAfterHeaderHeightTracking) then - TreeView.FOnAfterHeaderHeightTracking(Self); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.DoBeforeAutoFitColumn(Column: TColumnIndex; SmartAutoFitType: TSmartAutoFitType): Boolean; - -// Query the application if we may autofit a column. - -begin - Result := True; - if Assigned(TreeView.FOnBeforeAutoFitColumn) then - TreeView.FOnBeforeAutoFitColumn(Self, Column, SmartAutoFitType, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.DoBeforeColumnWidthTracking(Column: TColumnIndex; Shift: TShiftState); - -// Tell the a application that a column width tracking operation may begin. - -begin - if Assigned(TreeView.FOnBeforeColumnWidthTracking) then - TreeView.FOnBeforeColumnWidthTracking(Self, Column, Shift); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.DoBeforeHeightTracking(Shift: TShiftState); - -// Tell the application that a height tracking operation may begin. - -begin - if Assigned(TreeView.FOnBeforeHeaderHeightTracking) then - TreeView.FOnBeforeHeaderHeightTracking(Self, Shift); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.DoCanSplitterResize(P: TPoint; var Allowed: Boolean); -begin - if Assigned(TreeView.FOnCanSplitterResizeHeader) then - TreeView.FOnCanSplitterResizeHeader(Self, P, Allowed); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.DoColumnWidthDblClickResize(Column: TColumnIndex; P: TPoint; Shift: TShiftState): Boolean; - -// Queries the application whether a double click on the column splitter should resize the column. - -begin - Result := True; - if Assigned(TreeView.FOnColumnWidthDblClickResize) then - TreeView.FOnColumnWidthDblClickResize(Self, Column, Shift, P, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.DoColumnWidthTracking(Column: TColumnIndex; Shift: TShiftState; var TrackPoint: TPoint; P: TPoint): Boolean; - -begin - Result := True; - if Assigned(TreeView.FOnColumnWidthTracking) then - TreeView.FOnColumnWidthTracking(Self, Column, Shift, TrackPoint, P, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.DoGetPopupMenu(Column: TColumnIndex; Position: TPoint): TPopupMenu; - -// Queries the application whether there is a column specific header popup menu. - -var - AskParent: Boolean; - -begin - Result := PopupMenu; - if Assigned(TreeView.FOnGetPopupMenu) then - TreeView.FOnGetPopupMenu(TreeView, nil, Column, Position, AskParent, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.DoHeightTracking(var P: TPoint; Shift: TShiftState): Boolean; - -begin - Result := True; - if Assigned(TreeView.FOnHeaderHeightTracking) then - TreeView.FOnHeaderHeightTracking(Self, P, Shift, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.DoHeightDblClickResize(var P: TPoint; Shift: TShiftState): Boolean; - -begin - Result := True; - if Assigned(TreeView.FOnHeaderHeightDblClickResize) then - TreeView.FOnHeaderHeightDblClickResize(Self, P, Shift, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.DoSetSortColumn(Value: TColumnIndex; pSortDirection: TSortDirection); - -begin - if Value < NoColumn then - Value := NoColumn; - if Value > Columns.Count - 1 then - Value := Columns.Count - 1; - if FSortColumn <> Value then - begin - if FSortColumn > NoColumn then - Invalidate(Columns[FSortColumn]); - FSortColumn := Value; - FSortDirection := pSortDirection; - if FSortColumn > NoColumn then - Invalidate(Columns[FSortColumn]); - if ((toAutoSort in Treeview.FOptions.FAutoOptions) or (hoHeaderClickAutoSort in Options)) and (Treeview.FUpdateCount = 0) then - Treeview.SortTree(FSortColumn, FSortDirection, True); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.DragTo(P: TPoint); - -// Moves the drag image to a new position, which is determined from the passed point P and the previous -// mouse position. - -var - I, - NewTarget: Integer; - // optimized drag image move support - ClientP: TPoint; - Left, - Right: Integer; - NeedRepaint: Boolean; // True if the screen needs an update (changed drop target or drop side) - -begin - // Determine new drop target and which side of it is prefered. - ClientP := Treeview.ScreenToClient(P); - // Make coordinates relative to (0, 0) of the non-client area. - Inc(ClientP.Y, FHeight); - NewTarget := FColumns.ColumnFromPosition(ClientP); - NeedRepaint := (NewTarget <> InvalidColumn) and (NewTarget <> FColumns.FDropTarget); - if NewTarget >= 0 then - begin - FColumns.GetColumnBounds(NewTarget, Left, Right); - if (ClientP.X < ((Left + Right) div 2)) <> FColumns.FDropBefore then - begin - NeedRepaint := True; - FColumns.FDropBefore := not FColumns.FDropBefore; - end; - end; - - if NeedRepaint then - begin - // Invalidate columns which need a repaint. - if FColumns.FDropTarget > NoColumn then - begin - I := FColumns.FDropTarget; - FColumns.FDropTarget := NoColumn; - Invalidate(FColumns.Items[I]); - end; - if (NewTarget > NoColumn) and (NewTarget <> FColumns.FDropTarget) then - begin - Invalidate(FColumns.Items[NewTarget]); - FColumns.FDropTarget := NewTarget; - end; - end; - - // Fix for various problems mentioned in issue 248. - if NeedRepaint then - begin - UpdateWindow(FOwner.Handle); - // 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.FLastPosition)) - or InHeader(FOwner.ScreenToClient(FDragImage.FImagePosition)) - ) then - begin - GDIFlush; - FOwner.UpdateWindowAndDragImage(FOwner, 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; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.FixedAreaConstraintsChanged(Sender: TObject); - -// This method gets called when FFixedAreaConstraints is changed. - -begin - if Treeview.HandleAllocated then - RescaleHeader - else - Include(FStates, hsNeedScaling); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.GetColumnsClass: TVirtualTreeColumnsClass; - -// Returns the class to be used for the actual column implementation. descendants may optionally override this and -// return their own class. - -begin - Result := TVirtualTreeColumns; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.GetOwner: TPersistent; - -begin - Result := FOwner; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.GetShiftState: TShiftState; - -begin - Result := []; - if GetKeyState(VK_SHIFT) < 0 then - Include(Result, ssShift); - if GetKeyState(VK_CONTROL) < 0 then - Include(Result, ssCtrl); - if GetKeyState(VK_MENU) < 0 then - Include(Result, ssAlt); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.HandleHeaderMouseMove(var Message: TWMMouseMove): Boolean; - -var - P: TPoint; - NextColumn, - I: TColumnIndex; - NewWidth: Integer; - -begin - Result := False; - with Message do - begin - P := Point(XPos, YPos); - if hsColumnWidthTrackPending in FStates then - begin - Treeview.StopTimer(HeaderTimer); - FStates := FStates - [hsColumnWidthTrackPending] + [hsColumnWidthTracking]; - HandleHeaderMouseMove := True; - Result := 0; - end - else - if hsHeightTrackPending in FStates then - begin - Treeview.StopTimer(HeaderTimer); - FStates := FStates - [hsHeightTrackPending] + [hsHeightTracking]; - HandleHeaderMouseMove := True; - Result := 0; - end - else - if hsColumnWidthTracking in FStates then - begin - if DoColumnWidthTracking(FColumns.FTrackIndex, GetShiftState, FTrackPoint, P) then - begin - if Treeview.UseRightToLeftAlignment then - begin - NewWidth := FTrackPoint.X - XPos; - NextColumn := FColumns.GetPreviousVisibleColumn(FColumns.FTrackIndex); - end - else - begin - NewWidth := XPos - FTrackPoint.X; - NextColumn := FColumns.GetNextVisibleColumn(FColumns.FTrackIndex); - end; - - // The autosized column cannot be resized using the mouse normally. Instead we resize the next - // visible column, so it look as we directly resize the autosized column. - if (hoAutoResize in FOptions) and (FColumns.FTrackIndex = FAutoSizeIndex) and - (NextColumn > NoColumn) and (coResizable in FColumns[NextColumn].FOptions) and - (FColumns[FColumns.FTrackIndex].FMinWidth < NewWidth) and - (FColumns[FColumns.FTrackIndex].FMaxWidth > NewWidth) then - FColumns[NextColumn].Width := FColumns[NextColumn].Width - NewWidth - + FColumns[FColumns.FTrackIndex].Width - else - FColumns[FColumns.FTrackIndex].Width := NewWidth; // 1 EListError seen here (List index out of bounds (-1)) since 10/2013 - end; - HandleHeaderMouseMove := True; - Result := 0; - end - else - if hsHeightTracking in FStates then - begin - if DoHeightTracking(P, GetShiftState) then - SetHeight(Integer(FHeight) + P.Y); - HandleHeaderMouseMove := True; - Result := 0; - end - else - begin - if hsDragPending in FStates then - begin - P := Treeview.ClientToScreen(P); - // start actual dragging if allowed - if (hoDrag in FOptions) and Treeview.DoHeaderDragging(FColumns.FDownIndex) then - begin - if ((Abs(FDragStart.X - P.X) > Mouse.DragThreshold) or - (Abs(FDragStart.Y - P.Y) > Mouse.DragThreshold)) then - begin - Treeview.StopTimer(HeaderTimer); - I := FColumns.FDownIndex; - FColumns.FDownIndex := NoColumn; - FColumns.FHoverIndex := NoColumn; - if I > NoColumn then - Invalidate(FColumns[I]); - PrepareDrag(P, FDragStart); - FStates := FStates - [hsDragPending] + [hsDragging]; - HandleHeaderMouseMove := True; - Result := 0; - end; - end; - end - else - if hsDragging in FStates then - begin - DragTo(Treeview.ClientToScreen(Point(XPos, YPos))); - HandleHeaderMouseMove := True; - Result := 0; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.HandleMessage(var Message: TMessage): Boolean; - -// The header gets here the opportunity to handle certain messages before they reach the tree. This is important -// because the tree needs to handle various non-client area messages for the header as well as some dragging/tracking -// events. -// By returning True the message will not be handled further, otherwise the message is then dispatched -// to the proper message handlers. - -var - P: TPoint; - R: TRect; - I: TColumnIndex; - OldPosition: Integer; - HitIndex: TColumnIndex; - NewCursor: HCURSOR; - Button: TMouseButton; - IsInHeader, - IsHSplitterHit, - IsVSplitterHit: Boolean; - - //--------------- local function -------------------------------------------- - - function HSplitterHit: Boolean; - - var - NextCol: TColumnIndex; - - begin - Result := (hoColumnResize in FOptions) and DetermineSplitterIndex(P); - if Result and not InHeader(P) then - begin - NextCol := FColumns.GetNextVisibleColumn(FColumns.FTrackIndex); - if not (coFixed in FColumns[FColumns.FTrackIndex].Options) or (NextCol <= NoColumn) or - (coFixed in FColumns[NextCol].Options) or (P.Y > Integer(Treeview.FRangeY)) then - Result := False; - end; - end; - - //--------------- end local function ---------------------------------------- - -begin - Result := False; - case Message.Msg of - WM_SIZE: - begin - if not (tsWindowCreating in FOwner.FStates) then - if (hoAutoResize in FOptions) and not (hsAutoSizing in FStates) then - begin - FColumns.AdjustAutoSize(InvalidColumn); - Invalidate(nil); - end - else - if not (hsScaling in FStates) then - begin - RescaleHeader; - Invalidate(nil); - end; - end; - CM_PARENTFONTCHANGED: - if FParentFont then - FFont.Assign(FOwner.Font); - CM_BIDIMODECHANGED: - for I := 0 to FColumns.Count - 1 do - if coParentBiDiMode in FColumns[I].FOptions then - FColumns[I].ParentBiDiModeChanged; - WM_NCMBUTTONDOWN: - begin - with TWMNCMButtonDown(Message) do - P := Treeview.ScreenToClient(Point(XCursor, YCursor)); - if InHeader(P) then - FOwner.DoHeaderMouseDown(mbMiddle, GetShiftState, P.X, P.Y + Integer(FHeight)); - end; - WM_NCMBUTTONUP: - begin - with TWMNCMButtonUp(Message) do - P := FOwner.ScreenToClient(Point(XCursor, YCursor)); - if InHeader(P) then - begin - FColumns.HandleClick(P, mbMiddle, True, False); - FOwner.DoHeaderMouseUp(mbMiddle, GetShiftState, P.X, P.Y + Integer(FHeight)); - FColumns.FDownIndex := NoColumn; - FColumns.FCheckBoxHit := False; - end; - end; - WM_LBUTTONDBLCLK, - WM_NCLBUTTONDBLCLK, - WM_NCMBUTTONDBLCLK, - WM_NCRBUTTONDBLCLK: - begin - if Message.Msg <> WM_LBUTTONDBLCLK then - with TWMNCLButtonDblClk(Message) do - P := FOwner.ScreenToClient(Point(XCursor, YCursor)) - else - with TWMLButtonDblClk(Message) do - P := Point(XPos, YPos); - - if (hoHeightDblClickResize in FOptions) and InHeaderSplitterArea(P) and (FDefaultHeight > 0) then - begin - if DoHeightDblClickResize(P, GetShiftState) and (FDefaultHeight > 0) then - SetHeight(FMinHeight); - Result := True; - end - else - if HSplitterHit and ((Message.Msg = WM_NCLBUTTONDBLCLK) or (Message.Msg = WM_LBUTTONDBLCLK)) and - (hoDblClickResize in FOptions) and (FColumns.FTrackIndex > NoColumn) then - begin - // If the click was on a splitter then resize column to smallest width. - if DoColumnWidthDblClickResize(FColumns.FTrackIndex, P, GetShiftState) then - AutoFitColumns(True, smaUseColumnOption, FColumns[FColumns.FTrackIndex].FPosition, - FColumns[FColumns.FTrackIndex].FPosition); - Message.Result := 0; - Result := True; - end - else - if InHeader(P) and (Message.Msg <> WM_LBUTTONDBLCLK) then - begin - case Message.Msg of - WM_NCMBUTTONDBLCLK: - Button := mbMiddle; - WM_NCRBUTTONDBLCLK: - Button := mbRight; - else - // WM_NCLBUTTONDBLCLK - Button := mbLeft; - end; - if Button = mbLeft then - Columns.AdjustDownColumn(P); - FColumns.HandleClick(P, Button, True, True); - end; - end; - // The "hot" area of the headers horizontal splitter is partly within the client area of the the tree, so we need - // to handle WM_LBUTTONDOWN here, too. - WM_LBUTTONDOWN, - WM_NCLBUTTONDOWN: - begin - - Application.CancelHint; - - if not (csDesigning in Treeview.ComponentState) then - begin - // make sure no auto scrolling is active... - Treeview.StopTimer(ScrollTimer); - Treeview.DoStateChange([], [tsScrollPending, tsScrolling]); - // ... pending editing is cancelled (actual editing remains active) - Treeview.StopTimer(EditTimer); - Treeview.DoStateChange([], [tsEditPending]); - end; - - if Message.Msg = WM_LBUTTONDOWN then - // Coordinates are already client area based. - with TWMLButtonDown(Message) do - P := Point(XPos, YPos) - else - with TWMNCLButtonDown(Message) do - begin - // want the drag start point in screen coordinates - FDragStart := Point(XCursor, YCursor); - P := Treeview.ScreenToClient(FDragStart); - end; - - IsInHeader := InHeader(P); - // in design-time header columns are always resizable - if (csDesigning in Treeview.ComponentState) then - IsVSplitterHit := InHeaderSplitterArea(P) - else - IsVSplitterHit := InHeaderSplitterArea(P) and CanSplitterResize(P); - IsHSplitterHit := HSplitterHit; - - if IsVSplitterHit or IsHSplitterHit then - begin - FTrackStart := P; - FColumns.FHoverIndex := NoColumn; - if IsVSplitterHit then - begin - if not (csDesigning in Treeview.ComponentState) then - DoBeforeHeightTracking(GetShiftState); - Include(FStates, hsHeightTrackPending); - end - else - begin - if not (csDesigning in Treeview.ComponentState) then - DoBeforeColumnWidthTracking(FColumns.FTrackIndex, GetShiftState); - Include(FStates, hsColumnWidthTrackPending); - end; - - SetCapture(Treeview.Handle); - Result := True; - Message.Result := 0; - end - else - if IsInHeader then - begin - HitIndex := Columns.AdjustDownColumn(P); - // in design-time header columns are always draggable - if ((csDesigning in Treeview.ComponentState) and (HitIndex > NoColumn)) or - ((hoDrag in FOptions) and (HitIndex > NoColumn) and (coDraggable in FColumns[HitIndex].FOptions)) then - begin - // Show potential drag operation. - // Disabled columns do not start a drag operation because they can't be clicked. - Include(FStates, hsDragPending); - SetCapture(Treeview.Handle); - Result := True; - Message.Result := 0; - end; - end; - - // This is a good opportunity to notify the application. - if not (csDesigning in Treeview.ComponentState) and IsInHeader then - FOwner.DoHeaderMouseDown(mbLeft, GetShiftState, P.X, P.Y + Integer(FHeight)); - end; - WM_NCRBUTTONDOWN: - begin - with TWMNCRButtonDown(Message) do - P := FOwner.ScreenToClient(Point(XCursor, YCursor)); - if InHeader(P) then - FOwner.DoHeaderMouseDown(mbRight, GetShiftState, P.X, P.Y + Integer(FHeight)); - end; - WM_NCRBUTTONUP: - if not (csDesigning in FOwner.ComponentState) then - with TWMNCRButtonUp(Message) do - begin - Application.CancelHint; - P := FOwner.ScreenToClient(Point(XCursor, YCursor)); - if InHeader(P) then - begin - HandleMessage := FColumns.HandleClick(P, mbRight, True, False); - FOwner.DoHeaderMouseUp(mbRight, GetShiftState, P.X, P.Y + Integer(FHeight)); - end; - end; - // When the tree window has an active mouse capture then we only get "client-area" messages. - WM_LBUTTONUP, - WM_NCLBUTTONUP: - begin - Application.CancelHint; - - if FStates <> [] then - begin - ReleaseCapture; - if hsDragging in FStates then - begin - // successfull dragging moves columns - with TWMLButtonUp(Message) do - P := Treeview.ClientToScreen(Point(XPos, YPos)); - GetWindowRect(Treeview.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 (FDropTarget > -1) and (FDropTarget <> FDragIndex) and PtInRect(R, P) then - begin - OldPosition := FColumns[FDragIndex].Position; - if FColumns.FDropBefore then - begin - if FColumns[FDragIndex].Position < FColumns[FDropTarget].Position then - FColumns[FDragIndex].Position := Max(0, FColumns[FDropTarget].Position - 1) - else - FColumns[FDragIndex].Position := FColumns[FDropTarget].Position; - end - else - begin - if FColumns[FDragIndex].Position < FColumns[FDropTarget].Position then - FColumns[FDragIndex].Position := FColumns[FDropTarget].Position - else - FColumns[FDragIndex].Position := FColumns[FDropTarget].Position + 1; - end; - Treeview.DoHeaderDragged(FDragIndex, OldPosition); - end - else - Treeview.DoHeaderDraggedOut(FDragIndex, P); - FDropTarget := NoColumn; - end; - Invalidate(nil); - end; - Result := True; - Message.Result := 0; - end; - - case Message.Msg of - WM_LBUTTONUP: - with TWMLButtonUp(Message) do - begin - if FColumns.FDownIndex > NoColumn then - FColumns.HandleClick(Point(XPos, YPos), mbLeft, False, False); - if FStates <> [] then - FOwner.DoHeaderMouseUp(mbLeft, KeysToShiftState(Keys), XPos, YPos); - end; - WM_NCLBUTTONUP: - with TWMNCLButtonUp(Message) do - begin - P := FOwner.ScreenToClient(Point(XCursor, YCursor)); - FColumns.HandleClick(P, mbLeft, False, False); - FOwner.DoHeaderMouseUp(mbLeft, GetShiftState, P.X, P.Y + Integer(FHeight)); - end; - end; - - if FColumns.FTrackIndex > NoColumn then - begin - if hsColumnWidthTracking in FStates then - DoAfterColumnWidthTracking(FColumns.FTrackIndex); - Invalidate(Columns[FColumns.FTrackIndex]); - FColumns.FTrackIndex := NoColumn; - end; - if FColumns.FDownIndex > NoColumn then - begin - Invalidate(Columns[FColumns.FDownIndex]); - FColumns.FDownIndex := NoColumn; - end; - if hsHeightTracking in FStates then - DoAfterHeightTracking; - - FStates := FStates - [hsDragging, hsDragPending, - hsColumnWidthTracking, hsColumnWidthTrackPending, - hsHeightTracking, hsHeightTrackPending]; - end;// WM_NCLBUTTONUP - // hovering, mouse leave detection - WM_NCMOUSEMOVE: - with TWMNCMouseMove(Message), FColumns do - begin - P := Treeview.ScreenToClient(Point(XCursor, YCursor)); - Treeview.DoHeaderMouseMove(GetShiftState, P.X, P.Y + Integer(FHeight)); - if InHeader(P) and ((AdjustHoverColumn(P)) or ((FDownIndex >= 0) and (FHoverIndex <> FDownIndex))) then - begin - // We need a mouse leave detection from here for the non client area. - // TODO: The best solution available would be the TrackMouseEvent API. - // With the drop of the support of Win95 totally and WinNT4 we should replace the timer. - Treeview.StopTimer(HeaderTimer); - SetTimer(Treeview.Handle, HeaderTimer, 50, nil); - // use Delphi's internal hint handling for header hints too - if hoShowHint in FOptions then - begin - // client coordinates! - XCursor := P.X; - YCursor := P.Y + Integer(FHeight); - Application.HintMouseMessage(Treeview, Message); - end; - end; - end; - WM_TIMER: - if TWMTimer(Message).TimerID = HeaderTimer then - begin - // determine current mouse position to check if it left the window - GetCursorPos(P); - P := Treeview.ScreenToClient(P); - with FColumns do - begin - if not InHeader(P) or ((FDownIndex > NoColumn) and (FHoverIndex <> FDownIndex)) then - begin - Treeview.StopTimer(HeaderTimer); - FHoverIndex := NoColumn; - FClickIndex := NoColumn; - FDownIndex := NoColumn; - FCheckBoxHit := False; - Result := True; - Message.Result := 0; - Invalidate(nil); - end; - end; - end; - WM_MOUSEMOVE: // mouse capture and general message redirection - Result := HandleHeaderMouseMove(TWMMouseMove(Message)); - WM_SETCURSOR: - // Feature: design-time header - if (FStates = []) then - begin - // Retrieve last cursor position (GetMessagePos does not work here, I don't know why). - GetCursorPos(P); - - // Is the mouse in the header rectangle and near the splitters? - P := Treeview.ScreenToClient(P); - IsHSplitterHit := HSplitterHit; - // in design-time header columns are always resizable - if (csDesigning in Treeview.ComponentState) then - IsVSplitterHit := InHeaderSplitterArea(P) - else - IsVSplitterHit := InHeaderSplitterArea(P) and CanSplitterResize(P); - - if IsVSplitterHit or IsHSplitterHit then - begin - NewCursor := Screen.Cursors[Treeview.Cursor]; - if IsVSplitterHit and ((hoHeightResize in FOptions) or (csDesigning in Treeview.ComponentState)) then - NewCursor := Screen.Cursors[crVertSplit] - else - if IsHSplitterHit then - NewCursor := Screen.Cursors[crHeaderSplit]; - - if not (csDesigning in Treeview.ComponentState) then - Treeview.DoGetHeaderCursor(NewCursor); - Result := NewCursor <> Screen.Cursors[crDefault]; - if Result then - begin - Winapi.Windows.SetCursor(NewCursor); - Message.Result := 1; - end; - end; - end - else - begin - Message.Result := 1; - Result := True; - end; - WM_KEYDOWN, - WM_KILLFOCUS: - if (Message.Msg = WM_KILLFOCUS) or - (TWMKeyDown(Message).CharCode = VK_ESCAPE) then - begin - if hsDragging in FStates then - begin - ReleaseCapture; - FDragImage.EndDrag; - Exclude(FStates, hsDragging); - FColumns.FDropTarget := NoColumn; - Invalidate(nil); - Result := True; - Message.Result := 0; - end - else - begin - if [hsColumnWidthTracking, hsHeightTracking] * FStates <> [] then - begin - ReleaseCapture; - if hsColumnWidthTracking in FStates then - DoAfterColumnWidthTracking(FColumns.FTrackIndex); - if hsHeightTracking in FStates then - DoAfterHeightTracking; - Result := True; - Message.Result := 0; - end; - - FStates := FStates - [hsColumnWidthTracking, hsColumnWidthTrackPending, - hsHeightTracking, hsHeightTrackPending]; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.ImageListChange(Sender: TObject); - -begin - if not (csDestroying in Treeview.ComponentState) then - Invalidate(nil); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.PrepareDrag(P, Start: TPoint); - -// Initializes dragging of the header, P is the current mouse postion and Start the initial mouse position. - -var - Image: TBitmap; - ImagePos: TPoint; - DragColumn: TVirtualTreeColumn; - RTLOffset: Integer; - -begin - // Determine initial position of drag image (screen coordinates). - FColumns.FDropTarget := NoColumn; - Start := Treeview.ScreenToClient(Start); - Inc(Start.Y, FHeight); - FColumns.FDragIndex := FColumns.ColumnFromPosition(Start); - DragColumn := FColumns[FColumns.FDragIndex]; - - Image := TBitmap.Create; - with Image do - try - PixelFormat := pf32Bit; - SetSize(DragColumn.Width, FHeight); - - // Erase the entire image with the color key value, for the case not everything - // in the image is covered by the header image. - Canvas.Brush.Color := clBtnFace; - Canvas.FillRect(Rect(0, 0, Width, Height)); - - if TreeView.UseRightToLeftAlignment then - RTLOffset := Treeview.ComputeRTLOffset - else - RTLOffset := 0; - with DragColumn do - FColumns.PaintHeader(Canvas, Rect(FLeft, 0, FLeft + Width, Height), Point(-RTLOffset, 0), RTLOffset); - - if Treeview.UseRightToLeftAlignment then - ImagePos := Treeview.ClientToScreen(Point(DragColumn.Left + Treeview.ComputeRTLOffset(True), 0)) - else - ImagePos := Treeview.ClientToScreen(Point(DragColumn.Left, 0)); - // Column rectangles are given in local window coordinates not client coordinates. - Dec(ImagePos.Y, FHeight); - - if hoRestrictDrag in FOptions then - FDragImage.MoveRestriction := dmrHorizontalOnly - else - FDragImage.MoveRestriction := dmrNone; - FDragImage.PrepareDrag(Image, ImagePos, P, nil); - FDragImage.ShowDragImage; - finally - Image.Free; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.ReadColumns(Reader: TReader); - -begin - Include(FStates, hsLoading); - Columns.Clear; - Reader.ReadValue; - Reader.ReadCollection(Columns); - Exclude(FStates, hsLoading); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.RecalculateHeader; - -// Initiate a recalculation of the non-client area of the owner tree. - -begin - if Treeview.HandleAllocated then - begin - Treeview.UpdateHeaderRect; - SetWindowPos(Treeview.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOOWNERZORDER or - SWP_NOSENDCHANGING or SWP_NOSIZE or SWP_NOZORDER); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.RescaleHeader; - -// Rescale the fixed elements (fixed columns, header itself) to FixedAreaConstraints. - -var - FixedWidth, - MaxFixedWidth, - MinFixedWidth: Integer; - - //--------------- local function -------------------------------------------- - - procedure ComputeConstraints; - - var - I: TColumnIndex; - - begin - with FColumns do - begin - I := GetFirstVisibleColumn; - while I > NoColumn do - begin - if (coFixed in FColumns[I].Options) and (FColumns[I].Width < FColumns[I].MinWidth) then - FColumns[I].FWidth := FColumns[I].FMinWidth; - I := GetNextVisibleColumn(I); - end; - FixedWidth := GetVisibleFixedWidth; - end; - - with FFixedAreaConstraints do - begin - MinFixedWidth := (TreeView.ClientWidth * FMinWidthPercent) div 100; - MaxFixedWidth := (TreeView.ClientWidth * FMaxWidthPercent) div 100; - end; - end; - - //----------- end local function -------------------------------------------- - -begin - if ([csLoading, csReading, csWriting, csDestroying] * Treeview.ComponentState = []) and not - (hsLoading in FStates) and Treeview.HandleAllocated then - begin - Include(FStates, hsScaling); - - SetHeight(FHeight); - RecalculateHeader; - - with FFixedAreaConstraints do - if (FMinHeightPercent > 0) or (FMaxHeightPercent > 0) then - begin - ComputeConstraints; - - with FColumns do - if (FMaxWidthPercent > 0) and (FixedWidth > MaxFixedWidth) then - ResizeColumns(MaxFixedWidth - FixedWidth, 0, Count - 1, [coVisible, coFixed]) - else - if (FMinWidthPercent > 0) and (FixedWidth < MinFixedWidth) then - ResizeColumns(MinFixedWidth - FixedWidth, 0, Count - 1, [coVisible, coFixed]); - - FColumns.UpdatePositions; - end; - - Exclude(FStates, hsScaling); - Exclude(FStates, hsNeedScaling); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.UpdateMainColumn; - -// Called once the load process of the owner tree is done. - -begin - if FMainColumn < 0 then - FMainColumn := 0; - if FMainColumn > FColumns.Count - 1 then - FMainColumn := FColumns.Count - 1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.UpdateSpringColumns; - -var - I: TColumnIndex; - SpringCount: Integer; - Sign: Integer; - ChangeBy: Single; - Difference: Single; - NewAccumulator: Single; - -begin - with TreeView do - ChangeBy := FHeaderRect.Right - FHeaderRect.Left - FLastWidth; - if (hoAutoSpring in FOptions) and (FLastWidth <> 0) and (ChangeBy <> 0) then - begin - // Stay positive if downsizing the control. - if ChangeBy < 0 then - Sign := -1 - else - Sign := 1; - ChangeBy := Abs(ChangeBy); - // Count how many columns have spring enabled. - SpringCount := 0; - for I := 0 to FColumns.Count-1 do - if [coVisible, coAutoSpring] * FColumns[I].FOptions = [coVisible, coAutoSpring] then - Inc(SpringCount); - if SpringCount > 0 then - begin - // Calculate the size to add/sub to each columns. - Difference := ChangeBy / SpringCount; - // Adjust the column's size accumulators and resize if the result is >= 1. - for I := 0 to FColumns.Count - 1 do - if [coVisible, coAutoSpring] * FColumns[I].FOptions = [coVisible, coAutoSpring] then - begin - // Sum up rest changes from previous runs and the amount from this one and store it in the - // column. If there is at least one pixel difference then do a resize and reset the accumulator. - NewAccumulator := FColumns[I].FSpringRest + Difference; - // Set new width if at least one pixel size difference is reached. - if NewAccumulator >= 1 then - FColumns[I].SetWidth(FColumns[I].FWidth + (Trunc(NewAccumulator) * Sign)); - FColumns[I].FSpringRest := Frac(NewAccumulator); - - // Keep track of the size count. - ChangeBy := ChangeBy - Difference; - // Exit loop if resize count drops below freezing point. - if ChangeBy < 0 then - Break; - end; - end; - end; - with TreeView do - FLastWidth := FHeaderRect.Right - FHeaderRect.Left; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -type - // --- HACK WARNING! - // This type cast is a partial rewrite of the private section of TWriter. The purpose is to have access to - // the FPropPath member, which is otherwise not accessible. The reason why this access is needed is that - // with nested components this member contains unneeded property path information. These information prevent - // successful load of the stored properties later. - // In System.Classes.pas you can see that FPropPath is reset several times to '' to prevent this case for certain properies. - // Unfortunately, there is no clean way for us here to do the same. - {$hints off} - TWriterHack = class(TFiler) - private - FRootAncestor: TComponent; - FPropPath: string; - end; - {$hints on} - -procedure TVTHeader.WriteColumns(Writer: TWriter); - -// Write out the columns but take care for the case VT is a nested component. - -var - LastPropPath: string; - -begin - // Save last property path for restoration. - LastPropPath := TWriterHack(Writer).FPropPath; - try - // If VT is a nested component then this path contains the name of the parent component at this time - // (otherwise it is already empty). This path is then combined with the property name under which the tree - // is defined in the parent component. Unfortunately, the load code in System.Classes.pas does not consider this case - // is then unable to load this property. - TWriterHack(Writer).FPropPath := ''; - Writer.WriteCollection(Columns); - finally - TWriterHack(Writer).FPropPath := LastPropPath; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.AllowFocus(ColumnIndex: TColumnIndex): Boolean; -begin - Result := False; - if not FColumns.IsValidColumn(ColumnIndex) then - Exit; // Just in case. - - Result := (coAllowFocus in FColumns[ColumnIndex].Options); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.Assign(Source: TPersistent); - -begin - if Source is TVTHeader then - begin - AutoSizeIndex := TVTHeader(Source).AutoSizeIndex; - Background := TVTHeader(Source).Background; - Columns := TVTHeader(Source).Columns; - Font := TVTHeader(Source).Font; - FixedAreaConstraints.Assign(TVTHeader(Source).FixedAreaConstraints); - Height := TVTHeader(Source).Height; - Images := TVTHeader(Source).Images; - MainColumn := TVTHeader(Source).MainColumn; - Options := TVTHeader(Source).Options; - ParentFont := TVTHeader(Source).ParentFont; - PopupMenu := TVTHeader(Source).PopupMenu; - SortColumn := TVTHeader(Source).SortColumn; - SortDirection := TVTHeader(Source).SortDirection; - Style := TVTHeader(Source).Style; - - RescaleHeader; - end - else - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.AutoFitColumns(Animated: Boolean = True; SmartAutoFitType: TSmartAutoFitType = smaUseColumnOption; - RangeStartCol: Integer = NoColumn; RangeEndCol: Integer = NoColumn); - - //--------------- local functions ------------------------------------------- - - function GetUseSmartColumnWidth(ColumnIndex: TColumnIndex): Boolean; - - begin - case SmartAutoFitType of - smaAllColumns: - Result := True; - smaUseColumnOption: - Result := coSmartResize in FColumns.Items[ColumnIndex].FOptions; - else - Result := False; - end; - end; - - //---------------------------------------------------------------------------- - - procedure DoAutoFitColumn(Column: TColumnIndex); - - begin - with FColumns do - if ([coResizable, coVisible] * Items[FPositionToIndex[Column]].FOptions = [coResizable, coVisible]) and - DoBeforeAutoFitColumn(FPositionToIndex[Column], SmartAutoFitType) and not TreeView.OperationCanceled then - begin - if Animated then - AnimatedResize(FPositionToIndex[Column], Treeview.GetMaxColumnWidth(FPositionToIndex[Column], - GetUseSmartColumnWidth(FPositionToIndex[Column]))) - else - FColumns[FPositionToIndex[Column]].Width := Treeview.GetMaxColumnWidth(FPositionToIndex[Column], - GetUseSmartColumnWidth(FPositionToIndex[Column])); - - DoAfterAutoFitColumn(FPositionToIndex[Column]); - end; - end; - - //--------------- end local functions ---------------------------------------- - -var - I: Integer; - StartCol, - EndCol: Integer; - -begin - StartCol := Max(NoColumn + 1, RangeStartCol); - - if RangeEndCol <= NoColumn then - EndCol := FColumns.Count - 1 - else - EndCol := Min(RangeEndCol, FColumns.Count - 1); - - if StartCol > EndCol then - Exit; // nothing to do - - TreeView.StartOperation(okAutoFitColumns); - FDoingAutoFitColumns := true; - try - if Assigned(TreeView.FOnBeforeAutoFitColumns) then - TreeView.FOnBeforeAutoFitColumns(Self, SmartAutoFitType); - - for I := StartCol to EndCol do - DoAutoFitColumn(I); - - if Assigned(TreeView.FOnAfterAutoFitColumns) then - TreeView.FOnAfterAutoFitColumns(Self); - - finally - Treeview.EndOperation(okAutoFitColumns); - TreeView.Invalidate(); - FDoingAutoFitColumns := false; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.InHeader(P: TPoint): Boolean; - -// Determines whether the given point (client coordinates!) is within the header rectangle (non-client coordinates). - -var - R, RW: TRect; - -begin - R := Treeview.FHeaderRect; - - // Current position of the owner in screen coordinates. - GetWindowRect(Treeview.Handle, RW); - - // Convert to client coordinates. - MapWindowPoints(0, Treeview.Handle, RW, 2); - - // Consider the header within this rectangle. - OffsetRect(R, RW.Left, RW.Top); - Result := PtInRect(R, P); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.InHeaderSplitterArea(P: TPoint): Boolean; - -// Determines whether the given point (client coordinates!) hits the horizontal splitter area of the header. - -var - R, RW: TRect; - -begin - if (P.Y > 2) or (P.Y < -2) or not (hoVisible in FOptions) then - Result := False - else - begin - R := Treeview.FHeaderRect; - Inc(R.Bottom, 2); - - // Current position of the owner in screen coordinates. - GetWindowRect(Treeview.Handle, RW); - - // Convert to client coordinates. - MapWindowPoints(0, Treeview.Handle, RW, 2); - - // Consider the header within this rectangle. - OffsetRect(R, RW.Left, RW.Top); - Result := PtInRect(R, P); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.Invalidate(Column: TVirtualTreeColumn; ExpandToBorder: Boolean = False; UpdateNowFlag : Boolean = False); - -// Because the header is in the non-client area of the tree it needs some special handling in order to initiate its -// repainting. -// If ExpandToBorder is True then not only the given column but everything or (depending on hoFullRepaintOnResize) just -// everything to its right (or left, in RTL mode) will be invalidated (useful for resizing). This makes only sense when -// a column is given. - -var - R, RW: TRect; - Flags: Cardinal; - -begin - if (hoVisible in FOptions) and Treeview.HandleAllocated then - with Treeview do - begin - if Column = nil then - R := FHeaderRect - else - begin - R := Column.GetRect; - if not (coFixed in Column.Options) then - OffsetRect(R, -FEffectiveOffsetX, 0); - if UseRightToLeftAlignment then - OffsetRect(R, ComputeRTLOffset, 0); - if ExpandToBorder then - begin - if (hoFullRepaintOnResize in FHeader.FOptions) then - begin - R.Left := FHeaderRect.Left; - R.Right := FHeaderRect.Right; - end - else - begin - if UseRightToLeftAlignment then - R.Left := FHeaderRect.Left - else - R.Right := FHeaderRect.Right; - end; - end; - end; - R.Bottom := Treeview.ClientHeight; // We want to repaint the entire column to bottom, not just the header - - // Current position of the owner in screen coordinates. - GetWindowRect(Handle, RW); - - // Consider the header within this rectangle. - OffsetRect(R, RW.Left, RW.Top); - - // Expressed in client coordinates (because RedrawWindow wants them so, they will actually become negative). - MapWindowPoints(0, Handle, R, 2); - Flags := RDW_FRAME or RDW_INVALIDATE or RDW_VALIDATE or RDW_NOINTERNALPAINT or RDW_NOERASE or RDW_NOCHILDREN; - if UpdateNowFlag then - Flags := Flags or RDW_UPDATENOW; - RedrawWindow(Handle, @R, 0, Flags); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.LoadFromStream(const Stream: TStream); - -// restore the state of the header from the given stream - -var - Dummy, - Version: Integer; - S: AnsiString; - OldOptions: TVTHeaderOptions; - -begin - Include(FStates, hsLoading); - with Stream do - try - // Switch off all options which could influence loading the columns (they will be later set again). - OldOptions := FOptions; - FOptions := []; - - // Determine whether the stream contains data without a version number. - ReadBuffer(Dummy, SizeOf(Dummy)); - if Dummy > -1 then - begin - // Seek back to undo the read operation if this is an old stream format. - Seek(-SizeOf(Dummy), soFromCurrent); - Version := -1; - end - else // Read version number if this is a "versionized" format. - ReadBuffer(Version, SizeOf(Version)); - Columns.LoadFromStream(Stream, Version); - - ReadBuffer(Dummy, SizeOf(Dummy)); - AutoSizeIndex := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - Background := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - Height := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - FOptions := OldOptions; - Options := TVTHeaderOptions(Dummy); - // PopupMenu is neither saved nor restored - ReadBuffer(Dummy, SizeOf(Dummy)); - Style := TVTHeaderStyle(Dummy); - // TFont has no own save routine so we do it manually - with Font do - begin - ReadBuffer(Dummy, SizeOf(Dummy)); - Color := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - Height := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - SetLength(S, Dummy); - ReadBuffer(PAnsiChar(S)^, Dummy); - Name := UTF8ToString(S); - ReadBuffer(Dummy, SizeOf(Dummy)); - Pitch := TFontPitch(Dummy); - ReadBuffer(Dummy, SizeOf(Dummy)); - Style := TFontStyles(Byte(Dummy)); - end; - - // Read data introduced by stream version 1+. - if Version > 0 then - begin - ReadBuffer(Dummy, SizeOf(Dummy)); - MainColumn := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - SortColumn := Dummy; - ReadBuffer(Dummy, SizeOf(Dummy)); - SortDirection := TSortDirection(Byte(Dummy)); - end; - - // Read data introduced by stream version 5+. - if Version > 4 then - begin - ReadBuffer(Dummy, SizeOf(Dummy)); - ParentFont := Boolean(Dummy); - ReadBuffer(Dummy, SizeOf(Dummy)); - FMaxHeight := Integer(Dummy); - ReadBuffer(Dummy, SizeOf(Dummy)); - FMinHeight := Integer(Dummy); - ReadBuffer(Dummy, SizeOf(Dummy)); - FDefaultHeight := Integer(Dummy); - with FFixedAreaConstraints do - begin - ReadBuffer(Dummy, SizeOf(Dummy)); - FMaxHeightPercent := TVTConstraintPercent(Dummy); - ReadBuffer(Dummy, SizeOf(Dummy)); - FMaxWidthPercent := TVTConstraintPercent(Dummy); - ReadBuffer(Dummy, SizeOf(Dummy)); - FMinHeightPercent := TVTConstraintPercent(Dummy); - ReadBuffer(Dummy, SizeOf(Dummy)); - FMinWidthPercent := TVTConstraintPercent(Dummy); - end; - end; - finally - Exclude(FStates, hsLoading); - RecalculateHeader(); - Treeview.DoColumnResize(NoColumn); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTHeader.ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex; - Options: TVTColumnOptions = [coVisible]): Integer; - -// Distribute the given width change to a range of columns. A 'fair' way is used to distribute ChangeBy to the columns, -// while ensuring that everything that can be distributed will be distributed. - -var - Start, - I: TColumnIndex; - ColCount, - ToGo, - Sign, - Rest, - MaxDelta, - Difference: Integer; - Constraints, - Widths: array of Integer; - BonusPixel: Boolean; - - //--------------- local functions ------------------------------------------- - - function IsResizable (Column: TColumnIndex): Boolean; - - begin - if BonusPixel then - Result := Widths[Column - RangeStartCol] < Constraints[Column - RangeStartCol] - else - Result := Widths[Column - RangeStartCol] > Constraints[Column - RangeStartCol]; - end; - - //--------------------------------------------------------------------------- - - procedure IncDelta(Column: TColumnIndex); - - begin - if BonusPixel then - Inc(MaxDelta, FColumns[Column].MaxWidth - Widths[Column - RangeStartCol]) - else - Inc(MaxDelta, Widths[Column - RangeStartCol] - Constraints[Column - RangeStartCol]); - end; - - //--------------------------------------------------------------------------- - - function ChangeWidth(Column: TColumnIndex; Delta: Integer): Integer; - - begin - if Delta > 0 then - Delta := Min(Delta, Constraints[Column - RangeStartCol] - Widths[Column - RangeStartCol]) - else - Delta := Max(Delta, Constraints[Column - RangeStartCol] - Widths[Column - RangeStartCol]); - - Inc(Widths[Column - RangeStartCol], Delta); - Dec(ToGo, Abs(Delta)); - Result := Abs(Delta); - end; - - //--------------------------------------------------------------------------- - - function ReduceConstraints: Boolean; - - var - MaxWidth, - MaxReserveCol, - Column: TColumnIndex; - - begin - Result := True; - if not (hsScaling in FStates) or BonusPixel then - Exit; - - MaxWidth := 0; - MaxReserveCol := NoColumn; - for Column := RangeStartCol to RangeEndCol do - if (Options * FColumns[Column].FOptions = Options) and - (FColumns[Column].FWidth > MaxWidth) then - begin - MaxWidth := Widths[Column - RangeStartCol]; - MaxReserveCol := Column; - end; - - if (MaxReserveCol <= NoColumn) or (Constraints[MaxReserveCol - RangeStartCol] <= 10) then - Result := False - else - Dec(Constraints[MaxReserveCol - RangeStartCol], - Constraints[MaxReserveCol - RangeStartCol] div 10); - end; - - //----------- end local functions ------------------------------------------- - -begin - Result := 0; - if ChangeBy <> 0 then - begin - // Do some initialization here - BonusPixel := ChangeBy > 0; - Sign := IfThen(BonusPixel, 1, -1); - Start := IfThen(BonusPixel, RangeStartCol, RangeEndCol); - ToGo := Abs(ChangeBy); - SetLength(Widths, RangeEndCol - RangeStartCol + 1); - SetLength(Constraints, RangeEndCol - RangeStartCol + 1); - for I := RangeStartCol to RangeEndCol do - begin - Widths[I - RangeStartCol] := FColumns[I].FWidth; - Constraints[I - RangeStartCol] := IfThen(BonusPixel, FColumns[I].MaxWidth, FColumns[I].MinWidth); - end; - - repeat - repeat - MaxDelta := 0; - ColCount := 0; - for I := RangeStartCol to RangeEndCol do - if (Options * FColumns[I].FOptions = Options) and IsResizable(I) then - begin - Inc(ColCount); - IncDelta(I); - end; - if MaxDelta < Abs(ChangeBy) then - if not ReduceConstraints then - Break; - until (MaxDelta >= Abs(ChangeBy)) or not (hsScaling in FStates); - - if ColCount = 0 then - Break; - - ToGo := Min(ToGo, MaxDelta); - Difference := ToGo div ColCount; - Rest := ToGo mod ColCount; - - if Difference > 0 then - for I := RangeStartCol to RangeEndCol do - if (Options * FColumns[I].FOptions = Options) and IsResizable(I) then - ChangeWidth(I, Difference * Sign); - - // Now distribute Rest. - I := Start; - while Rest > 0 do - begin - if (Options * FColumns[I].FOptions = Options) and IsResizable(I) then - if FColumns[I].FBonusPixel <> BonusPixel then - begin - Dec(Rest, ChangeWidth(I, Sign)); - FColumns[I].FBonusPixel := BonusPixel; - end; - Inc(I, Sign); - if (BonusPixel and (I > RangeEndCol)) or (not BonusPixel and (I < RangeStartCol)) then - begin - for I := RangeStartCol to RangeEndCol do - if Options * FColumns[I].FOptions = Options then - FColumns[I].FBonusPixel := not FColumns[I].FBonusPixel; - I := Start; - end; - end; - until ToGo <= 0; - - // Now set the computed widths. We also compute the result here. - Include(FStates, hsResizing); - for I := RangeStartCol to RangeEndCol do - if (Options * FColumns[I].FOptions = Options) then - begin - Inc(Result, Widths[I - RangeStartCol] - FColumns[I].FWidth); - FColumns[I].SetWidth(Widths[I - RangeStartCol]); - end; - Exclude(FStates, hsResizing); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.RestoreColumns; - -// Restores all columns to their width which they had before they have been auto fitted. - -var - I: TColumnIndex; - -begin - with FColumns do - for I := Count - 1 downto 0 do - if [coResizable, coVisible] * Items[FPositionToIndex[I]].FOptions = [coResizable, coVisible] then - Items[I].RestoreLastWidth; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTHeader.SaveToStream(const Stream: TStream); - -// Saves the complete state of the header into the provided stream. - -var - Dummy: Integer; - Tmp: AnsiString; - -begin - with Stream do - begin - // In previous version of VT was no header stream version defined. - // For feature enhancements it is necessary, however, to know which stream - // format we are trying to load. - // In order to distict from non-version streams an indicator is inserted. - Dummy := -1; - WriteBuffer(Dummy, SizeOf(Dummy)); - // Write current stream version number, nothing more is required at the time being. - Dummy := VTHeaderStreamVersion; - WriteBuffer(Dummy, SizeOf(Dummy)); - - // Save columns in case they depend on certain options (like auto size). - Columns.SaveToStream(Stream); - - Dummy := FAutoSizeIndex; - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := FBackgroundColor; - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := FHeight; - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Integer(FOptions); - WriteBuffer(Dummy, SizeOf(Dummy)); - // PopupMenu is neither saved nor restored - Dummy := Ord(FStyle); - WriteBuffer(Dummy, SizeOf(Dummy)); - // TFont has no own save routine so we do it manually - with Font do - begin - Dummy := Color; - WriteBuffer(Dummy, SizeOf(Dummy)); - - // Need only to write one: size or height, I decided to write height. - Dummy := Height; - WriteBuffer(Dummy, SizeOf(Dummy)); - Tmp := UTF8Encode(Name); - Dummy := Length(Tmp); - WriteBuffer(Dummy, SizeOf(Dummy)); - WriteBuffer(PAnsiChar(Tmp)^, Dummy); - Dummy := Ord(Pitch); - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Byte(Style); - WriteBuffer(Dummy, SizeOf(Dummy)); - end; - - // Data introduced by stream version 1. - Dummy := FMainColumn; - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := FSortColumn; - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Byte(FSortDirection); - WriteBuffer(Dummy, SizeOf(Dummy)); - - // Data introduced by stream version 5. - Dummy := Integer(ParentFont); - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Integer(FMaxHeight); - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Integer(FMinHeight); - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Integer(FDefaultHeight); - WriteBuffer(Dummy, SizeOf(Dummy)); - with FFixedAreaConstraints do - begin - Dummy := Integer(FMaxHeightPercent); - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Integer(FMaxWidthPercent); - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Integer(FMinHeightPercent); - WriteBuffer(Dummy, SizeOf(Dummy)); - Dummy := Integer(FMinWidthPercent); - WriteBuffer(Dummy, SizeOf(Dummy)); - end; - end; -end; - -//----------------- TScrollBarOptions ---------------------------------------------------------------------------------- - -constructor TScrollBarOptions.Create(AOwner: TBaseVirtualTree); - -begin - inherited Create; - - FOwner := AOwner; - FAlwaysVisible := False; - FScrollBarStyle := sbmRegular; - FScrollBars := ssBoth; - FIncrementX := 20; - FIncrementY := 20; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TScrollBarOptions.SetAlwaysVisible(Value: Boolean); - -begin - if FAlwaysVisible <> Value then - begin - FAlwaysVisible := Value; - if not (csLoading in FOwner.ComponentState) and FOwner.HandleAllocated then - FOwner.RecreateWnd; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TScrollBarOptions.SetScrollBars(Value: TScrollStyle); - -begin - if FScrollBars <> Value then - begin - FScrollBars := Value; - if not (csLoading in FOwner.ComponentState) and FOwner.HandleAllocated then - FOwner.RecreateWnd; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TScrollBarOptions.SetScrollBarStyle(Value: TScrollBarStyle); - -begin - if FScrollBarStyle <> Value then - begin - FScrollBarStyle := Value; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TScrollBarOptions.GetOwner: TPersistent; - -begin - Result := FOwner; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TScrollBarOptions.Assign(Source: TPersistent); - -begin - if Source is TScrollBarOptions then - begin - AlwaysVisible := TScrollBarOptions(Source).AlwaysVisible; - HorizontalIncrement := TScrollBarOptions(Source).HorizontalIncrement; - ScrollBars := TScrollBarOptions(Source).ScrollBars; - ScrollBarStyle := TScrollBarOptions(Source).ScrollBarStyle; - VerticalIncrement := TScrollBarOptions(Source).VerticalIncrement; - end - else - inherited; -end; - -//----------------- TVTColors ------------------------------------------------------------------------------------------ - -constructor TVTColors.Create(AOwner: TBaseVirtualTree); -var - CE : TVTColorEnum; -begin - FOwner := AOwner; - for CE := Low(TVTColorEnum) to High(TVTColorEnum) do - FColors[CE] := cDefaultColors[CE]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTColors.GetBackgroundColor: TColor; -begin -// XE2 VCL Style - if FOwner.VclStyleEnabled and (seClient in FOwner.StyleElements) then - Result := StyleServices.GetStyleColor(scTreeView) - else - Result := FOwner.Color; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTColors.GetColor(const Index: TVTColorEnum): TColor; -begin - // Only try to fetch the color via StyleServices if theses are enabled - // Return default/user defined color otherwise - if FOwner.VclStyleEnabled and not StyleServices.IsSystemStyle then - begin - // If the ElementDetails are not defined, fall back to the SystemColor - case Index of - cDisabledColor: - if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemDisabled), ecTextColor, Result) then - Result := StyleServices.GetSystemColor(FColors[Index]); - cTreeLineColor: - if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttBranch), ecBorderColor, Result) then - Result := StyleServices.GetSystemColor(FColors[Index]); - cBorderColor: - if (seBorder in FOwner.StyleElements) then - Result := StyleServices.GetSystemColor(FColors[Index]); - cHotColor: - if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemHot), ecTextColor, Result) then - Result := StyleServices.GetSystemColor(FColors[Index]); - cHeaderHotColor: - if not StyleServices.GetElementColor(StyleServices.GetElementDetails(thHeaderItemNormal), ecTextColor, Result) then - Result := StyleServices.GetSystemColor(FColors[Index]); - cSelectionTextColor: - if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemSelected), ecTextColor, Result) then - Result := StyleServices.GetSystemColor(clHighlightText); - cUnfocusedColor: - if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemSelectedNotFocus), ecTextColor, Result) then - Result := StyleServices.GetSystemColor(FColors[Index]); - else - Result := StyleServices.GetSystemColor(FColors[Index]); - end; - end - else - Result := FColors[Index]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTColors.GetHeaderFontColor: TColor; -begin -// XE2+ VCL Style - if FOwner.VclStyleEnabled and (seFont in FOwner.StyleElements) then - StyleServices.GetElementColor(StyleServices.GetElementDetails(thHeaderItemNormal), ecTextColor, Result) - else - Result := FOwner.FHeader.Font.Color; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTColors.GetNodeFontColor: TColor; -begin - if FOwner.VclStyleEnabled and (seFont in FOwner.StyleElements) then - StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemNormal), ecTextColor, Result) - else - Result := FOwner.Font.Color; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTColors.GetSelectedNodeFontColor(Focused: boolean): TColor; -begin - if Focused then begin - if (tsUseExplorerTheme in FOwner.FStates) and not IsHighContrastEnabled then begin - Result := NodeFontColor - end - else - Result := SelectionTextColor - end// if Focused - else - Result := UnfocusedColor; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTColors.SetColor(const Index: TVTColorEnum; const Value: TColor); - -begin - if FColors[Index] <> Value then - begin - FColors[Index] := Value; - if not (csLoading in FOwner.ComponentState) and FOwner.HandleAllocated then - begin - // Cause helper bitmap rebuild if the button color changed. - case Index of - cTreeLineColor: - begin - FOwner.PrepareBitmaps(True, False); - FOwner.Invalidate; - end; - cBorderColor: - RedrawWindow(FOwner.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_NOERASE or RDW_NOCHILDREN) - else - FOwner.Invalidate; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTColors.Assign(Source: TPersistent); - -begin - if Source is TVTColors then - begin - FColors := TVTColors(Source).FColors; - if FOwner.FUpdateCount = 0 then - FOwner.Invalidate; - end - else - inherited; -end; - -//----------------- TClipboardFormats ---------------------------------------------------------------------------------- - -constructor TClipboardFormats.Create(AOwner: TBaseVirtualTree); - -begin - FOwner := AOwner; - Sorted := True; - Duplicates := dupIgnore; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TClipboardFormats.Add(const S: string): Integer; - -// Restrict additions to the clipbard formats to only those which are registered with the owner tree or one of its -// ancestors. - -var - Format: Word; - RegisteredClass: TVirtualTreeClass; - -begin - RegisteredClass := TClipboardFormatList.FindFormat(S, Format); - if Assigned(RegisteredClass) and FOwner.ClassType.InheritsFrom(RegisteredClass) then - Result := inherited Add(S) - else - Result := -1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TClipboardFormats.Insert(Index: Integer; const S: string); - -// Restrict additions to the clipbard formats to only those which are registered with the owner tree or one of its -// ancestors. - -var - Format: Word; - RegisteredClass: TVirtualTreeClass; - -begin - RegisteredClass := TClipboardFormatList.FindFormat(S, Format); - if Assigned(RegisteredClass) and FOwner.ClassType.InheritsFrom(RegisteredClass) then - inherited Insert(Index, S); -end; - -//----------------- TBaseVirtualTree ----------------------------------------------------------------------------------- - -constructor TBaseVirtualTree.Create(AOwner: TComponent); - -begin - InitializeGlobalStructures(); - - inherited; - - ControlStyle := ControlStyle - [csSetCaption] + [csCaptureMouse, csOpaque, csReplicatable, csDisplayDragImage, - csReflector]; - FTotalInternalDataSize := 0; - FNodeDataSize := -1; - Width := 200; - Height := 100; - TabStop := True; - ParentColor := False; - FDefaultNodeHeight := 18; - FDragOperations := [doCopy, doMove]; - FHotCursor := crDefault; - FScrollBarOptions := TScrollBarOptions.Create(Self); - FFocusedColumn := NoColumn; - FDragImageKind := diComplete; - FLastSelectionLevel := -1; - FSelectionBlendFactor := 128; - - FIndent := 18; - - FPlusBM := TBitmap.Create; - FHotPlusBM := TBitmap.Create; - FMinusBM := TBitmap.Create; - FHotMinusBM := TBitmap.Create; - FSelectedHotPlusBM := TBitmap.Create; - FSelectedHotMinusBM := TBitmap.Create; - - FBorderStyle := bsSingle; - FButtonStyle := bsRectangle; - FButtonFillMode := fmTreeColor; - - FHeader := GetHeaderClass.Create(Self); - - // we have an own double buffer handling - inherited DoubleBuffered := False; - - FCheckImageKind := ckSystemDefault; - - FImageChangeLink := TChangeLink.Create; - FImageChangeLink.OnChange := ImageListChange; - FStateChangeLink := TChangeLink.Create; - FStateChangeLink.OnChange := ImageListChange; - FCustomCheckChangeLink := TChangeLink.Create; - FCustomCheckChangeLink.OnChange := ImageListChange; - - FAutoExpandDelay := 1000; - FAutoScrollDelay := 1000; - FAutoScrollInterval := 1; - - FBackground := TPicture.Create; - // Similar to the Transparent property of TImage, - // this flag is Off by default. - FBackGroundImageTransparent := False; - - FDefaultPasteMode := amAddChildLast; - FMargin := 4; - FTextMargin := 4; - FImagesMargin := 2; - FLastDragEffect := DROPEFFECT_NONE; - FDragType := dtOLE; - FDragHeight := 350; - FDragWidth := 200; - - FColors := TVTColors.Create(Self); - FEditDelay := 1000; - - FDragImage := TVTDragImage.Create(Self); - with FDragImage do - begin - Fade := True; - PreBlendBias := 0; - Transparency := 200; - end; - - FAnimationDuration := 200; - FSearchTimeout := 1000; - FSearchStart := ssFocusedNode; - FNodeAlignment := naProportional; - FLineStyle := lsDotted; - FIncrementalSearch := isNone; - FClipboardFormats := TClipboardFormats.Create(Self); - FOptions := GetOptionsClass.Create(Self); - - if not (csDesigning in ComponentState) then //Don't create worker thread in IDE, there is no use for it - TWorkerThread.AddThreadReference(); - VclStyleChanged(); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -destructor TBaseVirtualTree.Destroy; - -begin - // Disconnect all remote MSAA connections - if Assigned(FAccessibleItem) then begin - CoDisconnectObject(FAccessibleItem, 0); - FAccessibleItem := nil; - end; - if Assigned(fAccessible) then begin - CoDisconnectObject(fAccessible, 0); - fAccessible := nil; - end; - - InterruptValidation(); - Exclude(FOptions.FMiscOptions, toReadOnly); - // Make sure there is no reference remaining to the releasing tree. - TWorkerThread.ReleaseThreadReference(); - StopWheelPanning; - CancelEditNode; - - // Just in case it didn't happen already release the edit link. - FEditLink := nil; - FClipboardFormats.Free; - // Clear will also free the drag manager if it is still alive. - Clear; - FDragImage.Free; - FColors.Free; - FBackground.Free; - FImageChangeLink.Free; - FStateChangeLink.Free; - FCustomCheckChangeLink.Free; - if CheckImageKind = ckSystemDefault then - FCheckImages.Free; - FScrollBarOptions.Free; - - // The window handle must be destroyed before the header is freed because it is needed in WM_NCDESTROY. - if HandleAllocated then - DestroyWindowHandle; - - // Release FDottedBrush in case WM_NCDESTROY hasn't been triggered. - if FDottedBrush <> 0 then - DeleteObject(FDottedBrush); - FDottedBrush := 0; - - FHeader.Free; - FHeader := nil; // Do not use FreeAndNil() before checking issue #497 - FreeAndNil(FOptions); // WM_NCDESTROY accesses FOptions - - FreeMem(FRoot); - - FPlusBM.Free; - FHotPlusBM.Free; - FMinusBM.Free; - FHotMinusBM.Free; - FSelectedHotPlusBM.Free; - FSelectedHotMinusBM.Free; - - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.AdjustTotalCount(Node: PVirtualNode; Value: Integer; Relative: Boolean = False); - -// Sets a node's total count to the given value and recursively adjusts the parent's total count -// (actually, the adjustment is done iteratively to avoid function call overheads). - -var - Difference: Integer; - Run: PVirtualNode; - -begin - if Relative then - Difference := Value - else - Difference := Value - Integer(Node.TotalCount); - if Difference <> 0 then - begin - Run := Node; - // Root node has as parent the tree view. - while Assigned(Run) and (Run <> Pointer(Self)) do - begin - Inc(Integer(Run.TotalCount), Difference); - Run := Run.Parent; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.AdjustTotalHeight(Node: PVirtualNode; Value: Integer; Relative: Boolean = False); - -// Sets a node's total height to the given value and recursively adjusts the parent's total height. - -var - Difference: Integer; - Run: PVirtualNode; - -begin - if Relative then - Difference := Value - else - Difference := Value - Integer(Node.TotalHeight); - if Difference <> 0 then - begin - Run := Node; - repeat - Inc(Integer(Run.TotalHeight), Difference); - // If the node is not visible or the parent node is not expanded or we are already at the top - // then nothing more remains to do. - if not (vsVisible in Run.States) or (Run = FRoot) or - (Run.Parent = nil) or not (vsExpanded in Run.Parent.States) then - Break; - - Run := Run.Parent; - until False; - end; - - UpdateVerticalRange; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CalculateCacheEntryCount: Integer; - -// Calculates the size of the position cache. - -begin - if FVisibleCount > 1 then - Result := Ceil(FVisibleCount / CacheThreshold) - else - Result := 0; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CalculateVerticalAlignments(var PaintInfo: TVTPaintInfo; var VButtonAlign: Integer); - -// Calculates the vertical alignment of the given node and its associated expand/collapse button during -// a node paint cycle depending on the required node alignment style. - -begin - With PaintInfo do begin - // For absolute alignment the calculation is trivial. - case FNodeAlignment of - naFromTop: - VAlign := Node.Align; - naFromBottom: - VAlign := Integer(NodeHeight[Node]) - Node.Align; - else // naProportional - // Consider button and line alignment, but make sure neither the image nor the button (whichever is taller) - // go out of the entire node height (100% means bottom alignment to the node's bounds). - if (ImageInfo[iiNormal].Index >= 0) or (ImageInfo[iiState].Index >= 0) then - begin - if (ImageInfo[iiNormal].Index >= 0) then - VAlign := ImageInfo[iiNormal].Images.Height - else - VAlign := ImageInfo[iiState].Images.Height; - VAlign := MulDiv((Integer(NodeHeight[Node]) - VAlign), Node.Align, 100) + VAlign div 2; - end - else - if toShowButtons in FOptions.FPaintOptions then - VAlign := MulDiv((Integer(NodeHeight[Node]) - FPlusBM.Height), Node.Align, 100) + FPlusBM.Height div 2 - else - VAlign := MulDiv(Integer(Node.NodeHeight), Node.Align, 100); - end; - - VButtonAlign := VAlign - FPlusBM.Height div 2 - (FPlusBM.Height and 1); - end;// With PaintInfo -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ChangeCheckState(Node: PVirtualNode; Value: TCheckState): Boolean; - -// Sets the check state of the node according to the given value and the node's check type. -// If the check state must be propagated to the parent nodes and one of them refuses to change then -// nothing happens and False is returned, otherwise True. - -var - Run: PVirtualNode; - UncheckedCount, - MixedCheckCount, - CheckedCount: Cardinal; - -begin - Result := not (vsChecking in Node.States); - with Node^ do - if Result then - begin - Include(States, vsChecking); - try - if not (vsInitialized in States) then - InitNode(Node) - else if CheckState = Value then - begin - // Value didn't change and node was initialized, so nothing to do - Result := False; - Exit; - end;//if - - // Indicate that we are going to propagate check states up and down the hierarchy. - if FCheckPropagationCount = 0 then begin - // Do not enter tsCheckPropagation more than once - DoStateChange([tsCheckPropagation]); - BeginUpdate(); - end; - Inc(FCheckPropagationCount); - try - // Do actions which are associated with the given check state. - case CheckType of - // Check state change with additional consequences for check states of the children. - ctTriStateCheckBox: - begin - // Propagate state down to the children. - if toAutoTristateTracking in FOptions.FAutoOptions then - case Value of - csUncheckedNormal: - if Node.ChildCount > 0 then - begin - Run := FirstChild; - CheckedCount := 0; - MixedCheckCount := 0; - UncheckedCount := 0; - while Assigned(Run) do - begin - if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then - begin - if not Self.GetCheckState(Run).IsDisabled() then - SetCheckState(Run, csUncheckedNormal); - // Check if the new child state was set successfully, otherwise we have to adjust the - // node's new check state accordingly. - case Self.GetCheckState(Run) of - csCheckedNormal, csCheckedDisabled: - Inc(CheckedCount); - csMixedNormal: - Inc(MixedCheckCount); - csUncheckedNormal, csUncheckedDisabled: - Inc(UncheckedCount); - end; - end; - Run := Run.NextSibling; - end; - - // If there is still a mixed state child node checkbox then this node must be mixed checked too. - if MixedCheckCount > 0 then - Value := csMixedNormal - else - // If nodes are normally checked child nodes then the unchecked count determines what - // to set for the node itself. - if CheckedCount > 0 then - if UncheckedCount > 0 then - Value := csMixedNormal - else - Value := csCheckedNormal; - end; - csCheckedNormal: - if Node.ChildCount > 0 then - begin - Run := FirstChild; - CheckedCount := 0; - MixedCheckCount := 0; - UncheckedCount := 0; - while Assigned(Run) do - begin - if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then - begin - if not Self.GetCheckState(Run).IsDisabled() then - SetCheckState(Run, csCheckedNormal); - // Check if the new child state was set successfully, otherwise we have to adjust the - // node's new check state accordingly. - case Self.GetCheckState(Run) of - csCheckedNormal: - Inc(CheckedCount); - csMixedNormal: - Inc(MixedCheckCount); - csUncheckedNormal: - Inc(UncheckedCount); - end; - end; - Run := Run.NextSibling; - end; - - // If there is still a mixed state child node checkbox then this node must be mixed checked too. - if MixedCheckCount > 0 then - Value := csMixedNormal - else - // If nodes are normally checked child nodes then the unchecked count determines what - // to set for the node itself. - if CheckedCount > 0 then - if UncheckedCount > 0 then - Value := csMixedNormal - else - Value := csCheckedNormal; - end; - end; - end; - // radio button check state change - ctRadioButton: - if Value = csCheckedNormal then - begin - Value := csCheckedNormal; - // Make sure only this node is checked. - Run := Parent.FirstChild; - while Assigned(Run) do - begin - if Run.CheckType = ctRadioButton then - Run.CheckState := csUncheckedNormal; - Run := Run.NextSibling; - end; - Invalidate; - end; - end; - - if Result then - CheckState := Value // Set new check state - else - CheckState := Self.GetCheckState(Node).GetUnpressed(); // Reset dynamic check state. - - // Propagate state up to the parent. - if not (vsInitialized in Parent.States) then - InitNode(Parent); - if (toAutoTristateTracking in FOptions.FAutoOptions) and ([vsChecking, vsDisabled] * Parent.States = []) and - (CheckType in [ctCheckBox, ctTriStateCheckBox]) and (Parent <> FRoot) and - (Parent.CheckType = ctTriStateCheckBox) then - Result := CheckParentCheckState(Node, Value) - else - Result := True; - - InvalidateNode(Node); - finally - Dec(FCheckPropagationCount); // WL, 05.02.2004 - if FCheckPropagationCount = 0 then begin - // Allow state change event after all check operations finished - DoStateChange([], [tsCheckPropagation]); - EndUpdate(); - end; - end; - finally - Exclude(States, vsChecking); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRight: Integer; Alignment: TAlignment; - OldRect, NewRect: TRect): Boolean; - -// Helper routine used when a draw selection takes place. This version handles left-to-right directionality. -// In the process of adding or removing nodes the current selection is modified which requires to pack it after -// the function returns. Another side effect of this method is that a temporary list of nodes will be created -// (see also InternalCacheNode) which must be inserted into the current selection by the caller. - -var - Run, - NextNode: PVirtualNode; - TextRight, - TextLeft, - CurrentTop, - CurrentRight, - NextTop, - NextColumn, - NodeWidth, - Dummy: Integer; - MinY, MaxY: Integer; - LabelOffset: Integer; - IsInOldRect, - IsInNewRect: Boolean; - - // quick check variables for various parameters - DoSwitch, - AutoSpan: Boolean; - SimpleSelection: Boolean; - -begin - // A priori nothing changes. - Result := False; - - // Determine minimum and maximum vertical coordinates to limit iteration to. - MinY := Min(OldRect.Top, NewRect.Top); - MaxY := Max(OldRect.Bottom, NewRect.Bottom); - - // Initialize short hand variables to speed up tests below. - DoSwitch := ssCtrl in FDrawSelShiftState; - AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions); - SimpleSelection := toSimpleDrawSelection in FOptions.FSelectionOptions; - // This is the node to start with. - Run := GetNodeAt(0, MinY, False, CurrentTop); - - if Assigned(Run) then - begin - LabelOffset := GetOffset(TVTElement.ofsLabel, Run); - - // ----- main loop - // Change selection depending on the node's rectangle being in the selection rectangle or not, but - // touch only those nodes which overlap either the old selection rectangle or the new one but not both. - repeat - // Collect offsets for check, normal and state images. - TextLeft := NodeLeft + LabelOffset; - NextTop := CurrentTop + Integer(NodeHeight[Run]); - - // Simple selection allows to draw the selection rectangle anywhere. No intersection with node captions is - // required. Only top and bottom bounds of the rectangle matter. - if SimpleSelection or (toFullRowSelect in FOptions.FSelectionOptions) then - begin - IsInOldRect := (NextTop > OldRect.Top) and (CurrentTop < OldRect.Bottom) and - ((FHeader.Columns.Count = 0) or (FHeader.Columns.TotalWidth > OldRect.Left)) and ((NodeLeft + LabelOffset) < OldRect.Right); - IsInNewRect := (NextTop > NewRect.Top) and (CurrentTop < NewRect.Bottom) and - ((FHeader.Columns.Count = 0) or (FHeader.Columns.TotalWidth > NewRect.Left)) and ((NodeLeft + LabelOffset) < NewRect.Right); - end - else - begin - // The right column border might be extended if column spanning is enabled. - if AutoSpan then - begin - with FHeader.FColumns do - begin - NextColumn := MainColumn; - repeat - Dummy := GetNextVisibleColumn(NextColumn); - if (Dummy = InvalidColumn) or not ColumnIsEmpty(Run, Dummy) or - (Items[Dummy].BidiMode <> bdLeftToRight) then - Break; - NextColumn := Dummy; - until False; - if NextColumn = MainColumn then - CurrentRight := NodeRight - else - GetColumnBounds(NextColumn, Dummy, CurrentRight); - end; - end - else - CurrentRight := NodeRight; - // Check if we need the node's width. This is the case when the node is not left aligned or the - // left border of the selection rectangle is to the right of the left node border. - if (TextLeft < OldRect.Left) or (TextLeft < NewRect.Left) or (Alignment <> taLeftJustify) then - begin - NodeWidth := DoGetNodeWidth(Run, MainColumn); - if NodeWidth >= (CurrentRight - TextLeft) then - TextRight := CurrentRight - else - case Alignment of - taLeftJustify: - TextRight := TextLeft + NodeWidth; - taCenter: - begin - TextLeft := (TextLeft + CurrentRight - NodeWidth) div 2; - TextRight := TextLeft + NodeWidth; - end; - else - // taRightJustify - TextRight := CurrentRight; - TextLeft := TextRight - NodeWidth; - end; - end - else - TextRight := CurrentRight; - - // Now determine whether we need to change the state. - IsInOldRect := (OldRect.Left <= TextRight) and (OldRect.Right >= TextLeft) and - (NextTop > OldRect.Top) and (CurrentTop < OldRect.Bottom); - IsInNewRect := (NewRect.Left <= TextRight) and (NewRect.Right >= TextLeft) and - (NextTop > NewRect.Top) and (CurrentTop < NewRect.Bottom); - end; - - if IsInOldRect xor IsInNewRect then - begin - Result := True; - if DoSwitch then - begin - if vsSelected in Run.States then - InternalRemoveFromSelection(Run) - else - InternalCacheNode(Run); - end - else - begin - if IsInNewRect then - InternalCacheNode(Run) - else - InternalRemoveFromSelection(Run); - end; - end; - CurrentTop := NextTop; - // Get next visible node and update left node position. - NextNode := GetNextVisibleNoInit(Run, True); - if NextNode = nil then - Break; - Inc(NodeLeft, CountLevelDifference(Run, NextNode) * Integer(FIndent)); - Run := NextNode; - until CurrentTop > MaxY; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRight: Integer; Alignment: TAlignment; - OldRect, NewRect: TRect): Boolean; - -// Helper routine used when a draw selection takes place. This version handles right-to-left directionality. -// See also comments in CollectSelectedNodesLTR. - -var - Run, - NextNode: PVirtualNode; - TextRight, - TextLeft, - CheckOffset, - CurrentTop, - CurrentLeft, - NextTop, - NextColumn, - NodeWidth, - Dummy: Integer; - MinY, MaxY: Integer; - IsInOldRect, - IsInNewRect: Boolean; - - // quick check variables for various parameters - WithCheck, - WithStateImages, - DoSwitch, - AutoSpan: Boolean; - SimpleSelection: Boolean; - -begin - // A priori nothing changes. - Result := False; - // Switch the alignment to the opposite value in RTL context. - ChangeBiDiModeAlignment(Alignment); - - // Determine minimum and maximum vertical coordinates to limit iteration to. - MinY := Min(OldRect.Top, NewRect.Top); - MaxY := Max(OldRect.Bottom, NewRect.Bottom); - - // Initialize short hand variables to speed up tests below. - DoSwitch := ssCtrl in FDrawSelShiftState; - WithCheck := (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages); - // Don't check the events here as descendant trees might have overriden the DoGetImageIndex method. - WithStateImages := Assigned(FStateImages) or Assigned(OnGetImageIndexEx); - if WithCheck then - CheckOffset := FCheckImages.Width + FImagesMargin - else - CheckOffset := 0; - AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions); - SimpleSelection := toSimpleDrawSelection in FOptions.FSelectionOptions; - // This is the node to start with. - Run := GetNodeAt(0, MinY, False, CurrentTop); - - if Assigned(Run) then - begin - // The initial minimal left border is determined by the identation level of the node and is dynamically adjusted. - if toShowRoot in FOptions.FPaintOptions then - Dec(NodeRight, Integer((GetNodeLevel(Run) + 1) * FIndent) + FMargin) - else - Dec(NodeRight, Integer(GetNodeLevel(Run) * FIndent) + FMargin); - - // ----- main loop - // Change selection depending on the node's rectangle being in the selection rectangle or not, but - // touch only those nodes which overlap either the old selection rectangle or the new one but not both. - repeat - // Collect offsets for check, normal and state images. - TextRight := NodeRight; - if WithCheck and (Run.CheckType <> ctNone) then - Dec(TextRight, CheckOffset); - Dec(TextRight, GetImageSize(Run, ikNormal, MainColumn).cx); - if WithStateImages then - Dec(TextRight, GetImageSize(Run, ikState, MainColumn).cx); - NextTop := CurrentTop + Integer(NodeHeight[Run]); - - // Simple selection allows to draw the selection rectangle anywhere. No intersection with node captions is - // required. Only top and bottom bounds of the rectangle matter. - if SimpleSelection then - begin - IsInOldRect := (NextTop > OldRect.Top) and (CurrentTop < OldRect.Bottom); - IsInNewRect := (NextTop > NewRect.Top) and (CurrentTop < NewRect.Bottom); - end - else - begin // The left column border might be extended if column spanning is enabled. - if AutoSpan then - begin - NextColumn := MainColumn; - repeat - Dummy := FHeader.FColumns.GetPreviousVisibleColumn(NextColumn); - if (Dummy = InvalidColumn) or not ColumnIsEmpty(Run, Dummy) or - (FHeader.FColumns[Dummy].BiDiMode = bdLeftToRight) then - Break; - NextColumn := Dummy; - until False; - if NextColumn = MainColumn then - CurrentLeft := NodeLeft - else - FHeader.FColumns.GetColumnBounds(NextColumn, CurrentLeft, Dummy); - end - else - CurrentLeft := NodeLeft; - // Check if we need the node's width. This is the case when the node is not left aligned (in RTL context this // means actually right aligned) or the right border of the selection rectangle is to the left - // of the right node border. - if (TextRight > OldRect.Right) or (TextRight > NewRect.Right) or (Alignment <> taRightJustify) then - begin - NodeWidth := DoGetNodeWidth(Run, MainColumn); - if NodeWidth >= (TextRight - CurrentLeft) then - TextLeft := CurrentLeft - else - case Alignment of - taLeftJustify: - begin - TextLeft := CurrentLeft; - TextRight := TextLeft + NodeWidth; - end; - taCenter: - begin - TextLeft := (TextRight + CurrentLeft - NodeWidth) div 2; - TextRight := TextLeft + NodeWidth; - end; - else - // taRightJustify - TextLeft := TextRight - NodeWidth; - end; - end - else - TextLeft := CurrentLeft; - - // Now determine whether we need to change the state. - IsInOldRect := (OldRect.Right >= TextLeft) and (OldRect.Left <= TextRight) and - (NextTop > OldRect.Top) and (CurrentTop < OldRect.Bottom); - IsInNewRect := (NewRect.Right >= TextLeft) and (NewRect.Left <= TextRight) and - (NextTop > NewRect.Top) and (CurrentTop < NewRect.Bottom); - end; - - if IsInOldRect xor IsInNewRect then - begin - Result := True; - if DoSwitch then - begin - if vsSelected in Run.States then - InternalRemoveFromSelection(Run) - else - InternalCacheNode(Run); - end - else - begin - if IsInNewRect then - InternalCacheNode(Run) - else - InternalRemoveFromSelection(Run); - end; - end; - CurrentTop := NextTop; - // Get next visible node and update left node position. - NextNode := GetNextVisibleNoInit(Run, True); - if NextNode = nil then - Break; - Dec(NodeRight, CountLevelDifference(Run, NextNode) * Integer(FIndent)); - Run := NextNode; - until CurrentTop > MaxY; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ClearNodeBackground(const PaintInfo: TVTPaintInfo; UseBackground, Floating: Boolean; - R: TRect); - -// Erases a node's background depending on what the application decides to do. -// UseBackground determines whether or not to use the background picture, while Floating indicates -// that R is given in coordinates of the small node bitmap or the superordinated target bitmap used in PaintTree. - -var - BackColor: TColor; - EraseAction: TItemEraseAction; - Offset: TPoint; - -begin - BackColor := FColors.BackGroundColor; - with PaintInfo do - begin - EraseAction := eaDefault; - - if Floating then - begin - Offset := Point(-FEffectiveOffsetX, R.Top); - OffsetRect(R, 0, -Offset.Y); - end - else - Offset := Point(0, 0); - - DoBeforeItemErase(Canvas, Node, R, BackColor, EraseAction); - - with Canvas do - begin - case EraseAction of - eaNone: - ; - eaColor: - begin - // User has given a new background color. - Brush.Color := BackColor; - FillRect(R); - end; - else // eaDefault - if UseBackground then - begin - if toStaticBackground in TreeOptions.PaintOptions then - StaticBackground(FBackground, Canvas, Offset, R, FColors.BackGroundColor) - else - TileBackground(FBackground, Canvas, Offset, R, FColors.BackGroundColor); - end - else - begin - if (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and - (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) and not - (tsUseExplorerTheme in FStates) then - begin - if toShowHorzGridLines in FOptions.PaintOptions then - begin - Brush.Color := BackColor; - FillRect(Rect(R.Left, R.Bottom - 1, R.Right, R.Bottom)); - Dec(R.Bottom); - end; - if Focused or (toPopupMode in FOptions.FPaintOptions) then - begin - Brush.Color := FColors.FocusedSelectionColor; - Pen.Color := FColors.FocusedSelectionBorderColor; - end - else - begin - Brush.Color := FColors.UnfocusedSelectionColor; - Pen.Color := FColors.UnfocusedSelectionBorderColor; - end; - - with TWithSafeRect(R) do - RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); - end - else - begin - Brush.Color := BackColor; - FillRect(R); - end; - end; - end; - DoAfterItemErase(Canvas, Node, R); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CompareNodePositions(Node1, Node2: PVirtualNode; ConsiderChildrenAbove: Boolean = False): Integer; - -// Tries hard and smart to quickly determine whether Node1's structural position is before Node2's position. -// If ConsiderChildrenAbove is True, the nodes will be compared with their visual order in mind. -// Returns 0 if Node1 = Node2, < 0 if Node1 is located before Node2 else > 0. - -var - Run1, - Run2: PVirtualNode; - Level1, - Level2: Cardinal; - -begin - Assert(Assigned(Node1) and Assigned(Node2), 'Nodes must never be nil.'); - - if Node1 = Node2 then - Result := 0 - else - begin - if HasAsParent(Node1, Node2) then - Result := IfThen(ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions), -1, 1) - else - if HasAsParent(Node2, Node1) then - Result := IfThen(ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions), 1, -1) - else - begin - // the given nodes are neither equal nor are they parents of each other, so go up to FRoot - // for each node and compare the child indices of the top level parents - // Note: neither Node1 nor Node2 can be FRoot at this point as this (a bit strange) circumstance would - // be caught by the previous code. - - // start lookup at the same level - Level1 := GetNodeLevel(Node1); - Level2 := GetNodeLevel(Node2); - Run1 := Node1; - while Level1 > Level2 do - begin - Run1 := Run1.Parent; - Dec(Level1); - end; - Run2 := Node2; - while Level2 > Level1 do - begin - Run2 := Run2.Parent; - Dec(Level2); - end; - - // now go up until we find a common parent node (loop will safely stop at FRoot if the nodes - // don't share a common parent) - while Run1.Parent <> Run2.Parent do - begin - Run1 := Run1.Parent; - Run2 := Run2.Parent; - end; - Result := Integer(Run1.Index) - Integer(Run2.Index); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DrawLineImage(const PaintInfo: TVTPaintInfo; X, Y, H, VAlign: Integer; Style: TVTLineType; - Reverse: Boolean); - -// Draws (depending on Style) one of the 5 line types of the tree. -// If Reverse is True then a right-to-left column is being drawn, hence horizontal lines must be mirrored. -// X and Y describe the left upper corner of the line image rectangle, while H denotes its height (and width). - -var - HalfWidth, - TargetX: Integer; - -begin - HalfWidth := (FIndent div 2); - if Reverse then - TargetX := 0 - else - TargetX := Integer(FIndent) + ScaledPixels(FImagesMargin); - - with PaintInfo.Canvas do - begin - case Style of - ltBottomRight: - begin - DrawDottedVLine(PaintInfo, Y + VAlign, Y + H, X + HalfWidth); - DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); - end; - ltTopDown: - DrawDottedVLine(PaintInfo, Y, Y + H, X + HalfWidth); - ltTopDownRight: - begin - DrawDottedVLine(PaintInfo, Y, Y + H, X + HalfWidth); - DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); - end; - ltRight: - DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); - ltTopRight: - begin - DrawDottedVLine(PaintInfo, Y, Y + VAlign, X + HalfWidth); - DrawDottedHLine(PaintInfo, X + HalfWidth, X + TargetX, Y + VAlign); - end; - ltLeft: // left can also mean right for RTL context - if Reverse then - DrawDottedVLine(PaintInfo, Y, Y + H, X + Integer(FIndent)) - else - DrawDottedVLine(PaintInfo, Y, Y + H, X); - ltLeftBottom: - if Reverse then - begin - DrawDottedVLine(PaintInfo, Y, Y + H, X + Integer(FIndent)); - DrawDottedHLine(PaintInfo, X, X + Integer(FIndent), Y + H); - end - else - begin - DrawDottedVLine(PaintInfo, Y, Y + H, X); - DrawDottedHLine(PaintInfo, X, X + Integer(FIndent), Y + H); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.FindInPositionCache(Node: PVirtualNode; var CurrentPos: Cardinal): 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. - -var - L, H, I: Integer; - -begin - L := 0; - H := High(FPositionCache); - while L <= H do - begin - I := (L + H) shr 1; - if CompareNodePositions(FPositionCache[I].Node, Node) <= 0 then - L := I + 1 - else - H := I - 1; - end; - if L = 0 then // High(FPositionCache) = -1 - begin - Result := nil; - CurrentPos := 0; - end - else - begin - Result := FPositionCache[L - 1].Node; - CurrentPos := FPositionCache[L - 1].AbsoluteTop; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.FindInPositionCache(Position: Cardinal; var CurrentPos: Cardinal): 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. -// The returned node does not necessarily occupy the given position but is the nearest one to start -// iterating from to approach the real node for a given position. CurrentPos receives the actual position of the found -// node which is needed for further iteration. - -var - L, H, I: Integer; - -begin - L := 0; - H := High(FPositionCache); - while L <= H do - begin - I := (L + H) shr 1; - if FPositionCache[I].AbsoluteTop <= Position then - L := I + 1 - else - H := I - 1; - end; - if L = 0 then // High(FPositionCache) = -1 - begin - Result := nil; - CurrentPos := 0; - end - else - begin - Result := FPositionCache[L - 1].Node; - CurrentPos := FPositionCache[L - 1].AbsoluteTop; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.FixupTotalCount(Node: PVirtualNode); - -// Called after loading a subtree from stream. The child count in each node is already set but not -// their total count. - -var - Child: PVirtualNode; - -begin - // Initial total count is set to one on node creation. - Child := Node.FirstChild; - while Assigned(Child) do - begin - FixupTotalCount(Child); - Inc(Node.TotalCount, Child.TotalCount); - Child := Child.NextSibling; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.FixupTotalHeight(Node: PVirtualNode); - -// Called after loading a subtree from stream. The individual height of each node is set already, -// but their total height needs an adjustment depending on their visibility state. - -var - Child: PVirtualNode; - -begin - // Initial total height is set to the node height on load. - Child := Node.FirstChild; - - if vsExpanded in Node.States then - begin - while Assigned(Child) do - begin - FixupTotalHeight(Child); - if vsVisible in Child.States then - Inc(Node.TotalHeight, Child.TotalHeight); - Child := Child.NextSibling; - end; - end - else - begin - // The node is collapsed, so just update the total height of its child nodes. - while Assigned(Child) do - begin - FixupTotalHeight(Child); - Child := Child.NextSibling; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetBottomNode: PVirtualNode; - -begin - Result := GetNodeAt(0, ClientHeight - 1); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetCheckedCount: Integer; - -var - Node: PVirtualNode; - -begin - Result := 0; - Node := GetFirstChecked; - while Assigned(Node) do - begin - Inc(Result); - Node := GetNextChecked(Node); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetCheckState(Node: PVirtualNode): TCheckState; - -begin - if Assigned(FOnBeforeGetCheckState) then - FOnBeforeGetCheckState(Self, Node); - - Result := Node.CheckState; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetCheckType(Node: PVirtualNode): TCheckType; - -begin - Result := Node.CheckType; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetChildCount(Node: PVirtualNode): Cardinal; -begin - if (Node = nil) or (Node = FRoot) then - Exit(FRoot.ChildCount); - if not GetChildrenInitialized(Node) then - InitChildren(Node); - Exit(Node.ChildCount); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetChildrenInitialized(Node: PVirtualNode): Boolean; - -begin - Result := not (vsHasChildren in Node.States) or (Node.ChildCount > 0); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetCutCopyCount: Integer; - -var - Node: PVirtualNode; - -begin - Result := 0; - Node := GetFirstCutCopy; - while Assigned(Node) do - begin - Inc(Result); - Node := GetNextCutCopy(Node); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetDisabled(Node: PVirtualNode): Boolean; - -begin - Result := Assigned(Node) and (vsDisabled in Node.States); -end; - -//---------------------------------------------------------------------------------------------------------------------- -// whether the sync of checkbox with selection is allowed for this node -function TBaseVirtualTree.GetSyncCheckstateWithSelection(Node: PVirtualNode): Boolean; - -begin - Result := (toSyncCheckboxesWithSelection in FOptions.FSelectionOptions) - and (toCheckSupport in FOptions.FMiscOptions) - and Assigned(FCheckImages) - and (Node.CheckType = ctCheckBox); ; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetDragManager: IVTDragManager; - -// Returns the internal drag manager interface. If this does not yet exist then it is created here. - -begin - if FDragManager = nil then - begin - FDragManager := DoCreateDragManager; - if FDragManager = nil then - FDragManager := TVTDragManager.Create(Self); - end; - - Result := FDragManager; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetExpanded(Node: PVirtualNode): Boolean; - -begin - if Assigned(Node) then - Result := vsExpanded in Node.States - else - Result := False; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFiltered(Node: PVirtualNode): Boolean; - -begin - Result := vsFiltered in Node.States; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFullyVisible(Node: PVirtualNode): Boolean; - -// Determines whether the given node has the visibility flag set as well as all its parents are expanded. - -begin - Assert(Assigned(Node), 'Invalid parameter.'); - Result := vsVisible in Node.States; - if Result and (Node <> FRoot) then - Result := VisiblePath[Node]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetHasChildren(Node: PVirtualNode): Boolean; - -begin - if Assigned(Node) then - Result := vsHasChildren in Node.States - else - Result := vsHasChildren in FRoot.States; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetMultiline(Node: PVirtualNode): Boolean; - -begin - Result := Assigned(Node) and (Node <> FRoot) and (vsMultiline in Node.States); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNodeHeight(Node: PVirtualNode): Cardinal; - -begin - if Assigned(Node) and (Node <> FRoot) then - begin - if (toVariableNodeHeight in FOptions.FMiscOptions) and not (vsDeleting in Node.States) then - begin - if not (vsInitialized in Node.States) then - InitNode(Node); - - // Ensure the node's height is determined. - MeasureItemHeight(Self.Canvas, Node); - end; - Result := Node.NodeHeight; - end - else - Result := 0; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNodeParent(Node: PVirtualNode): PVirtualNode; - -begin - if Assigned(Node) and (Node.Parent <> FRoot) then - Result := Node.Parent - else - Result := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetOffset(pElement: TVTElement; pNode: PVirtualNode): integer; -// Calculates the offset of the given element -var - lOffsets: TVTOffsets; -begin - GetOffsets(pNode, lOffsets, pElement); - Exit(lOffsets[pElement]); -end; - -procedure TBaseVirtualTree.GetOffsets(pNode: PVirtualNode; out pOffsets: TVTOffsets; pElement: TVTElement = TVTElement.ofsEndOfClientArea; pColumn: Integer = NoColumn); -// Calculates the offset up to the given element and supplies them in an array. -var - lNodeLevel: Integer; -begin - // If no specific column was given, assume the main column - if pColumn = -1 then - pColumn := Header.MainColumn; - - // Left Margin - pOffsets[TVTElement.ofsMargin] := FMargin; - if pElement = ofsMargin then - exit; - pOffsets[TVTElement.ofsCheckBox] := FMargin + fImagesMargin; - if (pColumn = Header.MainColumn) then - begin - if not (toFixedIndent in TreeOptions.PaintOptions) then begin - // plus Indent - lNodeLevel := GetNodeLevel(pNode); - if toShowRoot in FOptions.FPaintOptions then - Inc(lNodeLevel); - end - else - lNodeLevel := 1; - Inc(pOffsets[TVTElement.ofsCheckBox], lNodeLevel * Integer(FIndent)); - // toggle buttons - pOffsets[TVTElement.ofsToggleButton] := pOffsets[TVTElement.ofsCheckBox] - fImagesMargin - ((Integer(FIndent) - FPlusBM.Width) div 2) + 1 - FPlusBM.Width; //Compare PaintTree() relative line 107 - end;//if MainColumn - - // The area in which the toggle buttons are painted must have exactly the size of one indent level - if pElement <= TVTElement.ofsCheckBox then - exit; - - // right of checkbox, left of state image - if (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and (pNode.CheckType <> ctNone) and (pColumn = Header.MainColumn) then - pOffsets[TVTElement.ofsStateImage] := pOffsets[TVTElement.ofsCheckBox] + FCheckImages.Width + fImagesMargin - else - pOffsets[TVTElement.ofsStateImage] := pOffsets[TVTElement.ofsCheckBox]; - if pElement = TVTElement.ofsStateImage then - exit; - // right of left image, left of normal image - pOffsets[TVTElement.ofsImage] := pOffsets[TVTElement.ofsStateImage] + GetImageSize(pNode, TVTImageKind.ikState, pColumn).cx; - if pElement = TVTElement.ofsImage then - exit; - // label - pOffsets[TVTElement.ofsLabel] := pOffsets[TVTElement.ofsImage] + GetImageSize(pNode, TVTImageKind.ikNormal, pColumn).cx; - pOffsets[TVTElement.ofsText] := pOffsets[TVTElement.ofsLabel] + FTextMargin; - Dec(pOffsets[TVTElement.ofsText]); //TODO: This should no longer be necessary once issue #369 is resolved. - if pElement <= TVTElement.ofsText then - exit; - - // End of text - pOffsets[TVTElement.ofsRightOfText] := pOffsets[TVTElement.ofsText] + DoGetNodeWidth(pNode, pColumn) + DoGetNodeExtraWidth(pNode, pColumn); - - // end of client area - pOffsets[TVTElement.ofsEndOfClientArea] := Max(FRangeX, ClientWidth) - FTextMargin; -end; - -function TBaseVirtualTree.GetOffsetXY: TPoint; - -begin - Result := Point(FOffsetX, FOffsetY); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetRangeX: Cardinal; -begin - Result := Max(0, FRangeX); -end; - -function TBaseVirtualTree.GetRootNodeCount: Cardinal; - -begin - Result := FRoot.ChildCount; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetSelected(Node: PVirtualNode): Boolean; - -begin - Result := Assigned(Node) and (vsSelected in Node.States); -end; - -function TBaseVirtualTree.GetSelectedData: TArray; -var - lItem: PVirtualNode; - i: Integer; -begin - SetLEngth(Result, Self.SelectedCount); - lItem := Self.GetFirstSelected; - for i := 0 to SelectedCount - 1 do - begin - Result[i] := Self.GetNodeData(lItem); - lItem := Self.GetNextSelected(lItem); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetTopNode: PVirtualNode; - -var - Dummy: Integer; - -begin - Result := GetNodeAt(0, 0, True, Dummy); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetTotalCount: Cardinal; - -begin - Inc(FUpdateCount); - try - ValidateNode(FRoot, True); - finally - Dec(FUpdateCount); - end; - // The root node itself doesn't count as node. - Result := FRoot.TotalCount - 1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetVerticalAlignment(Node: PVirtualNode): Byte; - -begin - Result := Node.Align; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetVisible(Node: PVirtualNode): Boolean; - -// Determines if the given node is marked as being visible. - -begin - if Node = nil then - Node := FRoot; - - if not (vsInitialized in Node.States) then - InitNode(Node); - - Result := vsVisible in Node.States; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetVisiblePath(Node: PVirtualNode): Boolean; - -// Determines if all parents of the given node are expanded and have the visibility flag set. - -begin - Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameters.'); - - // FRoot is always expanded - repeat - Node := Node.Parent; - until (Node = FRoot) or not (vsExpanded in Node.States) or not (vsVisible in Node.States); - - Result := Node = FRoot; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.HandleClickSelection(LastFocused, NewNode: PVirtualNode; Shift: TShiftState; - DragPending: Boolean); - -// Handles multi-selection with mouse click. - -begin - // Ctrl key down - if ssCtrl in Shift then - begin - if ssShift in Shift then - begin - SelectNodes(FRangeAnchor, NewNode, True); - end - else - begin - if not (toSiblingSelectConstraint in FOptions.SelectionOptions) then - FRangeAnchor := NewNode; - // Delay selection change if a drag operation is pending. - // Otherwise switch selection state here. - if DragPending then - DoStateChange([tsToggleFocusedSelection]) - else - if vsSelected in NewNode.States then - RemoveFromSelection(NewNode) - else - AddToSelection(NewNode, True); - end; - end - else - // Shift key down - if ssShift in Shift then - begin - if FRangeAnchor = nil then - FRangeAnchor := FRoot.FirstChild; - - // select node range - if Assigned(FRangeAnchor) then - begin - SelectNodes(FRangeAnchor, NewNode, False); - Invalidate; - end; - end - else - begin - // any other case - if not (vsSelected in NewNode.States) then - AddToSelection(NewNode, True); - // assign new reference item - FRangeAnchor := NewNode; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.HandleDrawSelection(X, Y: Integer): Boolean; - -// Handles multi-selection with a focus rectangle. -// Result is True if something changed in selection. - -var - OldRect, - NewRect: TRect; - MainColumn: TColumnIndex; - MaxValue: Integer; - - // limits of a node and its text - NodeLeft, - NodeRight: Integer; - - // alignment and directionality - CurrentBidiMode: TBidiMode; - CurrentAlignment: TAlignment; - -begin - Result := False; - - // Selection changes are only done if the user drew a selection rectangle large - // enough to exceed the threshold. - if (FRoot.TotalCount > 1) and (tsDrawSelecting in FStates) then - begin - // Effective handling of node selection is done by using two rectangles stored in FSelectRec. - OldRect := OrderRect(FLastSelRect); - NewRect := OrderRect(FNewSelRect); - ClearTempCache; - - MainColumn := FHeader.MainColumn; - - // Alignment and bidi mode determine where the node text is located within a node. - if MainColumn <= NoColumn then - begin - CurrentBidiMode := BidiMode; - CurrentAlignment := Alignment; - end - else - begin - CurrentBidiMode := FHeader.FColumns[MainColumn].BidiMode; - CurrentAlignment := FHeader.FColumns[MainColumn].Alignment; - end; - - // Determine initial left border of first node (take column reordering into account). - if FHeader.UseColumns then - begin - // The mouse coordinates don't include any horizontal scrolling hence take this also - // out from the returned column position. - NodeLeft := FHeader.FColumns[MainColumn].Left + FEffectiveOffsetX; - NodeRight := NodeLeft + FHeader.FColumns[MainColumn].Width; - end - else - begin - NodeLeft := 0 + FEffectiveOffsetX; - NodeRight := NodeLeft + ClientWidth; - end; - if CurrentBidiMode = bdLeftToRight then - Result := CollectSelectedNodesLTR(MainColumn, NodeLeft, NodeRight, CurrentAlignment, OldRect, NewRect) - else - Result := CollectSelectedNodesRTL(MainColumn, NodeLeft, NodeRight, CurrentAlignment, OldRect, NewRect); - end; - - if Result then - begin - // Do some housekeeping if there was a change. - MaxValue := PackArray(FSelection, FSelectionCount); - if MaxValue > -1 then - begin - FSelectionCount := MaxValue; - SetLength(FSelection, FSelectionCount); - end; - if FTempNodeCount > 0 then - begin - if tsClearOnNewSelection in fStates then - begin - DoStateChange([], [tsClearOnNewSelection]); - ClearSelection(False); - end; - - AddToSelection(FTempNodeCache, FTempNodeCount); - ClearTempCache; - end; - - Change(nil); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.HasVisibleNextSibling(Node: PVirtualNode): Boolean; - -// Helper method to determine if the given node has a visible next sibling. This is needed to -// draw correct tree lines. - -begin - // Check if there is a sibling at all. - Result := Assigned(Node.NextSibling); - - if Result then - begin - repeat - Node := Node.NextSibling; - Result := IsEffectivelyVisible[Node]; - until Result or (Node.NextSibling = nil); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.HasVisiblePreviousSibling(Node: PVirtualNode): Boolean; - -// Helper method to determine if the given node has a visible previous sibling. This is needed to -// draw correct tree lines. - -begin - // Check if there is a sibling at all. - Result := Assigned(Node.PrevSibling); - - if Result then - begin - repeat - Node := Node.PrevSibling; - Result := IsEffectivelyVisible[Node]; - until Result or (Node.PrevSibling = nil); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ImageListChange(Sender: TObject); - -begin - if not (csDestroying in ComponentState) then - Invalidate; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InitializeFirstColumnValues(var PaintInfo: TVTPaintInfo); - -// Determines initial index, position and cell size of the first visible column. - -begin - PaintInfo.Column := FHeader.FColumns.GetFirstVisibleColumn; - with FHeader.FColumns, PaintInfo do - begin - if Column > NoColumn then - begin - CellRect.Right := CellRect.Left + Items[Column].Width; - Position := Items[Column].Position; - end - else - Position := 0; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InitRecursive(Node: PVirtualNode; Levels: Cardinal = MaxInt; pVisibleOnly: Boolean = True); - -// Initializes a node and optionally its children up to a certain level. -// The sepcified number of levels are latrive to the givne Node. - -var - Run: PVirtualNode; -begin - if not Assigned(Node) then - Node := FRoot; - - if (Node <> FRoot) and not (vsInitialized in Node.States) then - InitNode(Node); - if (Levels = 0) or (pVisibleOnly and not (vsExpanded in Node.States)) then - exit; - Run := Node.FirstChild; - - while Assigned(Run) do - begin - InitRecursive(Run, Levels - 1, pVisibleOnly); - Run := Run.NextSibling; - end; -end; - -procedure TBaseVirtualTree.InitRootNode(OldSize: Cardinal = 0); - -// Reinitializes the root node. - -var - NewSize: Cardinal; - -begin - NewSize := TreeNodeSize + FTotalInternalDataSize; - if FRoot = nil then - FRoot := AllocMem(NewSize) - else - begin - ReallocMem(FRoot, NewSize); - ZeroMemory(PByte(FRoot) + OldSize, NewSize - OldSize); - end; - - with FRoot^ do - begin - // Indication that this node is the root node. - PrevSibling := FRoot; - NextSibling := FRoot; - Parent := Pointer(Self); - States := [vsInitialized, vsExpanded, vsHasChildren, vsVisible]; - TotalHeight := FDefaultNodeHeight; - TotalCount := 1; - NodeHeight := FDefaultNodeHeight; - Align := 50; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InterruptValidation; - -var - WasValidating: Boolean; - -begin - DoStateChange([tsStopValidation], [tsUseCache]); - - // Check the worker thread existance. It might already be gone (usually on destruction of the last tree). - WasValidating := (tsValidating in FStates); - TWorkerThread.RemoveTree(Self); - if WasValidating then - InvalidateCache(); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.IsFirstVisibleChild(Parent, Node: PVirtualNode): Boolean; - -// Helper method to check if Node is the same as the first visible child of Parent. - -var - Run: PVirtualNode; - -begin - // Find first visible child. - Run := Parent.FirstChild; - while Assigned(Run) and not IsEffectivelyVisible[Run] do - Run := Run.NextSibling; - - Result := Assigned(Run) and (Run = Node); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.IsLastVisibleChild(Parent, Node: PVirtualNode): Boolean; - -// Helper method to check if Node is the same as the last visible child of Parent. - -var - Run: PVirtualNode; - -begin - // Find last visible child. - Run := Parent.LastChild; - while Assigned(Run) and not IsEffectivelyVisible[Run] do - Run := Run.PrevSibling; - - Result := Assigned(Run) and (Run = Node); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.MakeNewNode: PVirtualNode; - -var - Size: Cardinal; - -begin - Size := TreeNodeSize; - if not (csDesigning in ComponentState) then - begin // Make sure FNodeDataSize is valid. - if FNodeDataSize <= 0 then - ValidateNodeDataSize(FNodeDataSize); - - // Take record alignment into account. - Inc(Size, FNodeDataSize); - end//not csDesigning - else - Inc(Size, SizeOf(Pointer)); // Fixes #702 - - - Result := AllocMem(Size + FTotalInternalDataSize); - - // Fill in some default values. - with Result^ do - begin - TotalCount := 1; - TotalHeight := FDefaultNodeHeight; - NodeHeight := FDefaultNodeHeight; - States := [vsVisible]; - Align := 50; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.PackArray({*}const TheArray: TNodeArray; Count: Integer): Integer; assembler; -// *This is an optimization to get as near as possible with the PUREPASCAL code without the -// compiler generating a _DynArrayAddRef call. We still modify the array's content via pointers. - -// Removes all entries from the selection array which are no longer in use. The selection array must be sorted for this -// algo to work. Values which must be removed are marked with bit 0 (LSB) set. This little trick works because memory -// is always allocated DWORD aligned. Since the selection array must be sorted while determining the entries to be -// removed it is much more efficient to increment the entry in question instead of setting it to nil (which would break -// the ordered appearance of the list). -// -// On enter EAX contains self reference, EDX the address to TheArray and ECX Count -// The returned value is the number of remaining entries in the array, so the caller can reallocate (shorten) -// the selection array if needed or -1 if nothing needs to be changed. - -{$ifdef CPUX64} -var - Source, Dest: ^PVirtualNode; - ConstOne: NativeInt; -begin - Source := Pointer(TheArray); - ConstOne := 1; - Result := 0; - // Do the fastest scan possible to find the first entry - while (Count <> 0) and {not Odd(NativeInt(Source^))} (NativeInt(Source^) and ConstOne = 0) do - begin - Inc(Result); - Inc(Source); - Dec(Count); - end; - - if Count <> 0 then - begin - Dest := Source; - repeat - // Skip odd entries - if {not Odd(NativeInt(Source^))} NativeInt(Source^) and ConstOne = 0 then - begin - Dest^ := Source^; - Inc(Result); - Inc(Dest); - end; - Inc(Source); // Point to the next entry - Dec(Count); - until Count = 0; - end; -end; -{$else} -asm - PUSH EBX - PUSH EDI - PUSH ESI - MOV ESI, EDX - MOV EDX, -1 - JCXZ @@Finish // Empty list? - INC EDX // init remaining entries counter - MOV EDI, ESI // source and destination point to the list memory - MOV EBX, 1 // use a register instead of immediate operant to check against -@@PreScan: - TEST [ESI], EBX // do the fastest scan possible to find the first entry - // which must be removed - JNZ @@DoMainLoop - INC EDX - ADD ESI, 4 - DEC ECX - JNZ @@PreScan - JMP @@Finish - -@@DoMainLoop: - MOV EDI, ESI -@@MainLoop: - TEST [ESI], EBX // odd entry? - JNE @@Skip // yes, so skip this one - MOVSD // else move the entry to new location - INC EDX // count the moved entries - DEC ECX - JNZ @@MainLoop // do it until all entries are processed - JMP @@Finish - -@@Skip: - ADD ESI, 4 // point to the next entry - DEC ECX - JNZ @@MainLoop // do it until all entries are processed -@@Finish: - MOV EAX, EDX // prepare return value - POP ESI - POP EDI - POP EBX -end; -{$endif CPUX64} - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.PrepareBitmaps(NeedButtons, NeedLines: Boolean); - -// initializes the contents of the internal bitmaps - -const - LineBitsDotted: array [0..8] of Word = ($55, $AA, $55, $AA, $55, $AA, $55, $AA, $55); - LineBitsSolid: array [0..7] of Word = (0, 0, 0, 0, 0, 0, 0, 0); - -var - PatternBitmap: HBITMAP; - Bits: Pointer; - Size: TSize; - Theme: HTHEME; - R: TRect; - - //--------------- local function -------------------------------------------- - - procedure FillBitmap (ABitmap: TBitmap); - begin - with ABitmap, Canvas do - begin - SetSize(Size.cx, Size.cy); - - if IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) or VclStyleEnabled then - begin - if (FHeader.MainColumn > NoColumn) then - Brush.Color := FHeader.FColumns[FHeader.MainColumn].GetEffectiveColor - else - Brush.Color := FColors.BackGroundColor; - end - else - Brush.Color := clFuchsia; - - Transparent := True; - TransparentColor := Brush.Color; - - FillRect(Rect(0, 0, Width, Height)); - end; - end; - - //--------------- end local function ---------------------------------------- - -begin - if VclStyleEnabled and (seClient in StyleElements) then - begin - Size.cx := ScaledPixels(11); - Size.cy := ScaledPixels(11); - FillBitmap(FPlusBM); - FillBitmap(FHotPlusBM); - FillBitmap(FSelectedHotPlusBM); - FillBitmap(FMinusBM); - FillBitmap(FHotMinusBM); - FillBitmap(FSelectedHotMinusBM); - R := Rect(0,0,Size. cx,Size.cy); - // tcbCategoryGlyphClosed, tcbCategoryGlyphOpened from CategoryButtons - StyleServices.DrawElement(FPlusBM.Canvas.Handle, StyleServices.GetElementDetails(tcbCategoryGlyphClosed), R); - StyleServices.DrawElement(FMinusBM.Canvas.Handle, StyleServices.GetElementDetails(tcbCategoryGlyphOpened), R); - FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); - FSelectedHotMinusBM.Canvas.Draw(0, 0, FMinusBM); - FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); - FSelectedHotPlusBM.Canvas.Draw(0, 0, FPlusBM); - if Assigned(FOnPrepareButtonImages) then - FOnPrepareButtonImages(Self, FPlusBM, FHotPlusBM, FSelectedHotPlusBM, FMinusBM, FHotMinusBM, FSelectedHotMinusBM, size); - end - else - begin - Size.cx := 9; - Size.cy := 9; - if tsUseThemes in FStates then - begin - R := Rect(0, 0, 100, 100); - Theme := OpenThemeData(Handle, 'TREEVIEW'); - GetThemePartSize(Theme, FPlusBM.Canvas.Handle, TVP_GLYPH, GLPS_OPENED, @R, TS_TRUE, Size); - end - else - Theme := 0; - - if NeedButtons then - begin - //VCL Themes do not really have ability to provide tree plus/minus images when not using the - //windows theme. The bitmap style designer doesn't have any elements for for them, and you - //cannot name any elements you add, which makes it useless. - //To mitigate this, Hook up the OnPrepareButtonImages and draw them yourself. - if Assigned(FOnPrepareButtonImages) then - begin - FillBitmap(FPlusBM); - FillBitmap(FHotPlusBM); - FillBitmap(FSelectedHotPlusBM); - FillBitmap(FMinusBM); - FillBitmap(FHotMinusBM); - FillBitmap(FSelectedHotMinusBM); - FOnPrepareButtonImages(Self, FPlusBM, FHotPlusBM, FSelectedHotPlusBM, FMinusBM, FHotMinusBM, FSelectedHotMinusBM, size); - end - else - begin - with FMinusBM, Canvas do - begin - // box is always of odd size - FillBitmap(FMinusBM); - FillBitmap(FHotMinusBM); - FillBitmap(FSelectedHotMinusBM); - // Weil die selbstgezeichneten Bitmaps sehen im Vcl Style scheiße aus - // Because the self-drawn bitmaps view Vcl Style shit - if Theme = 0 then - begin - if not(tsUseExplorerTheme in FStates) then - begin - if FButtonStyle = bsTriangle then - begin - Brush.Color := clBlack; - Pen.Color := clBlack; - Polygon([Point(0, 2), Point(8, 2), Point(4, 6)]); - end - else - begin - // Button style is rectangular. Now ButtonFillMode determines how to fill the interior. - if FButtonFillMode in [fmTreeColor, fmWindowColor, fmTransparent] then - begin - case FButtonFillMode of - fmTreeColor: - Brush.Color := FColors.BackGroundColor; - fmWindowColor: - Brush.Color := clWindow; - end; - Pen.Color := FColors.TreeLineColor; - Rectangle(0, 0, Width, Height); - Pen.Color := FColors.NodeFontColor; - 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); - end; - end; - end; - with FPlusBM, Canvas do - begin - FillBitmap(FPlusBM); - FillBitmap(FHotPlusBM); - FillBitmap(FSelectedHotPlusBM); - if Theme = 0 then - begin - if not(tsUseExplorerTheme in FStates) then - begin - if FButtonStyle = bsTriangle then - begin - Brush.Color := clBlack; - Pen.Color := clBlack; - Polygon([Point(2, 0), Point(6, 4), Point(2, 8)]); - end - else - begin - // Button style is rectangular. Now ButtonFillMode determines how to fill the interior. - if FButtonFillMode in [fmTreeColor, fmWindowColor, fmTransparent] then - begin - case FButtonFillMode of - fmTreeColor: - Brush.Color := FColors.BackGroundColor; - fmWindowColor: - Brush.Color := clWindow; - end; - Pen.Color := FColors.TreeLineColor; - Rectangle(0, 0, Width, Height); - Pen.Color := FColors.NodeFontColor; - MoveTo(2, Width div 2); - LineTo(Width - 2, Width div 2); - 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); - end; - end; - end; - - - // Overwrite glyph images if theme is active. - if (tsUseThemes in FStates) and (Theme <> 0) then - begin - R := Rect(0, 0, Size.cx, Size.cy); - DrawThemeBackground(Theme, FPlusBM.Canvas.Handle, TVP_GLYPH, GLPS_CLOSED, R, nil); - DrawThemeBackground(Theme, FMinusBM.Canvas.Handle, TVP_GLYPH, GLPS_OPENED, R, nil); - if tsUseExplorerTheme in FStates then - begin - DrawThemeBackground(Theme, FHotPlusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_CLOSED, R, nil); - DrawThemeBackground(Theme, FSelectedHotPlusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_CLOSED, R, nil); - DrawThemeBackground(Theme, FHotMinusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_OPENED, R, nil); - DrawThemeBackground(Theme, FSelectedHotMinusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_OPENED, R, nil); - end - else - begin - FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); - FSelectedHotPlusBM.Canvas.Draw(0, 0, FPlusBM); - FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); - FSelectedHotMinusBM.Canvas.Draw(0, 0, FMinusBM); - end; - end; - end; - if tsUseThemes in FStates then - CloseThemeData(Theme); - end; - end; - - if NeedLines then - begin - if FDottedBrush <> 0 then - DeleteObject(FDottedBrush); - case FLineStyle of - lsDotted: - Bits := @LineBitsDotted; - lsSolid: - Bits := @LineBitsSolid; - else // lsCustomStyle - Bits := @LineBitsDotted; - DoGetLineStyle(Bits); - end; - PatternBitmap := CreateBitmap(8, 8, 1, 1, Bits); - FDottedBrush := CreatePatternBrush(PatternBitmap); - DeleteObject(PatternBitmap); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetAlignment(const Value: TAlignment); - -begin - if FAlignment <> Value then - begin - FAlignment := Value; - if not (csLoading in ComponentState) then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetAnimationDuration(const Value: Cardinal); - -begin - FAnimationDuration := Value; - if FAnimationDuration = 0 then - Exclude(FOptions.FAnimationOptions, toAnimatedToggle) - else - Include(FOptions.FAnimationOptions, toAnimatedToggle); -end; - -//---------------------------------------------------------------------------------------------------------------------- -{ New, Support for transparent background: - * Image types: BMP, PNG, GIF, ICO, EMF, TIFF and WMF are automatically identified to support transparent background - * Also detects certain third party image classes registered for PNG, GIF and other image types so that the - transparency related code is used for them. See the code below. - * If some other third party image class is registered that is not detected, - set the flag BackgroundTransparentExternalType explicitly in order to properly do - transparent painting. -} -procedure TBaseVirtualTree.SetBackground(const Value: TPicture); - -begin - FBackground.Assign(Value); - Invalidate; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetBackGroundImageTransparent(const Value: Boolean); - -begin - if Value <> FBackGroundImageTransparent then - begin - FBackGroundImageTransparent := Value; - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetBackgroundOffset(const Index, Value: Integer); - -begin - case Index of - 0: - if FBackgroundOffsetX <> Value then - begin - FBackgroundOffsetX := Value; - Invalidate; - end; - 1: - if FBackgroundOffsetY <> Value then - begin - FBackgroundOffsetY := Value; - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetBorderStyle(Value: TBorderStyle); - -begin - if FBorderStyle <> Value then - begin - FBorderStyle := Value; - RecreateWnd; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetBottomNode(Node: PVirtualNode); - -var - Run: PVirtualNode; - R: TRect; - -begin - if Assigned(Node) then - begin - // make sure all parents of the node are expanded - Run := Node.Parent; - while Run <> FRoot do - begin - if not (vsExpanded in Run.States) then - ToggleNode(Run); - Run := Run.Parent; - end; - R := GetDisplayRect(Node, FHeader.MainColumn, True); - DoSetOffsetXY(Point(FOffsetX, FOffsetY + ClientHeight - R.Top - Integer(NodeHeight[Node])), - [suoRepaintScrollBars, suoUpdateNCArea]); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetBottomSpace(const Value: Cardinal); - -begin - if FBottomSpace <> Value then - begin - FBottomSpace := Value; - UpdateVerticalScrollBar(True); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetButtonFillMode(const Value: TVTButtonFillMode); - -begin - if FButtonFillMode <> Value then - begin - FButtonFillMode := Value; - if not (csLoading in ComponentState) then - begin - PrepareBitmaps(True, False); - if HandleAllocated then - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetButtonStyle(const Value: TVTButtonStyle); - -begin - if FButtonStyle <> Value then - begin - FButtonStyle := Value; - if not (csLoading in ComponentState) then - begin - PrepareBitmaps(True, False); - if HandleAllocated then - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetCheckState(Node: PVirtualNode; Value: TCheckState); - -begin - if (Node.CheckState <> Value) and DoChecking(Node, Value) then - DoCheckClick(Node, Value); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetCheckStateForAll(aCheckState: TCheckState; pSelectedOnly: Boolean; pExcludeDisabled: Boolean = True); - -// Changes the check state for all or for all seledcted nodes. -// aCheckState: The new check state. -// pSelectedOnly: If passed True, only the selected nodes will bechnaged, if passed False all nodes in the control will be changed. -// pExcludeDisabled: Optiopnal. If passed True (the default value), disabled checkboxes won't be changed, if passed False disabled checkboxes will be altered too. - -var - lItem : PVirtualNode; -begin - With Self do begin - Screen.Cursor := crHourGlass; - BeginUpdate; - try - if pSelectedOnly then - lItem := GetFirstSelected - else - lItem := GetFirst; - //for i:=0 to List.Items.Count-1 do begin - while Assigned(lItem) do begin - if not pExcludeDisabled or not CheckState[lItem].IsDisabled() then - CheckState[lItem] := aCheckState; - if pSelectedOnly then - lItem := GetNextSelected(lItem) - else - lItem := GetNext(lItem); - end;//while - finally - Screen.Cursor := crDefault; - EndUpdate; - end;//try..finally - end;//With -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetCheckType(Node: PVirtualNode; Value: TCheckType); - -begin - if (Node.CheckType <> Value) and not (toReadOnly in FOptions.FMiscOptions) then - begin - Node.CheckType := Value; - if (Value <> ctTriStateCheckBox) and (Node.CheckState in [csMixedNormal, csMixedPressed]) then - Node.CheckState := csUncheckedNormal;// reset check state if it doesn't fit the new check type - // For check boxes with tri-state check box parents we have to initialize differently. - if (toAutoTriStateTracking in FOptions.FAutoOptions) and (Value in [ctCheckBox, ctTriStateCheckBox]) and - (Node.Parent <> FRoot) then - begin - if not (vsInitialized in Node.Parent.States) then - InitNode(Node.Parent); - if (Node.Parent.CheckType = ctTriStateCheckBox) then begin - if (GetCheckState(Node.Parent) in [csUncheckedNormal, csUncheckedDisabled]) then - CheckState[Node] := csUncheckedNormal - else if (GetCheckState(Node.Parent) in [csCheckedNormal, csCheckedDisabled]) then - CheckState[Node] := csCheckedNormal; - end;//if - end;//if - InvalidateNode(Node); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal); - -// Changes a node's child structure to accomodate the new child count. This is used to add or delete -// child nodes to/from the end of the node's child list. To insert or delete a specific node a separate -// routine is used. - -var - Remaining: Cardinal; - Index: Cardinal; - Child: PVirtualNode; - Count: Integer; - NewHeight: Integer; -begin - if not (toReadOnly in FOptions.FMiscOptions) then - begin - if Node = nil then - Node := FRoot; - - Assert(GetCurrentThreadId = MainThreadId, 'UI controls may only be chnaged in UI thread.'); - if NewChildCount = 0 then - DeleteChildren(Node) - else - begin - // If nothing changed then do nothing. - if NewChildCount <> Node.ChildCount then - begin - InterruptValidation; - - if NewChildCount > Node.ChildCount then - begin - Remaining := NewChildCount - Node.ChildCount; - Count := Remaining; - NewHeight := Node.TotalHeight; - - // New nodes to add. - if Assigned(Node.LastChild) then - Index := Node.LastChild.Index + 1 - else - begin - Index := 0; - Include(Node.States, vsHasChildren); - end; - Node.States := Node.States - [vsAllChildrenHidden, vsHeightMeasured]; - if (vsExpanded in Node.States) and FullyVisible[Node] then - Inc(FVisibleCount, Count); // Do this before a possible init of the sub-nodes in DoMeasureItem() - - // New nodes are by default always visible, so we don't need to check the visibility. - while Remaining > 0 do - begin - Child := MakeNewNode; - Child.Index := Index; - Child.PrevSibling := Node.LastChild; - if Assigned(Node.LastChild) then - Node.LastChild.NextSibling := Child; - Child.Parent := Node; - Node.LastChild := Child; - if Node.FirstChild = nil then - Node.FirstChild := Child; - Dec(Remaining); - Inc(Index); - - if (toVariableNodeHeight in FOptions.FMiscOptions) then - GetNodeHeight(Child); - Inc(NewHeight, Child.TotalHeight); - end; - - if vsExpanded in Node.States then - AdjustTotalHeight(Node, NewHeight, False); - - AdjustTotalCount(Node, Count, True); - Node.ChildCount := NewChildCount; - if (FUpdateCount = 0) and (toAutoSort in FOptions.FAutoOptions) and (FHeader.FSortColumn > InvalidColumn) then - Sort(Node, FHeader.FSortColumn, FHeader.FSortDirection, True); - - InvalidateCache; - end//if NewChildCount > Node.ChildCount - else - begin - // Nodes have to be deleted. - Remaining := Node.ChildCount - NewChildCount; - while Remaining > 0 do - begin - DeleteNode(Node.LastChild); - Dec(Remaining); - end; - end; - - if FUpdateCount = 0 then - begin - ValidateCache; - UpdateScrollBars(True); - Invalidate; - end; - - if Node = FRoot then - StructureChange(nil, crChildAdded) - else - StructureChange(Node, crChildAdded); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetClipboardFormats(const Value: TClipboardFormats); - -var - I: Integer; - -begin - // Add string by string instead doing an Assign or AddStrings because the list may return -1 for - // invalid entries which cause trouble for the standard implementation. - FClipboardFormats.Clear; - for I := 0 to Value.Count - 1 do - FClipboardFormats.Add(Value[I]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetColors(const Value: TVTColors); - -begin - FColors.Assign(Value); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetCheckImageKind(Value: TCheckImageKind); -begin - if (Value < Low(Value)) or (Value> High(Value)) then - Value := ckSystemDefault; - // property is deprecated. See issue #622 - if FCheckImageKind <> Value then - begin - if FCheckImageKind = ckSystemDefault then - FreeAndNil(FCheckImages); - FCheckImageKind := Value; - if Value = ckCustom then - FCheckImages := FCustomCheckImages - else if HandleAllocated then - FCheckImages := CreateSystemImageSet(Self); - if HandleAllocated and (FUpdateCount = 0) and not (csLoading in ComponentState) then - InvalidateRect(Handle, nil, False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetCustomCheckImages(const Value: TCustomImageList); - -begin - if FCustomCheckImages <> Value then - begin - if Assigned(FCustomCheckImages) then - begin - FCustomCheckImages.UnRegisterChanges(FCustomCheckChangeLink); - FCustomCheckImages.RemoveFreeNotification(Self); - // Reset the internal check image list reference too, if necessary. - if FCheckImages = FCustomCheckImages then - FCheckImages := nil; - end; - FCustomCheckImages := Value; - if Assigned(FCustomCheckImages) then - begin - // If custom check images are assigned, we switch the property CheckImageKind to ckCustom so that they are actually used - CheckImageKind := ckCustom; - FCustomCheckImages.RegisterChanges(FCustomCheckChangeLink); - FCustomCheckImages.FreeNotification(Self); - end - else - CheckImageKind := ckSystemDefault; - if not (csLoading in ComponentState) then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetDefaultNodeHeight(Value: Cardinal); - -begin - if Value = 0 then - Value := 18; - if FDefaultNodeHeight <> Value then - begin - Inc(Integer(FRoot.TotalHeight), Integer(Value) - Integer(FDefaultNodeHeight)); - Inc(SmallInt(FRoot.NodeHeight), Integer(Value) - Integer(FDefaultNodeHeight)); - FDefaultNodeHeight := Value; - InvalidateCache; - if (FUpdateCount = 0) and HandleAllocated and not (csLoading in ComponentState) then - begin - ValidateCache; - UpdateScrollBars(True); - ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions, True); - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetDisabled(Node: PVirtualNode; Value: Boolean); - -begin - if Assigned(Node) and (Value xor (vsDisabled in Node.States)) then - begin - if Value then - Include(Node.States, vsDisabled) - else - Exclude(Node.States, vsDisabled); - - if FUpdateCount = 0 then - InvalidateNode(Node); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetDoubleBuffered(const Value: Boolean); -begin - // empty by intention, we do our own buffering -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetDoubleBuffered: Boolean; -begin - Result := True; // we do our own buffering -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetEmptyListMessage(const Value: string); - -begin - if Value <> EmptyListMessage then - begin - FEmptyListMessage := Value; - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetExpanded(Node: PVirtualNode; Value: Boolean); - -begin - if Assigned(Node) and (Node <> FRoot) and (Value xor (vsExpanded in Node.States)) then - ToggleNode(Node); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetFocusedColumn(Value: TColumnIndex); - -begin - if (FFocusedColumn <> Value) and - DoFocusChanging(FFocusedNode, FFocusedNode, FFocusedColumn, Value) then - begin - CancelEditNode; - InvalidateColumn(FFocusedColumn); - InvalidateColumn(Value); - FFocusedColumn := Value; - if Assigned(FFocusedNode) and not (toDisableAutoscrollOnFocus in FOptions.FAutoOptions) then - begin - if ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions, True) then - InvalidateNode(FFocusedNode); - end; - - if Assigned(FDropTargetNode) then - InvalidateNode(FDropTargetNode); - - DoFocusChange(FFocusedNode, FFocusedColumn); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetFocusedNode(Value: PVirtualNode); - -var - WasDifferent: Boolean; - -begin - WasDifferent := Value <> FFocusedNode; - DoFocusNode(Value, True); - // Do change event only if there was actually a change. - if WasDifferent and (FFocusedNode = Value) then - DoFocusChange(FFocusedNode, FFocusedColumn); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetFullyVisible(Node: PVirtualNode; Value: Boolean); - -// This method ensures that a node is visible and all its parent nodes are expanded and also visible -// if Value is True. Otherwise the visibility flag of the node is reset but the expand state -// of the parent nodes stays untouched. - -begin - Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter'); - - IsVisible[Node] := Value; - if Value then - begin - repeat - Node := Node.Parent; - if Node = FRoot then - Break; - if not (vsExpanded in Node.States) then - ToggleNode(Node); - if not (vsVisible in Node.States) then - IsVisible[Node] := True; - until False; - end; - ScrollIntoView(Node, False); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetHasChildren(Node: PVirtualNode; Value: Boolean); - -begin - if Assigned(Node) and not (toReadOnly in FOptions.FMiscOptions) then - begin - if Value then - Include(Node.States, vsHasChildren) - else - begin - Exclude(Node.States, vsHasChildren); - DeleteChildren(Node); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetHeader(const Value: TVTHeader); - -begin - FHeader.Assign(Value); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetHotNode(Value: PVirtualNode); - -begin - FCurrentHotNode := Value; -end; - - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetFiltered(Node: PVirtualNode; Value: Boolean); - -// Sets the 'filtered' flag of the given node according to Value and updates all dependent states. - -var - NeedUpdate: Boolean; - -begin - Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); - - // Initialize the node if necessary as this might change the filtered state. - if not (vsInitialized in Node.States) then - InitNode(Node); - - if Value <> (vsFiltered in Node.States) then - begin - InterruptValidation; - NeedUpdate := False; - if Value then - begin - Include(Node.States, vsFiltered); - if not (toShowFilteredNodes in FOptions.FPaintOptions) then - begin - if (vsInitializing in Node.States) and not (vsHasChildren in Node.States) then - AdjustTotalHeight(Node, 0, False) - else - AdjustTotalHeight(Node, -Integer(NodeHeight[Node]), True); - if FullyVisible[Node] then - begin - Dec(FVisibleCount); - NeedUpdate := True; - end; - if FocusedNode = Node then - FocusedNode := nil; - end; - - if FUpdateCount = 0 then - DetermineHiddenChildrenFlag(Node.Parent) - else - Include(FStates, tsUpdateHiddenChildrenNeeded); - end - else - begin - Exclude(Node.States, vsFiltered); - if not (toShowFilteredNodes in FOptions.FPaintOptions) then - begin - AdjustTotalHeight(Node, Integer(NodeHeight[Node]), True); - if FullyVisible[Node] then - begin - Inc(FVisibleCount); - NeedUpdate := True; - end; - end; - - if vsVisible in Node.States then - // Update the hidden children flag of the parent. - // Since this node is now visible we simply have to remove the flag. - Exclude(Node.Parent.States, vsAllChildrenHidden); - end; - - InvalidateCache; - if NeedUpdate and (FUpdateCount = 0) then - begin - ValidateCache; - UpdateScrollBars(True); - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.SetImages(const Value: TCustomImageList); - -begin - if FImages <> Value then - begin - if Assigned(FImages) then - begin - FImages.UnRegisterChanges(FImageChangeLink); - FImages.RemoveFreeNotification(Self); - end; - FImages := Value; - if Assigned(FImages) then - begin - FImages.RegisterChanges(FImageChangeLink); - FImages.FreeNotification(Self); - end; - if not (csLoading in ComponentState) then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetIndent(Value: Cardinal); - -begin - if FIndent <> Value then - begin - FIndent := Value; - if not (csLoading in ComponentState) and (FUpdateCount = 0) and HandleAllocated then - begin - UpdateScrollBars(True); - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetLineMode(const Value: TVTLineMode); - -begin - if FLineMode <> Value then - begin - FLineMode := Value; - if HandleAllocated and not (csLoading in ComponentState) then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetLineStyle(const Value: TVTLineStyle); - -begin - if FLineStyle <> Value then - begin - FLineStyle := Value; - if not (csLoading in ComponentState) then - begin - PrepareBitmaps(False, True); - if HandleAllocated then - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetMargin(Value: Integer); - -begin - if FMargin <> Value then - begin - FMargin := Value; - if HandleAllocated and not (csLoading in ComponentState) then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetMultiline(Node: PVirtualNode; const Value: Boolean); - -begin - if Assigned(Node) and (Node <> FRoot) then - if Value <> (vsMultiline in Node.States) then - begin - if Value then - Include(Node.States, vsMultiline) - else - Exclude(Node.States, vsMultiline); - - if FUpdateCount = 0 then - InvalidateNode(Node); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetNodeAlignment(const Value: TVTNodeAlignment); - -begin - if FNodeAlignment <> Value then - begin - FNodeAlignment := Value; - if HandleAllocated and not (csReading in ComponentState) then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetNodeData(pNode: PVirtualNode; pUserData: Pointer); - - // Can be used to set user data of a PVirtualNode with the size of a pointer, useful for setting - // A pointer to a record or a reference to a class instance. - -var - NodeData: PPointer; -begin - // Check if there is initial user data and there is also enough user data space allocated. - Assert(FNodeDataSize >= SizeOf(Pointer), Self.Classname + ': Cannot set initial user data because there is not enough user data space allocated.'); - NodeData := PPointer(@pNode.Data); - NodeData^ := pUserData; - Include(pNode.States, vsOnFreeNodeCallRequired); -end; - -procedure TBaseVirtualTree.SetNodeData(pNode: PVirtualNode; pUserData: T); - - // Can be used to set user data of a PVirtualNode to a class instance. - -begin - pNode.SetData(pUserData); -end; - -procedure TBaseVirtualTree.SetNodeData(pNode: PVirtualNode; const pUserData: IInterface); - - // Can be used to set user data of a PVirtualNode to a class instance, - // will take care about reference counting. - -begin - pNode.SetData(pUserData); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetNodeDataSize(Value: Integer); - -var - LastRootCount: Cardinal; - -begin - if Value < -1 then - Value := -1; - if FNodeDataSize <> Value then - begin - FNodeDataSize := Value; - if not (csLoading in ComponentState) and not (csDesigning in ComponentState) then - begin - LastRootCount := FRoot.ChildCount; - Clear; - SetRootNodeCount(LastRootCount); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetNodeHeight(Node: PVirtualNode; Value: Cardinal); - -var - Difference: Integer; - -begin - Assert(Assigned(Node), 'SetNodeHeight() cannot be called with Node = nil'); - Assert((Node <> FRoot), 'SetNodeHeight() cannot be called for the root node FRoot'); - if (Node.NodeHeight <> Value) then - begin - Difference := Integer(Value) - Integer(Node.NodeHeight); - Node.NodeHeight := Value; - - // If the node is effectively filtered out, nothing else has to be done, as it is not visible anyway. - if not IsEffectivelyFiltered[Node] then - begin - AdjustTotalHeight(Node, Difference, True); - - // If an edit operation is currently active then update the editors boundaries as well. - UpdateEditBounds; - - InvalidateCache; - // Stay away from touching the node cache while it is being validated. - if not (tsValidating in FStates) and FullyVisible[Node] then - begin - if (FUpdateCount = 0) and ([tsPainting, tsSizing] * FStates = []) then - begin - ValidateCache; - InvalidateToBottom(Node); - UpdateScrollBars(True); - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetNodeParent(Node: PVirtualNode; const Value: PVirtualNode); - -begin - if Assigned(Node) and Assigned(Value) and (Node.Parent <> Value) then - MoveTo(Node, Value, amAddChildLast, False); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetOffsetX(const Value: Integer); - -begin - DoSetOffsetXY(Point(Value, FOffsetY), DefaultScrollUpdateFlags); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetOffsetXY(const Value: TPoint); - -begin - DoSetOffsetXY(Value, DefaultScrollUpdateFlags); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetOffsetY(const Value: Integer); - -begin - DoSetOffsetXY(Point(FOffsetX, Value), DefaultScrollUpdateFlags); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetOptions(const Value: TCustomVirtualTreeOptions); - -begin - FOptions.Assign(Value); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetRangeX(value: Cardinal); -begin - FRangeX := value; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetRootNodeCount(Value: Cardinal); - -begin - // Don't set the root node count until all other properties (in particular the OnInitNode event) have been set. - if csLoading in ComponentState then - begin - FRoot.ChildCount := Value; - DoStateChange([tsNeedRootCountUpdate]); - end - else - if FRoot.ChildCount <> Value then - begin - BeginUpdate; - InterruptValidation; - SetChildCount(FRoot, Value); - EndUpdate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetScrollBarOptions(Value: TScrollBarOptions); - -begin - FScrollBarOptions.Assign(Value); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetSearchOption(const Value: TVTIncrementalSearch); - -begin - if FIncrementalSearch <> Value then - begin - FIncrementalSearch := Value; - if FIncrementalSearch = isNone then - begin - StopTimer(SearchTimer); - FSearchBuffer := ''; - FLastSearchNode := nil; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetSelected(Node: PVirtualNode; Value: Boolean); - -begin - if not FSelectionLocked and Assigned(Node) and (Node <> FRoot) and (Value xor (vsSelected in Node.States)) then - begin - if Value then - begin - if FSelectionCount = 0 then - FRangeAnchor := Node - else begin - if not (toMultiSelect in FOptions.FSelectionOptions) then - ClearSelection; - if FRangeAnchor = nil then - FRangeAnchor := Node; - end; - - AddToSelection(Node, True); - - if not (toMultiSelect in FOptions.FSelectionOptions) then - FocusedNode := GetFirstSelected; // if only one node can be selected, make sure the focused node changes with the selected node - // Make sure there is a valid column selected (if there are columns at all). - if ((FFocusedColumn < 0) or not (coVisible in FHeader.Columns[FFocusedColumn].Options)) and - (FHeader.MainColumn > NoColumn) then - if ([coVisible, coAllowFocus] * FHeader.Columns[FHeader.MainColumn].Options = [coVisible, coAllowFocus]) then - FFocusedColumn := FHeader.MainColumn - else - FFocusedColumn := FHeader.Columns.GetFirstVisibleColumn(True); - end - else - begin - RemoveFromSelection(Node); - if FSelectionCount = 0 then - ResetRangeAnchor; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetSelectionCurveRadius(const Value: Cardinal); - -begin - if FSelectionCurveRadius <> Value then - begin - FSelectionCurveRadius := Value; - if HandleAllocated and not (csLoading in ComponentState) then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetStateImages(const Value: TCustomImageList); - -begin - if FStateImages <> Value then - begin - if Assigned(FStateImages) then - begin - FStateImages.UnRegisterChanges(FStateChangeLink); - FStateImages.RemoveFreeNotification(Self); - end; - FStateImages := Value; - if Assigned(FStateImages) then - begin - FStateImages.RegisterChanges(FStateChangeLink); - FStateImages.FreeNotification(Self); - end; - if HandleAllocated and not (csLoading in ComponentState) then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetTextMargin(Value: Integer); - -begin - if FTextMargin <> Value then - begin - FTextMargin := Value; - if not (csLoading in ComponentState) then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetTopNode(Node: PVirtualNode); - -var - R: TRect; - Run: PVirtualNode; - -begin - if Assigned(Node) then - begin - // make sure all parents of the node are expanded - Run := Node.Parent; - while Run <> FRoot do - begin - if not (vsExpanded in Run.States) then - ToggleNode(Run); - Run := Run.Parent; - end; - R := GetDisplayRect(Node, FHeader.MainColumn, True); - SetOffsetY(FOffsetY - R.Top); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetUpdateState(Updating: Boolean); - -begin - // The check for visibility is necessary otherwise the tree is automatically shown when - // updating is allowed. As this happens internally the VCL does not get notified and - // still assumes the control is hidden. This results in weird "cannot focus invisible control" errors. - if Visible and HandleAllocated and (FUpdateCount = 0) then - SendMessage(Handle, WM_SETREDRAW, Ord(not Updating), 0); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetVerticalAlignment(Node: PVirtualNode; Value: Byte); - -begin - if Value > 100 then - Value := 100; - if Node.Align <> Value then - begin - Node.Align := Value; - if FullyVisible[Node] and not IsEffectivelyFiltered[Node] then - InvalidateNode(Node); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetVisible(Node: PVirtualNode; Value: Boolean); - -// Sets the visibility style of the given node according to Value. - -var - NeedUpdate: Boolean; - -begin - Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); - - if Value <> (vsVisible in Node.States) then - begin - InterruptValidation; - NeedUpdate := False; - if Value then - begin - Include(Node.States, vsVisible); - if vsExpanded in Node.Parent.States then - AdjustTotalHeight(Node.Parent, Node.TotalHeight, True); - if VisiblePath[Node] then - begin - Inc(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); - NeedUpdate := True; - end; - - // Update the hidden children flag of the parent. - // Since this node is now visible we simply have to remove the flag. - if not IsEffectivelyFiltered[Node] then - Exclude(Node.Parent.States, vsAllChildrenHidden); - end - else - begin - if vsExpanded in Node.Parent.States then - AdjustTotalHeight(Node.Parent, -Integer(Node.TotalHeight), True); - if VisiblePath[Node] then - begin - Dec(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); - NeedUpdate := True; - end; - Exclude(Node.States, vsVisible); - - if FUpdateCount = 0 then - DetermineHiddenChildrenFlag(Node.Parent) - else - Include(FStates, tsUpdateHiddenChildrenNeeded); - end; - - InvalidateCache; - if NeedUpdate and (FUpdateCount = 0) then - begin - ValidateCache; - UpdateScrollBars(True); - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetVisiblePath(Node: PVirtualNode; Value: Boolean); - -// If Value is True then all parent nodes of Node are expanded. - -begin - Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); - - if Value then - begin - repeat - Node := Node.Parent; - if Node = FRoot then - Break; - if not (vsExpanded in Node.States) then - ToggleNode(Node); - until False; - end; -end; - -// ---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.PrepareBackGroundPicture(Source: TPicture; - DrawBitmap: TBitmap; DrawBitmapWidth: Integer; DrawBitMapHeight: Integer; ABkgcolor: TColor); -const - DST = $00AA0029; // Ternary Raster Operation - Destination unchanged - - // fill background will work for transparent images and - // will not disturb non-transparent ones - procedure FillDrawBitmapWithBackGroundColor; - begin - DrawBitmap.Canvas.Brush.Color := ABkgcolor; - DrawBitmap.Canvas.FillRect(Rect(0, 0, DrawBitmap.Width, DrawBitmap.Height)); - end; - -begin - DrawBitmap.SetSize(DrawBitmapWidth, DrawBitMapHeight); - - if (Source.Graphic is TBitmap) and - (FBackGroundImageTransparent or Source.Bitmap.TRANSPARENT) - then - begin - FillDrawBitmapWithBackGroundColor; - MaskBlt(DrawBitmap.Canvas.Handle, 0, 0, Source.Width, Source.Height, - Source.Bitmap.Canvas.Handle, 0, 0, Source.Bitmap.MaskHandle, 0, 0, - MakeROP4(DST, SRCCOPY)); - end - else - begin - // Similar to TImage's Transparent property behavior, we don't want - // to draw transparent if the following flag is OFF. - if FBackGroundImageTransparent then - FillDrawBitmapWithBackGroundColor; - DrawBitmap.Canvas.Draw(0, 0, Source.Graphic); - end -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.StaticBackground(Source: TPicture; Target: TCanvas; OffsetPosition: TPoint; R: TRect; aBkgColor: TColor); - -// Draws the given source graphic so that it stays static in the given rectangle which is relative to the target bitmap. -// The graphic is aligned so that it always starts at the upper left corner of the target canvas. -// Offset gives the position of the target window as a possible superordinated surface. - -const - DST = $00AA0029; // Ternary Raster Operation - Destination unchanged - -var - PicRect: TRect; - AreaRect: TRect; - DrawRect: TRect; - DrawBitmap: TBitmap; -begin - DrawBitmap := TBitmap.Create; - try - // clear background - Target.Brush.Color := aBkgColor; - Target.FillRect(R); - - // Picture rect in relation to client viewscreen. - PicRect := Rect(FBackgroundOffsetX, FBackgroundOffsetY, FBackgroundOffsetX + Source.Width, FBackgroundOffsetY + Source.Height); - - // Area to be draw in relation to client viewscreen. - AreaRect := Rect(OffsetPosition.X + R.Left, OffsetPosition.Y + R.Top, OffsetPosition.X + R.Right, OffsetPosition.Y + R.Bottom); - - // If picture falls in AreaRect, return intersection (DrawRect). - if IntersectRect(DrawRect, PicRect, AreaRect) then - begin - PrepareBackGroundPicture(Source, DrawBitmap, Source.Width, Source.Height, aBkgColor); - // copy image to destination - BitBlt(Target.Handle, DrawRect.Left - OffsetPosition.X, DrawRect.Top - OffsetPosition.Y, (DrawRect.Right - OffsetPosition.X) - (DrawRect.Left - OffsetPosition.X), - (DrawRect.Bottom - OffsetPosition.Y) - (DrawRect.Top - OffsetPosition.Y) + R.Top, DrawBitmap.Canvas.Handle, DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top, - SRCCOPY); - end; - finally - DrawBitmap.Free; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.StopTimer(ID: Integer); - -begin - if HandleAllocated then - KillTimer(Handle, ID); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetWindowTheme(const Theme: string); - -begin - FChangingTheme := True; - Winapi.UxTheme.SetWindowTheme(Handle, PWideChar(Theme), nil); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.TileBackground(Source: TPicture; Target: TCanvas; Offset: TPoint; R: TRect; aBkgColor: TColor); - -// Draws the given source graphic so that it tiles into the given rectangle which is relative to the target bitmap. -// The graphic is aligned so that it always starts at the upper left corner of the target canvas. -// Offset gives the position of the target window in an possible superordinated surface. - -var - SourceX, - SourceY, - TargetX, - DeltaY: Integer; - DrawBitmap: TBitmap; -begin - DrawBitmap := TBitmap.Create; - try - PrepareBackGroundPicture(Source, DrawBitmap, Source.Width, Source.Height, aBkgColor); - with Target do - begin - SourceY := (R.Top + Offset.Y + FBackgroundOffsetY) mod Source.Height; - // Always wrap the source coordinates into positive range. - if SourceY < 0 then - SourceY := Source.Height + SourceY; - - // Tile image vertically until target rect is filled. - while R.Top < R.Bottom do - begin - SourceX := (R.Left + Offset.X + FBackgroundOffsetX) mod Source.Width; - // always wrap the source coordinates into positive range - if SourceX < 0 then - SourceX := Source.Width + SourceX; - - TargetX := R.Left; - // height of strip to draw - DeltaY := Min(R.Bottom - R.Top, Source.Height - SourceY); - - // tile the image horizontally - while TargetX < R.Right do - begin - BitBlt(Handle, TargetX, R.Top, Min(R.Right - TargetX, Source.Width - SourceX), DeltaY, - DrawBitmap.Canvas.Handle, SourceX, SourceY, SRCCOPY); - Inc(TargetX, Source.Width - SourceX); - SourceX := 0; - end; - Inc(R.Top, Source.Height - SourceY); - SourceY := 0; - end; - end; - finally - DrawBitmap.Free; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ToggleCallback(Step, StepSize: Integer; Data: Pointer): Boolean; - -var - Column: TColumnIndex; - Run: TRect; - SecondaryStepSize: Integer; - - //--------------- local functions ------------------------------------------- - - procedure EraseLine; - - var - LocalBrush: HBRUSH; - - begin - with TToggleAnimationData(Data^), FHeader.FColumns do - begin - // Iterate through all columns and erase background in their local color. - // LocalBrush is a brush in the color of the particular column. - Column := GetFirstVisibleColumn; - while (Column > InvalidColumn) and (Run.Left < ClientWidth) do - begin - GetColumnBounds(Column, Run.Left, Run.Right); - if coParentColor in Items[Column].FOptions then - FillRect(DC, Run, Brush) - else - begin - if VclStyleEnabled then - LocalBrush := CreateSolidBrush(ColorToRGB(FColors.BackGroundColor)) - else - LocalBrush := CreateSolidBrush(ColorToRGB(Items[Column].Color)); - FillRect(DC, Run, LocalBrush); - DeleteObject(LocalBrush); - end; - Column := GetNextVisibleColumn(Column); - end; - end; - end; - - //--------------------------------------------------------------------------- - - procedure DoScrollUp(DC: HDC; Brush: HBRUSH; Area: TRect; Steps: Integer); - - begin - ScrollDC(DC, 0, -Steps, Area, Area, 0, nil); - - if Step = 0 then - if not FHeader.UseColumns then - FillRect(DC, Rect(Area.Left, Area.Bottom - Steps - 1, Area.Right, Area.Bottom), Brush) - else - begin - Run := Rect(Area.Left, Area.Bottom - Steps - 1, Area.Right, Area.Bottom); - EraseLine; - end; - end; - - //--------------------------------------------------------------------------- - - procedure DoScrollDown(DC: HDC; Brush: HBRUSH; Area: TRect; Steps: Integer); - - begin - ScrollDC(DC, 0, Steps, Area, Area, 0, nil); - - if Step = 0 then - if not FHeader.UseColumns then - FillRect(DC, Rect(Area.Left, Area.Top, Area.Right, Area.Top + Steps + 1), Brush) - else - begin - Run := Rect(Area.Left, Area.Top, Area.Right, Area.Top + Steps + 1); - EraseLine; - end; - end; - - //--------------- end local functions --------------------------------------- - -begin - Result := True; - if StepSize > 0 then - begin - SecondaryStepSize := 0; - with TToggleAnimationData(Data^) do - begin - if Mode1 <> tamNoScroll then - begin - if Mode1 = tamScrollUp then - DoScrollUp(DC, Brush, R1, StepSize) - else - DoScrollDown(DC, Brush, R1, StepSize); - - if (Mode2 <> tamNoScroll) and (ScaleFactor > 0) then - begin - // As this routine is able to scroll two independent areas at once, the missing StepSize is - // computed in that case. To ensure the maximal accuracy the rounding error is accumulated. - SecondaryStepSize := Round((StepSize + MissedSteps) * ScaleFactor); - MissedSteps := MissedSteps + StepSize * ScaleFactor - SecondaryStepSize; - end; - end - else - SecondaryStepSize := StepSize; - - if Mode2 <> tamNoScroll then - if Mode2 = tamScrollUp then - DoScrollUp(DC, Brush, R2, SecondaryStepSize) - else - DoScrollDown(DC, Brush, R2, SecondaryStepSize); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMColorChange(var Message: TMessage); - -begin - if not (csLoading in ComponentState) then - begin - PrepareBitmaps(True, False); - if HandleAllocated then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMCtl3DChanged(var Message: TMessage); - -begin - inherited; - if FBorderStyle = bsSingle then - RecreateWnd; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMBiDiModeChanged(var Message: TMessage); - -begin - inherited; - - if UseRightToLeftAlignment then - FEffectiveOffsetX := Integer(FRangeX) - ClientWidth + FOffsetX - else - FEffectiveOffsetX := -FOffsetX; - if FEffectiveOffsetX < 0 then - FEffectiveOffsetX := 0; - - if toAutoBidiColumnOrdering in FOptions.FAutoOptions then - FHeader.FColumns.ReorderColumns(UseRightToLeftAlignment); - FHeader.Invalidate(nil); -end; - -procedure TBaseVirtualTree.CMBorderChanged(var Message: TMessage); -begin - inherited; - if VclStyleEnabled and (seBorder in StyleElements) then - RecreateWnd; -end; - -procedure TBaseVirtualTree.CMParentDoubleBufferedChange(var Message: TMessage); -begin - // empty by intention, we do our own buffering -end; - -procedure TBaseVirtualTree.CMStyleChanged(var Message: TMessage); -begin - VclStyleChanged; - RecreateWnd; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMDenySubclassing(var Message: TMessage); - -// If a Windows XP Theme Manager component is used in the application it will try to subclass all controls which do not -// explicitly deny this. Virtual Treeview knows how to handle XP themes so it does not need subclassing. - -begin - Message.Result := 1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMDrag(var Message: TCMDrag); - -var - S: TObject; - ShiftState: Integer; - P: TPoint; - Formats: TFormatArray; - Effect: Integer; - -begin - with Message, DragRec^ do - begin - S := Source; - Formats := nil; - - // Let the ancestor handle dock operations. - if S is TDragDockObject then - inherited - else - begin - // We need an extra check for the control drag object as there might be other objects not derived from - // this class (e.g. TActionDragObject). - if not (tsUserDragObject in FStates) and (S is TBaseDragControlObject) then - S := (S as TBaseDragControlObject).Control; - case DragMessage of - dmDragEnter, dmDragLeave, dmDragMove: - begin - if DragMessage = dmDragEnter then - DoStateChange([tsVCLDragging]); - if DragMessage = dmDragLeave then - DoStateChange([tsVCLDragFinished], [tsVCLDragging]); - - if DragMessage = dmDragMove then - with ScreenToClient(Pos) do - DoAutoScroll(X, Y); - - ShiftState := 0; - // Alt key will be queried by the KeysToShiftState function in DragOver. - if GetKeyState(VK_SHIFT) < 0 then - ShiftState := ShiftState or MK_SHIFT; - if GetKeyState(VK_CONTROL) < 0 then - ShiftState := ShiftState or MK_CONTROL; - - // Allowed drop effects are simulated for VCL dd. - Effect := DROPEFFECT_MOVE or DROPEFFECT_COPY; - DragOver(S, ShiftState, TDragState(DragMessage), Pos, Effect); - FLastVCLDragTarget := FDropTargetNode; - FVCLDragEffect := Effect; - if (DragMessage = dmDragLeave) and Assigned(FDropTargetNode) then - begin - InvalidateNode(FDropTargetNode); - FDropTargetNode := nil; - end; - Result := LRESULT(Effect); - end; - dmDragDrop: - begin - ShiftState := 0; - // Alt key will be queried by the KeysToShiftState function in DragOver - if GetKeyState(VK_SHIFT) < 0 then - ShiftState := ShiftState or MK_SHIFT; - if GetKeyState(VK_CONTROL) < 0 then - ShiftState := ShiftState or MK_CONTROL; - - // allowed drop effects are simulated for VCL dd, - // replace target node with cached node from other VCL dd messages - if Assigned(FDropTargetNode) then - InvalidateNode(FDropTargetNode); - FDropTargetNode := FLastVCLDragTarget; - P := Point(Pos.X, Pos.Y); - P := ScreenToClient(P); - try - DoDragDrop(S, nil, Formats, KeysToShiftState(ShiftState), P, FVCLDragEffect, FLastDropMode); - finally - if Assigned(FDropTargetNode) then - begin - InvalidateNode(FDropTargetNode); - FDropTargetNode := nil; - end; - end; - end; - dmFindTarget: - begin - Result := LRESULT(ControlAtPos(ScreenToClient(Pos), False)); - if Result = 0 then - Result := LRESULT(Self); - - // This is a reliable place to check whether VCL drag has - // really begun. - if tsVCLDragPending in FStates then - DoStateChange([tsVCLDragging], [tsVCLDragPending, tsEditPending, tsClearPending]); - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMEnabledChanged(var Message: TMessage); - -begin - inherited; - - // Need to invalidate the non-client area as well, since the header must be redrawn too. - if csDesigning in ComponentState then - RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_NOERASE or RDW_NOCHILDREN); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMFontChanged(var Message: TMessage); - -var - HeaderMessage: TMessage; - -begin - inherited; - - if not (csLoading in ComponentState) then - begin - PrepareBitmaps(True, False); - if HandleAllocated then begin - AutoScale(False); - Invalidate; - end - end; - - HeaderMessage.Msg := CM_PARENTFONTCHANGED; - HeaderMessage.WParam := 0; - HeaderMessage.LParam := 0; - HeaderMessage.Result := 0; - FHeader.HandleMessage(HeaderMessage); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMHintShow(var Message: TCMHintShow); - -// Determines hint message (tooltip) and out-of-hint rect. -// Note: A special handling is needed here because we cannot pass wide strings back to the caller. -// I had to introduce the hint data record anyway so we can use this to pass the hint string. -// We still need to set a dummy hint string in the message to make the VCL showing the hint window. - -var - NodeRect: TRect; - SpanColumn, - Dummy, - ColLeft, - ColRight: Integer; - HitInfo: THitInfo; - ShowOwnHint: Boolean; - IsFocusedOrEditing: Boolean; - ParentForm: TCustomForm; - BottomRightCellContentMargin: TPoint; - DummyLineBreakStyle: TVTTooltipLineBreakStyle; - HintKind: TVTHintKind; -begin - with Message do - begin - Result := 1; - - if PtInRect(FLastHintRect, HintInfo.CursorPos) then - Exit; - - // Determine node for which to show hint/tooltip. - with HintInfo^ do - GetHitTestInfoAt(CursorPos.X, CursorPos.Y, True, HitInfo); - - // Make sure a hint is only shown if the tree or at least its parent form is active. - // Active editing is ok too as long as we don't want the hint for the current edit node. - if IsEditing then - IsFocusedOrEditing := HitInfo.HitNode <> FFocusedNode - else - begin - IsFocusedOrEditing := Focused; - ParentForm := GetParentForm(Self); - if Assigned(ParentForm) then - IsFocusedOrEditing := ParentForm.Focused or Application.Active; - end; - - if (GetCapture = 0) and ShowHint and not (Dragging or IsMouseSelecting) and ([tsScrolling] * FStates = []) and - (FHeader.States = []) and IsFocusedOrEditing then - begin - with HintInfo^ do - begin - Result := 0; - ShowOwnHint := False; - - //workaround for issue #291 - //it duplicates parts of the following code and code in TVirtualTreeHintWindow - HintStr := ''; - if FHeader.UseColumns and (hoShowHint in FHeader.FOptions) and FHeader.InHeader(CursorPos) then - begin - CursorRect := FHeaderRect; - // Convert the cursor rectangle into real client coordinates. - OffsetRect(CursorRect, 0, -Integer(FHeader.FHeight)); - HitInfo.HitColumn := FHeader.FColumns.GetColumnAndBounds(CursorPos, CursorRect.Left, CursorRect.Right); - if (HitInfo.HitColumn > NoColumn) and not (csLButtonDown in ControlState) and - (FHeader.FColumns[HitInfo.HitColumn].FHint <> '') then - HintStr := FHeader.FColumns[HitInfo.HitColumn].FHint; - end - else - if HintMode = hmDefault then - HintStr := GetShortHint(Hint) - else - if Assigned(HitInfo.HitNode) and (HitInfo.HitColumn > InvalidColumn) then - begin - if HintMode = hmToolTip then - HintStr := DoGetNodeToolTip(HitInfo.HitNode, HitInfo.HitColumn, DummyLineBreakStyle) - else - HintStr := DoGetNodeHint(HitInfo.HitNode, HitInfo.HitColumn, DummyLineBreakStyle); - end; - - // First check whether there is a header hint to show. - if FHeader.UseColumns and (hoShowHint in FHeader.FOptions) and FHeader.InHeader(CursorPos) then - begin - CursorRect := FHeaderRect; - // Convert the cursor rectangle into real client coordinates. - OffsetRect(CursorRect, 0, -Integer(FHeader.FHeight)); - HitInfo.HitColumn := FHeader.FColumns.GetColumnAndBounds(CursorPos, CursorRect.Left, CursorRect.Right); - // align the vertical hint position on the bottom bound of the header, but - // avoid overlapping of mouse cursor and hint - HintPos.Y := Max(HintPos.Y, ClientToScreen(Point(0, CursorRect.Bottom)).Y); - // Note: the test for the left mouse button in ControlState might cause problems whenever the VCL does not - // realize when the button is released. This, for instance, happens when doing OLE drag'n drop and - // cancel this with ESC. - if (HitInfo.HitColumn > NoColumn) and not (csLButtonDown in ControlState) then - begin - HintStr := FHeader.FColumns[HitInfo.HitColumn].FHint; - if HintStr <> '' then - ShowOwnHint := True - else - Result := 1; - end - else - Result := 1; - end - else - begin - // Default mode is handled as would the tree be a usual VCL control (no own hint window necessary). - if FHintMode = hmDefault then - HintStr := GetShortHint(Hint) - else - begin - if Assigned(HitInfo.HitNode) and (HitInfo.HitColumn > InvalidColumn) then - begin - // An owner-draw tree should only display a hint when at least - // its OnGetHintSize event handler is assigned. - DoGetHintKind(HitInfo.HitNode, HitInfo.HitColumn, HintKind); - FHintData.HintRect := Rect(0, 0, 0, 0); - if (HintKind = vhkOwnerDraw) then - begin - DoGetHintSize(HitInfo.HitNode, HitInfo.HitColumn, FHintData.HintRect); - ShowOwnHint := not IsRectEmpty(FHintData.HintRect); - end - else - // For trees displaying text hints, a decision about showing the hint or not is based - // on the hint string (if it is empty then no hint is shown). - ShowOwnHint := True; - - if ShowOwnHint then - begin - if HitInfo.HitColumn > NoColumn then - begin - FHeader.FColumns.GetColumnBounds(HitInfo.HitColumn, ColLeft, ColRight); - // The right column border might be extended if column spanning is enabled. - if toAutoSpanColumns in FOptions.FAutoOptions then - begin - SpanColumn := HitInfo.HitColumn; - repeat - Dummy := FHeader.FColumns.GetNextVisibleColumn(SpanColumn); - if (Dummy = InvalidColumn) or not ColumnIsEmpty(HitInfo.HitNode, Dummy) then - Break; - SpanColumn := Dummy; - until False; - if SpanColumn <> HitInfo.HitColumn then - FHeader.FColumns.GetColumnBounds(SpanColumn, Dummy, ColRight); - end; - end - else - begin - ColLeft := 0; - ColRight := ClientWidth; - end; - - if FHintMode <> hmTooltip then - begin - // Node specific hint text. - CursorRect := GetDisplayRect(HitInfo.HitNode, HitInfo.HitColumn, False); - CursorRect.Left := ColLeft; - CursorRect.Right := ColRight; - // Align the vertical hint position on the bottom bound of the node, but - // avoid overlapping of mouse cursor and hint. - HintPos.Y := Max(HintPos.Y, ClientToScreen(CursorRect.BottomRight).Y) + ScaledPixels(2); - end - else - begin - // Tool tip to show. This means the full caption of the node must be displayed. - if vsMultiline in HitInfo.HitNode.States then - begin - if hiOnItemLabel in HitInfo.HitPositions then - begin - ShowOwnHint := True; - NodeRect := GetDisplayRect(HitInfo.HitNode, HitInfo.HitColumn, True, False); - end - else - ShowOwnHint := False; - end - else - begin - NodeRect := GetDisplayRect(HitInfo.HitNode, HitInfo.HitColumn, True, True, True); - BottomRightCellContentMargin := DoGetCellContentMargin(HitInfo.HitNode, HitInfo.HitColumn, ccmtBottomRightOnly); - - ShowOwnHint := (HitInfo.HitColumn > InvalidColumn) and PtInRect(NodeRect, CursorPos) and - (CursorPos.X <= ColRight) and (CursorPos.X >= ColLeft) and - ( - // Show hint also if the node text is partially out of the client area. - // "ColRight - 1", since the right column border is not part of this cell. - ( (NodeRect.Right + BottomRightCellContentMargin.X) > Min(ColRight - 1, ClientWidth) ) or - (NodeRect.Left < Max(ColLeft, 0)) or - ( (NodeRect.Bottom + BottomRightCellContentMargin.Y) > ClientHeight ) or - (NodeRect.Top < 0) - ); - end; - - if ShowOwnHint then - begin - // Node specific hint text given will be retrieved when needed. - HintPos := ClientToScreen(Point(NodeRect.Left, NodeRect.Top)); - CursorRect := NodeRect; - end - else - // nothing to show - Result := 1; - end; - end - else - Result := 1; // Avoid hint if this is a draw tree returning an empty hint rectangle. - end - else - begin - // No node so fall back to control's hint (if indicated) or show nothing. - if FHintMode = hmHintAndDefault then - begin - HintStr := GetShortHint(Hint); - - // Fix for the problem: Default Hint once shown stayed even when - // node hint was to be displayed. The reason was that CursorRect - // was for the full client area. Now reducing it to remove the - // columns from it. - if BidiMode = bdLeftToRight then - CursorRect.Left := Header.Columns.TotalWidth - else - CursorRect.right := CursorRect.right - Header.Columns.TotalWidth; - - if Length(HintStr) = 0 then - Result := 1 - else - ShowOwnHint := True; - end - else - Result := 1; - end; - end; - end; - - // Set our own hint window class and prepare structure to be passed to the hint window. - if ShowOwnHint and (Result = 0) then - begin - HintWindowClass := GetHintWindowClass; - FHintData.HintText := HintStr; - FHintData.Tree := Self; - FHintData.Column := HitInfo.HitColumn; - FHintData.Node := HitInfo.HitNode; - FLastHintRect := CursorRect; - HintData := @FHintData; - end - else - FLastHintRect := Rect(0, 0, 0, 0); - end; - - // Remind that a hint is about to show. - if Result = 0 then - DoStateChange([tsHint]) - else - DoStateChange([], [tsHint]); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMHintShowPause(var Message: TCMHintShowPause); - -// Tells the application that the tree (and only the tree) does not want a delayed tool tip. -// Normal hints / header hints use the default delay (except for the first time). - - begin - if ShowHint and (FHintMode = hmToolTip) then - Message.Pause^ := 0; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMMouseEnter(var Message: TMessage); -begin - DoMouseEnter(); - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMMouseLeave(var Message: TMessage); - -var - LeaveStates: TVirtualTreeStates; - -begin - // Reset the last used hint rectangle in case the mouse enters the window within the bounds - if Assigned(FHintData.Tree) then - FHintData.Tree.FLastHintRect := Rect(0, 0, 0, 0); - - LeaveStates := [tsHint]; - if [tsWheelPanning, tsWheelScrolling] * FStates = [] then - begin - StopTimer(ScrollTimer); - LeaveStates := LeaveStates + [tsScrollPending, tsScrolling]; - end; - DoStateChange([], LeaveStates); - if Assigned(FCurrentHotNode) then - begin - DoHotChange(FCurrentHotNode, nil); - if (toHotTrack in FOptions.PaintOptions) or (toCheckSupport in FOptions.FMiscOptions) then - InvalidateNode(FCurrentHotNode); - FCurrentHotNode := nil; - end; - - if Assigned(Header) then - begin - Header.FColumns.FDownIndex := NoColumn; - Header.FColumns.FHoverIndex := NoColumn; - Header.FColumns.FCheckBoxHit := False; - end; - DoMouseLeave(); - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CMMouseWheel(var Message: TCMMouseWheel); - -var - ScrollAmount: Integer; - ScrollLines: DWORD; - RTLFactor: Integer; - WheelFactor: Double; - -begin - StopWheelPanning; - - inherited; - - if Message.Result = 0 then - begin - with Message do - begin - Result := 1; - WheelFactor := WheelDelta / WHEEL_DELTA; - if (FRangeY > Cardinal(ClientHeight)) and (not (ssShift in ShiftState)) then - begin - // Scroll vertically if there's something to scroll... - if ssCtrl in ShiftState then - ScrollAmount := Trunc(WheelFactor * ClientHeight) - else - begin - SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @ScrollLines, 0); - if ScrollLines = WHEEL_PAGESCROLL then - ScrollAmount := Trunc(WheelFactor * ClientHeight) - else - ScrollAmount := Integer(Trunc(WheelFactor * ScrollLines * FDefaultNodeHeight)); - end; - SetOffsetY(FOffsetY + ScrollAmount); - end - else - begin - // ...else scroll horizontally if there's something to scroll. - if UseRightToLeftAlignment then - RTLFactor := -1 - else - RTLFactor := 1; - - if ssCtrl in ShiftState then - ScrollAmount := Trunc(WheelFactor * (ClientWidth - FHeader.Columns.GetVisibleFixedWidth)) - else - begin - SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @ScrollLines, 0); - ScrollAmount := Trunc(WheelFactor * ScrollLines * FHeader.Columns.GetScrollWidth); - end; - SetOffsetX(FOffsetX + RTLFactor * ScrollAmount); - end; - end; - - end; - -end; - -//---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.CMSysColorChange(var Message: TMessage); - -begin - inherited; - Message.Msg := WM_SYSCOLORCHANGE; - DefaultHandler(Message); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.TVMGetItem(var Message: TMessage); - -// Screen reader support function. The method returns information about a particular node. - -const - StateMask = TVIS_STATEIMAGEMASK or TVIS_OVERLAYMASK or TVIS_EXPANDED or TVIS_DROPHILITED or TVIS_CUT or - TVIS_SELECTED or TVIS_FOCUSED; - -var - Item: PTVItemEx; - Node: PVirtualNode; - Ghosted: Boolean; - ImageIndex: TImageIndex; - R: TRect; - Text: string; -begin - // We can only return valid data if a nodes reference is given. - Item := Pointer(Message.LParam); - Message.Result := Ord(((Item.mask and TVIF_HANDLE) <> 0) and Assigned(Item.hItem)); - if Message.Result = 1 then - begin - Node := Pointer(Item.hItem); - // Child count requested? - if (Item.mask and TVIF_CHILDREN) <> 0 then - Item.cChildren := Node.ChildCount; - // Index for normal image requested? - if (Item.mask and TVIF_IMAGE) <> 0 then - begin - ImageIndex := -1; - DoGetImageIndex(Node, ikNormal, -1, Ghosted, ImageIndex); - Item.iImage := ImageIndex; - end; - // Index for selected image requested? - if (Item.mask and TVIF_SELECTEDIMAGE) <> 0 then - begin - ImageIndex := -1; - DoGetImageIndex(Node, ikSelected, -1, Ghosted, ImageIndex); - Item.iSelectedImage := ImageIndex; - end; - // State info requested? - if (Item.mask and TVIF_STATE) <> 0 then - begin - // Everything, which is possible is returned. - Item.stateMask := StateMask; - Item.state := 0; - if Node = FFocusedNode then - Item.state := Item.state or TVIS_FOCUSED; - if vsSelected in Node.States then - Item.state := Item.state or TVIS_SELECTED; - if vsCutOrCopy in Node.States then - Item.state := Item.state or TVIS_CUT; - if Node = FDropTargetNode then - Item.state := Item.state or TVIS_DROPHILITED; - if vsExpanded in Node.States then - Item.state := Item.state or TVIS_EXPANDED; - - // Construct state image and overlay image indices. They are one based, btw. - // and zero means there is no image. - ImageIndex := -1; - DoGetImageIndex(Node, ikState, -1, Ghosted, ImageIndex); - Item.state := Item.state or Byte(IndexToStateImageMask(ImageIndex + 1)); - ImageIndex := -1; - DoGetImageIndex(Node, ikOverlay, -1, Ghosted, ImageIndex); - Item.state := Item.state or Byte(IndexToOverlayMask(ImageIndex + 1)); - end; - // Node caption requested? - if (Item.mask and TVIF_TEXT) <> 0 then - begin - GetTextInfo(Node, -1, Font, R, Text); - - StrLCopy(Item.pszText, PWideChar(Text), Item.cchTextMax - 1); - Item.pszText[Length(Text)] := #0; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.TVMGetItemRect(var Message: TMessage); - -// Screen read support function. This method returns a node's display rectangle. - -var - TextOnly: Boolean; - Node: PVirtualNode; - -begin - // The lparam member is used two-way. On enter it contains a pointer to the item (node). - // On exit it is to be considered as pointer to a rectangle structure. - Node := Pointer(Pointer(Message.LParam)^); - Message.Result := Ord(IsVisible[Node]); - if Message.Result <> 0 then - begin - TextOnly := Message.WParam <> 0; - PRect(Message.LParam)^ := GetDisplayRect(Node, NoColumn, TextOnly); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.TVMGetNextItem(var Message: TMessage); - -// Screen read support function. This method returns a node depending on the requested case. - -var - Node: PVirtualNode; - -begin - // Start with a nil result. - Message.Result := 0; - Node := Pointer(Message.LParam); - case Message.WParam of - TVGN_CARET: - Message.Result := LRESULT(FFocusedNode); - TVGN_CHILD: - if Assigned(Node) then - Message.Result := LRESULT(GetFirstChild(Node)); - TVGN_DROPHILITE: - Message.Result := LRESULT(FDropTargetNode); - TVGN_FIRSTVISIBLE: - Message.Result := LRESULT(GetFirstVisible(nil, True)); - TVGN_LASTVISIBLE: - Message.Result := LRESULT(GetLastVisible(nil, True)); - TVGN_NEXT: - if Assigned(Node) then - Message.Result := LRESULT(GetNextSibling(Node)); - TVGN_NEXTVISIBLE: - if Assigned(Node) then - Message.Result := LRESULT(GetNextVisible(Node, True)); - TVGN_PARENT: - if Assigned(Node) and (Node <> FRoot) and (Node.Parent <> FRoot) then - Message.Result := LRESULT(Node.Parent); - TVGN_PREVIOUS: - if Assigned(Node) then - Message.Result := LRESULT(GetPreviousSibling(Node)); - TVGN_PREVIOUSVISIBLE: - if Assigned(Node) then - Message.Result := LRESULT(GetPreviousVisible(Node, True)); - TVGN_ROOT: - Message.Result := LRESULT(GetFirst); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMCancelMode(var Message: TWMCancelMode); - -begin - // Clear any transient state. - StopTimer(ExpandTimer); - StopTimer(EditTimer); - StopTimer(HeaderTimer); - StopTimer(ScrollTimer); - StopTimer(SearchTimer); - StopTimer(ThemeChangedTimer); - FSearchBuffer := ''; - FLastSearchNode := nil; - - DoStateChange([], [tsClearPending, tsEditPending, tsOLEDragPending, tsVCLDragPending, tsDrawSelecting, - tsDrawSelPending, tsIncrementalSearching]); - - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMChar(var Message: TWMChar); - -begin - if tsIncrementalSearchPending in FStates then - begin - HandleIncrementalSearch(Message.CharCode); - DoStateChange([], [tsIncrementalSearchPending]); - end; - - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -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. - -begin - DoStateChange([], [tsClearPending, tsEditPending, tsOLEDragPending, tsVCLDragPending]); - - if not (tsPopupMenuShown in FStates) then - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMCopy(var Message: TWMCopy); - -begin - CopyToClipboard; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMCut(var Message: TWMCut); - -begin - CutToClipboard; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMEnable(var Message: TWMEnable); - -begin - inherited; - RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_NOERASE or RDW_NOCHILDREN); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMEraseBkgnd(var Message: TWMEraseBkgnd); - -begin - Message.Result := 1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMGetDlgCode(var Message: TWMGetDlgCode); - -begin - Message.Result := DLGC_WANTCHARS or DLGC_WANTARROWS; - if FWantTabs then - Message.Result := Message.Result or DLGC_WANTTAB; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMGetObject(var Message: TMessage); - -begin - if TVTAccessibilityFactory.GetAccessibilityFactory <> nil then - begin - // Create the IAccessibles for the tree view and tree view items, if necessary. - if FAccessible = nil then - FAccessible := TVTAccessibilityFactory.GetAccessibilityFactory.CreateIAccessible(Self); - if FAccessibleItem = nil then - FAccessibleItem := TVTAccessibilityFactory.GetAccessibilityFactory.CreateIAccessible(Self); - if Cardinal(Message.LParam) = OBJID_CLIENT then - if Assigned(Accessible) then - Message.Result := LresultFromObject(IID_IAccessible, Message.WParam, FAccessible) - else - Message.Result := 0; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMHScroll(var Message: TWMHScroll); - - //--------------- local functions ------------------------------------------- - - function GetRealScrollPosition: Integer; - - var - SI: TScrollInfo; - Code: Integer; - - begin - SI.cbSize := SizeOf(TScrollInfo); - SI.fMask := SIF_TRACKPOS; - Code := SB_HORZ; - GetScrollInfo(Handle, Code, SI); - Result := SI.nTrackPos; - end; - - //--------------- end local functions --------------------------------------- - -var - RTLFactor: Integer; - -begin - if UseRightToLeftAlignment then - RTLFactor := -1 - else - RTLFactor := 1; - - case Message.ScrollCode of - SB_BOTTOM: - SetOffsetX(-Integer(FRangeX)); - SB_ENDSCROLL: - begin - DoStateChange([], [tsThumbTracking]); - // avoiding to adjust the vertical scroll position while tracking makes it much smoother - // but we need to adjust the final position here then - UpdateHorizontalScrollBar(False); - end; - SB_LINELEFT: - SetOffsetX(FOffsetX + RTLFactor * FScrollBarOptions.FIncrementX); - SB_LINERIGHT: - SetOffsetX(FOffsetX - RTLFactor * FScrollBarOptions.FIncrementX); - SB_PAGELEFT: - SetOffsetX(FOffsetX + RTLFactor * (ClientWidth - FHeader.Columns.GetVisibleFixedWidth)); - SB_PAGERIGHT: - SetOffsetX(FOffsetX - RTLFactor * (ClientWidth - FHeader.Columns.GetVisibleFixedWidth)); - SB_THUMBPOSITION, - SB_THUMBTRACK: - begin - DoStateChange([tsThumbTracking]); - if UseRightToLeftAlignment then - SetOffsetX(-Integer(FRangeX) + ClientWidth + GetRealScrollPosition) - else - SetOffsetX(-GetRealScrollPosition); - end; - SB_TOP: - SetOffsetX(0); - end; - - Message.Result := 0; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMKeyDown(var Message: TWMKeyDown); - -// Keyboard event handling for node focus, selection, node specific popup menus and help invokation. -// For a detailed description of every action done here read the help. - -var - Shift: TShiftState; - Node, Temp, - LastFocused: PVirtualNode; - Offset: Integer; - ClearPending, - NeedInvalidate, - DoRangeSelect, - PerformMultiSelect: Boolean; - Context: Integer; - ParentControl: TWinControl; - R: TRect; - NewCheckState: TCheckState; - TempColumn, - NewColumn: TColumnIndex; - ActAsGrid: Boolean; - ForceSelection: Boolean; - NewWidth, - NewHeight: Integer; - RTLFactor: Integer; - - // for tabulator handling - GetStartColumn: function(ConsiderAllowFocus: Boolean = False): TColumnIndex of object; - GetNextColumn: function(Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex of object; - GetNextNode: TGetNextNodeProc; - - KeyState: TKeyboardState; - Buffer: array[0..1] of AnsiChar; - - //--------------- local functions ------------------------------------------- - function getPreviousVisibleAutoSpanColumn(acolumn: TColumnIndex; anode: PVirtualNode): TColumnIndex; - var - PrevColumn: Integer; - begin - if (not assigned(anode)) - or (not FHeader.UseColumns) - or (not (toAutoSpanColumns in FOptions.FAutoOptions)) - or (acolumn = FHeader.MainColumn) then - begin - //previously existing logic - result := FHeader.Columns.GetPreviousVisibleColumn(acolumn, True); - exit; - end; - //consider auto spanning - with FHeader.FColumns do //standard loop for auto span - begin - PrevColumn := acolumn; - repeat - result := FHeader.Columns.GetPreviousVisibleColumn(PrevColumn); - if (result = InvalidColumn) or - (not ColumnIsEmpty(anode, result)) - //Any other BidiMode is not supported as already - //documented by original developer - or (Items[result].BidiMode <> bdLeftToRight) then - Break; - PrevColumn := result; - until False; - end; - end; - - //--------------------------------------------------------------------------- - function getNextVisibleAutoSpanColumn(acolumn: TColumnIndex; anode: PVirtualNode): TColumnIndex; - var - NextColumn: Integer; - begin - if (not assigned(anode)) - or (not FHeader.UseColumns) - or (not (toAutoSpanColumns in FOptions.FAutoOptions)) - or (acolumn = FHeader.MainColumn) then - begin - //previously existing logic - result := FHeader.Columns.GetNextVisibleColumn(acolumn, True); - exit; - end; - //consider auto spanning - with FHeader.FColumns do //standard loop for auto span - begin - NextColumn := acolumn; - repeat - result := FHeader.Columns.GetNextVisibleColumn(NextColumn); - if (result = InvalidColumn) or - not ColumnIsEmpty(anode, result) - //Any other BidiMode is not supported as already - //documented by original developer - or (Items[result].BidiMode <> bdLeftToRight) then - Break; - NextColumn := result; - until False; - end; - end; - - //--------------------------------------------------------------------------- - function isEmptyAutoSpanColumn(acolumn: TColumnIndex; anode: PVirtualNode): boolean; - var - previousColumn: Integer; - begin - result := false; - if (not assigned(anode)) - or (not FHeader.UseColumns) - or (not (toAutoSpanColumns in FOptions.FAutoOptions)) - or (acolumn = FHeader.MainColumn) then - exit; - with FHeader.FColumns do - begin - previousColumn := FHeader.Columns.GetPreviousVisibleColumn(acolumn); - if (previousColumn = InvalidColumn) //there is no previous column - //Any other BidiMode is not supported as already - //documented by original developer - or (Items[acolumn].BidiMode <> bdLeftToRight) then - exit; //returning false - result := ColumnIsEmpty(anode, acolumn); - end; - end; - - - //--------------- end local functions --------------------------------------- - -begin - // Make form key preview work and let application modify the key if it wants this. - inherited; - - with Message do - begin - Shift := KeyDataToShiftState(KeyData); - // Ask the application if the default key handling is desired. - if DoKeyAction(CharCode, Shift) then - begin - if (CharCode in [VK_HOME, VK_END, VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_BACK, VK_TAB]) and (RootNode.FirstChild <> nil) then - begin - PerformMultiSelect := (ssShift in Shift) and (toMultiSelect in FOptions.FSelectionOptions) and not IsEditing; - - // Flag to avoid range selection in case of single node advance. - DoRangeSelect := (CharCode in [VK_HOME, VK_END, VK_PRIOR, VK_NEXT]) and PerformMultiSelect and not IsEditing; - - NeedInvalidate := DoRangeSelect or (FSelectionCount > 1); - ActAsGrid := toGridExtensions in FOptions.FMiscOptions; - ClearPending := (Shift = []) or (ActAsGrid and not (ssShift in Shift)) or - not (toMultiSelect in FOptions.FSelectionOptions) or (CharCode in [VK_TAB, VK_BACK]); - - // Keep old focused node for range selection. Use a default node if none was focused until now. - LastFocused := FFocusedNode; - if (LastFocused = nil) and (Shift <> []) then - LastFocused := GetFirstVisible(nil, True); - - // Set an initial range anchor if there is not yet one. - if FRangeAnchor = nil then - FRangeAnchor := GetFirstSelected; - if FRangeAnchor = nil then - FRangeAnchor := GetFirst; - - if UseRightToLeftAlignment then - RTLFactor := -1 - else - RTLFactor := 1; - - // Determine new focused node. - case CharCode of - VK_HOME, VK_END: - begin - if (CharCode = VK_END) xor UseRightToLeftAlignment then - begin - GetStartColumn := FHeader.FColumns.GetLastVisibleColumn; - GetNextColumn := FHeader.FColumns.GetPreviousVisibleColumn; - GetNextNode := GetPreviousVisible; - Node := GetLastVisible(nil, True); - end - else - begin - GetStartColumn := FHeader.FColumns.GetFirstVisibleColumn; - GetNextColumn := FHeader.FColumns.GetNextVisibleColumn; - GetNextNode := GetNextVisible; - Node := GetFirstVisible(nil, True); - end; - - // Advance to next/previous visible column. - if FHeader.UseColumns then - NewColumn := GetStartColumn - else - NewColumn := NoColumn; - // Find a column for the new/current node which can be focused. - // Make the 'DoFocusChanging' for finding a valid column - // identifiable from the 'DoFocusChanging' raised later on by - // "FocusedNode := Node;" - while (NewColumn > NoColumn) and not DoFocusChanging(FFocusedNode, FFocusedNode, FFocusedColumn, NewColumn) do - NewColumn := GetNextColumn(NewColumn); - if NewColumn > InvalidColumn then - begin - if (Shift = [ssCtrl]) and not ActAsGrid then - begin - ScrollIntoView(Node, toCenterScrollIntoView in FOptions.SelectionOptions, - not (toDisableAutoscrollOnFocus in FOptions.FAutoOptions)); - if (CharCode = VK_HOME) and not UseRightToLeftAlignment then - SetOffsetX(0) - else - SetOffsetX(-MaxInt); - end - else - begin - if not ActAsGrid or (ssCtrl in Shift) then - FocusedNode := Node; - //fix: In grid mode, if full row select option is ON, - //then also go to the node determined from the earlier logic - if ActAsGrid and (toFullRowSelect in FOptions.FSelectionOptions) then - FocusedNode := Node; - if ActAsGrid and not (toFullRowSelect in FOptions.FSelectionOptions) then - begin - FocusedColumn := NewColumn; - // fix: If auto span is ON the last column may be a merged column. So take - // care of selecting the whole merged column on END key. - if (CharCode = VK_END) and isEmptyAutoSpanColumn(NewColumn, FFocusedNode) then - FocusedColumn := getPreviousVisibleAutoSpanColumn(NewColumn, FFocusedNode); - end; - end; - end; - end; - VK_PRIOR: - if Shift = [ssCtrl, ssShift] then - SetOffsetX(FOffsetX + ClientWidth) - else - if [ssShift, ssAlt] = Shift then - begin - if FFocusedColumn <= NoColumn then - NewColumn := FHeader.FColumns.GetFirstVisibleColumn - else - begin - Offset := FHeader.FColumns.GetVisibleFixedWidth; - NewColumn := FFocusedColumn; - while True do - begin - TempColumn := FHeader.FColumns.GetPreviousVisibleColumn(NewColumn); - NewWidth := FHeader.FColumns[NewColumn].Width; - if (TempColumn <= NoColumn) or - (Offset + NewWidth >= ClientWidth) or - (coFixed in FHeader.FColumns[TempColumn].FOptions) then - Break; - NewColumn := TempColumn; - Inc(Offset, NewWidth); - end; - end; - SetFocusedColumn(NewColumn); - end - else - if ssCtrl in Shift then - SetOffsetY(FOffsetY + ClientHeight) - else - begin - Offset := 0; - // If there's no focused node then just take the very first visible one. - if FFocusedNode = nil then - Node := GetFirstVisible(nil, True) - else - begin - // Go up as many nodes as comprise together a size of ClientHeight. - Node := FFocusedNode; - while True do - begin - Temp := GetPreviousVisible(Node, True); - NewHeight := NodeHeight[Node]; - if (Temp = nil) or (Offset + NewHeight >= ClientHeight) then - Break; - Node := Temp; - Inc(Offset, NodeHeight[Node]); - end; - end; - FocusedNode := Node; - end; - VK_NEXT: - if Shift = [ssCtrl, ssShift] then - SetOffsetX(FOffsetX - ClientWidth) - else - if [ssShift, ssAlt] = Shift then - begin - if FFocusedColumn <= NoColumn then - NewColumn := FHeader.FColumns.GetFirstVisibleColumn - else - begin - Offset := FHeader.FColumns.GetVisibleFixedWidth; - NewColumn := FFocusedColumn; - while True do - begin - TempColumn := FHeader.FColumns.GetNextVisibleColumn(NewColumn); - NewWidth := FHeader.FColumns[NewColumn].Width; - if (TempColumn <= NoColumn) or - (Offset + NewWidth >= ClientWidth) or - (coFixed in FHeader.FColumns[TempColumn].FOptions) then - Break; - NewColumn := TempColumn; - Inc(Offset, NewWidth); - end; - end; - SetFocusedColumn(NewColumn); - end - else - if ssCtrl in Shift then - SetOffsetY(FOffsetY - ClientHeight) - else - begin - Offset := 0; - // If there's no focused node then just take the very last one. - if FFocusedNode = nil then - Node := GetLastVisible(nil, True) - else - begin - // Go up as many nodes as comprise together a size of ClientHeight. - Node := FFocusedNode; - while True do - begin - Temp := GetNextVisible(Node, True); - NewHeight := NodeHeight[Node]; - if (Temp = nil) or (Offset + NewHeight >= ClientHeight) then - Break; - Node := Temp; - Inc(Offset, NewHeight); - end; - end; - FocusedNode := Node; - end; - VK_UP: - begin - // scrolling without selection change - if ssCtrl in Shift then - SetOffsetY(FOffsetY + Integer(FDefaultNodeHeight)) - else - begin - if FFocusedNode = nil then - Node := GetLastVisible(nil, True) - else - Node := GetPreviousVisible(FFocusedNode, True); - - if Assigned(Node) then - begin - if not EndEditNode then - exit; - if (not PerformMultiSelect or (CompareNodePositions(LastFocused, FRangeAnchor) > 0)) and - Assigned(FFocusedNode) then - ClearSelection(False); - if FFocusedColumn <= NoColumn then - FFocusedColumn := FHeader.MainColumn; - FocusedNode := Node; - end - else - if Assigned(FFocusedNode) then - InvalidateNode(FFocusedNode); - end; - end; - VK_DOWN: - begin - // scrolling without selection change - if ssCtrl in Shift then - SetOffsetY(FOffsetY - Integer(FDefaultNodeHeight)) - else - begin - if FFocusedNode = nil then - Node := GetFirstVisible(nil, True) - else - Node := GetNextVisible(FFocusedNode, True); - - if Assigned(Node) then - begin - if not EndEditNode then - exit; - if (not PerformMultiSelect or (CompareNodePositions(LastFocused, FRangeAnchor) < 0)) and Assigned(FFocusedNode) then - ClearSelection(False); - if FFocusedColumn <= NoColumn then - FFocusedColumn := FHeader.MainColumn; - FocusedNode := Node; - end - else - if Assigned(FFocusedNode) then - InvalidateNode(FFocusedNode); - end; - end; - VK_LEFT: - begin - // special handling - if ssCtrl in Shift then - SetOffsetX(FOffsetX + RTLFactor * FHeader.Columns.GetScrollWidth) - else - begin - // other special cases - Context := NoColumn; - if (toExtendedFocus in FOptions.FSelectionOptions) and (toGridExtensions in FOptions.FMiscOptions) then - begin - Context := getPreviousVisibleAutoSpanColumn(FFocusedColumn, FFocusedNode); - if Context > NoColumn then - FocusedColumn := Context; - end - else - if Assigned(FFocusedNode) and (vsExpanded in FFocusedNode.States) and - (Shift = []) and (vsHasChildren in FFocusedNode.States) then - ToggleNode(FFocusedNode) - else - begin - if FFocusedNode = nil then - FocusedNode := GetFirstVisible(nil, True) - else - begin - if FFocusedNode.Parent <> FRoot then - Node := FFocusedNode.Parent - else - Node := nil; - if Assigned(Node) then - begin - if PerformMultiSelect then - begin - // and a third special case - if FFocusedNode.Index > 0 then - DoRangeSelect := True - else - if CompareNodePositions(Node, FRangeAnchor) > 0 then - RemoveFromSelection(FFocusedNode); - end; - FocusedNode := Node; - end - else begin - // If already a root node is selected, then scroll to the left as there is nothing else we could do. #691 - SetOffsetX(FOffsetX + RTLFactor * FHeader.Columns.GetScrollWidth); - end;//else - end; - end; - end; - end; - VK_RIGHT: - begin - // special handling - if ssCtrl in Shift then - SetOffsetX(FOffsetX - RTLFactor * FHeader.Columns.GetScrollWidth) - else - begin - // other special cases - Context := NoColumn; - if (toExtendedFocus in FOptions.FSelectionOptions) and (toGridExtensions in FOptions.FMiscOptions) then - begin - Context := getNextVisibleAutoSpanColumn(FFocusedColumn, FFocusedNode); - if Context > NoColumn then - FocusedColumn := Context; - end - else - if Assigned(FFocusedNode) and not (vsExpanded in FFocusedNode.States) and - (Shift = []) and (vsHasChildren in FFocusedNode.States) then - ToggleNode(FFocusedNode) - else - begin - if FFocusedNode = nil then - FocusedNode := GetFirstVisible(nil, True) - else - begin - Node := GetFirstVisibleChild(FFocusedNode); - if Assigned(Node) then - begin - if PerformMultiSelect and (CompareNodePositions(Node, FRangeAnchor) < 0) then - RemoveFromSelection(FFocusedNode); - FocusedNode := Node; - end - else begin - // If already a leaf node is selected, then scroll to the right as there is nothing else we could do. #691 - SetOffsetX(FOffsetX - RTLFactor * FHeader.Columns.GetScrollWidth); - end;//else - end; - end; - end; - end; - VK_BACK: - if tsIncrementalSearching in FStates then - DoStateChange([tsIncrementalSearchPending]) - else - if Assigned(FFocusedNode) and (FFocusedNode.Parent <> FRoot) then - FocusedNode := FocusedNode.Parent; - VK_TAB: - if (toExtendedFocus in FOptions.FSelectionOptions) and FHeader.UseColumns then - begin - // In order to avoid duplicating source code just to change the direction - // we use function variables. - if ssShift in Shift then - begin - GetStartColumn := FHeader.FColumns.GetLastVisibleColumn; - GetNextColumn := FHeader.FColumns.GetPreviousVisibleColumn; - GetNextNode := GetPreviousVisible; - end - else - begin - GetStartColumn := FHeader.FColumns.GetFirstVisibleColumn; - GetNextColumn := FHeader.FColumns.GetNextVisibleColumn; - GetNextNode := GetNextVisible; - end; - - // Advance to next/previous visible column/node. - Node := FFocusedNode; - NewColumn := GetNextColumn(FFocusedColumn, True); - repeat - // Find a column for the current node which can be focused. - while (NewColumn > NoColumn) and not DoFocusChanging(FFocusedNode, Node, FFocusedColumn, NewColumn) - //Fix: for Tab Key to properly skip the empty auto span column - or isEmptyAutoSpanColumn(NewColumn, Node) do - NewColumn := GetNextColumn(NewColumn, True); - - if NewColumn > NoColumn then - begin - // Set new node and column in one go. - SetFocusedNodeAndColumn(Node, NewColumn); - Break; - end; - - // No next column was accepted for the current node. So advance to next node and try again. - Node := GetNextNode(Node); - NewColumn := GetStartColumn; - - // fix: From last column, the Tab key should always go to next row irrespective of auto span - // Similarly the Shift-Tab key should go to previos row from first column - if (Node <> nil) and (NewColumn > NoColumn) then - SetFocusedNodeAndColumn(Node, NewColumn); - - until Node = nil; - end; - end; - - // Clear old selection if required but take care to select the new focused node if it was not selected before. - ForceSelection := False; - if ClearPending and ((LastFocused <> FFocusedNode) or (FSelectionCount <> 1)) then - begin - ClearSelection(not Assigned(FFocusedNode)); - ForceSelection := True; - end; - - // Determine new selection anchor. - if Shift = [] then - begin - FRangeAnchor := FFocusedNode; - FLastSelectionLevel := GetNodeLevelForSelectConstraint(FFocusedNode); - end; - - if Assigned(FFocusedNode) then - begin - // Finally change the selection for a specific range of nodes. - if DoRangeSelect then - ToggleSelection(LastFocused, FFocusedNode); - - // Make sure the new focused node is also selected. - if (LastFocused <> FFocusedNode) or ForceSelection then - AddToSelection(FFocusedNode, False); - end; - - // If a repaint is needed then paint the entire tree because of the ClearSelection call, - if NeedInvalidate then - Invalidate; - end - else - begin - // Second chance for keys not directly concerned with selection changes. - - // For +, -, /, * keys on the main keyboard (not numpad) there is no virtual key code defined. - // We have to do special processing to get them working too. - GetKeyboardState(KeyState); - // Avoid conversion to control characters. We have captured the control key state already in Shift. - KeyState[VK_CONTROL] := 0; - if ToASCII(Message.CharCode, (Message.KeyData shr 16) and 7, KeyState, PChar(@Buffer), 0) > 0 then - begin - case Buffer[0] of - '*': - CharCode := VK_MULTIPLY; - '+': - CharCode := VK_ADD; - '/': - CharCode := VK_DIVIDE; - '-': - CharCode := VK_SUBTRACT; - end; - end; - - // According to https://web.archive.org/web/20041129085958/http://www.it-faq.pl/mskb/99/337.HTM - // there is a problem with ToASCII when used in conjunction with dead chars. - // The article recommends to call ToASCII twice to restore a deleted flag in the key message - // structure under certain circumstances. It turned out it is best to always call ToASCII twice. - ToASCII(Message.CharCode, (Message.KeyData shr 16) and 7, KeyState, PChar(@Buffer), 0); - - case CharCode of - VK_F2: - if (Shift = []) and Assigned(FFocusedNode) and CanEdit(FFocusedNode, FFocusedColumn) then - begin - FEditColumn := FFocusedColumn; - DoEdit; - end; - VK_ADD: - if not (tsIncrementalSearching in FStates) then - begin - if ssCtrl in Shift then begin// When changing this code review issue #781 - if ((toReverseFullExpandHotKey in TreeOptions.MiscOptions) and (Shift = [ssCtrl])) xor (Shift = [ssCtrl, ssShift]) then - FullExpand - else if Shift = [ssCtrl] then - FHeader.AutoFitColumns - end - else if Shift = [] then begin - if Assigned(FFocusedNode) and not (vsExpanded in FFocusedNode.States) then - ToggleNode(FFocusedNode); - end// if Shift = [] - else - DoStateChange([tsIncrementalSearchPending]); - end;//if not (tsIncrementalSearching in FStates) - VK_SUBTRACT: - if not (tsIncrementalSearching in FStates) then - begin - if ssCtrl in Shift then - if (toReverseFullExpandHotKey in TreeOptions.MiscOptions) xor (ssShift in Shift) then - FullCollapse - else - FHeader.RestoreColumns - else - if Assigned(FFocusedNode) and (vsExpanded in FFocusedNode.States) then - ToggleNode(FFocusedNode); - end - else - DoStateChange([tsIncrementalSearchPending]); - VK_MULTIPLY: - if not (tsIncrementalSearching in FStates) then - begin - if Assigned(FFocusedNode) then - FullExpand(FFocusedNode); - end - else - DoStateChange([tsIncrementalSearchPending]); - VK_DIVIDE: - if not (tsIncrementalSearching in FStates) then - begin - if Assigned(FFocusedNode) then - FullCollapse(FFocusedNode); - end - else - DoStateChange([tsIncrementalSearchPending]); - VK_ESCAPE: // cancel actions currently in progress - begin - if IsMouseSelecting then - begin - DoStateChange([], [tsDrawSelecting, tsDrawSelPending]); - Invalidate; - end - else - if IsEditing then - CancelEditNode; - end; - VK_SPACE: - if (toCheckSupport in FOptions.FMiscOptions) and Assigned(FFocusedNode) and - (FFocusedNode.CheckType <> ctNone) then - begin - NewCheckState := DetermineNextCheckState(FFocusedNode.CheckType, GetCheckState(FFocusedNode)); - if DoChecking(FFocusedNode, NewCheckState) then - begin - if SelectedCount > 1 then - SetCheckStateForAll(NewCheckState, True) - else - DoCheckClick(FFocusedNode, NewCheckState); - end; - end - else - DoStateChange([tsIncrementalSearchPending]); - VK_F1: - if Assigned(FOnGetHelpContext) then - begin - Context := 0; - if Assigned(FFocusedNode) then - begin - Node := FFocusedNode; - // Traverse the tree structure up to the root. - repeat - FOnGetHelpContext(Self, Node, IfThen(FFocusedColumn > NoColumn, FFocusedColumn, 0), Context); - Node := Node.Parent; - until (Node = FRoot) or (Context <> 0); - end; - - // If no help context could be found try the tree's one or its parent's contexts. - ParentControl := Self; - while Assigned(ParentControl) and (Context = 0) do - begin - Context := ParentControl.HelpContext; - ParentControl := ParentControl.Parent; - end; - if Context <> 0 then - Application.HelpContext(Context); - end; - VK_APPS: - if Assigned(FFocusedNode) then - begin - R := GetDisplayRect(FFocusedNode, FFocusedColumn, True); - Offset := DoGetNodeWidth(FFocusedNode, FFocusedColumn); - if FFocusedColumn >= 0 then - begin - if Offset > FHeader.Columns[FFocusedColumn].Width then - Offset := FHeader.Columns[FFocusedColumn].Width; - end - else - begin - if Offset > ClientWidth then - Offset := ClientWidth; - end; - DoPopupMenu(FFocusedNode, FFocusedColumn, Point(R.Left + Offset div 2, (R.Top + R.Bottom) div 2)); - end - else - DoPopupMenu(nil, FFocusedColumn, Point(-1, -1)); - Ord('a'), Ord('A'): - if ssCtrl in Shift then - SelectAll(True) - else - DoStateChange([tsIncrementalSearchPending]); - else - begin - // Use the key for incremental search. - // Since we are dealing with Unicode all the time there should be a more sophisticated way - // of checking for valid characters for incremental search. - // This is available but would require to include a significant amount of Unicode character - // properties, so we stick with the simple space check. - if ((Shift * [ssCtrl, ssAlt] = []) or ((Shift * [ssCtrl, ssAlt] = [ssCtrl, ssAlt]))) and (CharCode >= 32) then - DoStateChange([tsIncrementalSearchPending]); - end; - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMKeyUp(var Message: TWMKeyUp); - -begin - inherited; - - case Message.CharCode of - VK_TAB: - EnsureNodeFocused(); // Always select a node if the control gets the focus via TAB key, #237 - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMKillFocus(var Msg: TWMKillFocus); - -var - Form: TCustomForm; - Control: TWinControl; - Pos: TSmallPoint; - Unknown: IUnknown; - -begin - inherited; - - // Remove hint if shown currently. - if tsHint in Self.FStates then - Application.CancelHint; - - // Stop wheel panning if active. - StopWheelPanning; - - // Don't let any timer continue if the tree is no longer the active control (except change timers). - StopTimer(ExpandTimer); - StopTimer(EditTimer); - StopTimer(HeaderTimer); - StopTimer(ScrollTimer); - StopTimer(SearchTimer); - FSearchBuffer := ''; - FLastSearchNode := nil; - - DoStateChange([], [tsScrollPending, tsScrolling, tsEditPending, tsLeftButtonDown, tsRightButtonDown, - tsMiddleButtonDown, tsOLEDragPending, tsVCLDragPending, tsIncrementalSearching, tsNodeHeightTrackPending, - tsNodeHeightTracking]); - - if (FSelectionCount > 0) or not (toGhostedIfUnfocused in FOptions.FPaintOptions) then - Invalidate - else - if Assigned(FFocusedNode) then - InvalidateNode(FFocusedNode); - - // Workaround for wrapped non-VCL controls (like TWebBrowser), which do not use VCL mechanisms and - // leave the ActiveControl property in the wrong state, which causes trouble when the control is refocused. - Form := GetParentForm(Self); - if Assigned(Form) and (Form.ActiveControl = Self) then - begin - Cardinal(Pos) := GetMessagePos; - Control := FindVCLWindow(SmallPointToPoint(Pos)); - // Every control derived from TOleControl has potentially the focus problem. In order to avoid including - // the OleCtrls unit (which will, among others, include Variants), which would allow to test for the TOleControl - // class, the IOleClientSite interface is used for the test, which is supported by TOleControl and a good indicator. - if Assigned(Control) and Control.GetInterface(IOleClientSite, Unknown) then - Form.ActiveControl := nil; - - // For other classes the active control should not be modified. Otherwise you need two clicks to select it. - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMLButtonDblClk(var Message: TWMLButtonDblClk); - -var - HitInfo: THitInfo; - -begin - DoStateChange([tsLeftDblClick]); - try - // get information about the hit, before calling inherited, is this may change the scroll postion and so the node under the mouse would chnage and would no longer be the one the user actually clicked - GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); - HandleMouseDblClick(Message, HitInfo); - // Call inherited after doing our standard handling, as the event handler may close the form or re-fill the control, so our clicked node would be no longer valid. - // Our standard handling does not do that. - inherited; - finally - DoStateChange([], [tsLeftDblClick]); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMLButtonDown(var Message: TWMLButtonDown); - -var - HitInfo: THitInfo; - -begin - DoStateChange([tsLeftButtonDown]); - inherited; - - // get information about the hit - GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); - HandleMouseDown(Message, HitInfo); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMLButtonUp(var Message: TWMLButtonUp); - -var - HitInfo: THitInfo; - -begin - DoStateChange([], [tsLeftButtonDown, tsNodeHeightTracking, tsNodeHeightTrackPending]); - - // get information about the hit - GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); - HandleMouseUp(Message, HitInfo); - - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMMButtonDblClk(var Message: TWMMButtonDblClk); - -var - HitInfo: THitInfo; - -begin - DoStateChange([tsMiddleDblClick]); - inherited; - - // get information about the hit - if toMiddleClickSelect in FOptions.FSelectionOptions then - begin - GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); - HandleMouseDblClick(Message, HitInfo); - end; - DoStateChange([], [tsMiddleDblClick]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMMButtonDown(var Message: TWMMButtonDown); - -var - HitInfo: THitInfo; - -begin - DoStateChange([tsMiddleButtonDown]); - - if FHeader.FStates = [] then - begin - inherited; - - // Start wheel panning or scrolling if not already active, allowed and scrolling is useful at all. - if (toWheelPanning in FOptions.FMiscOptions) and ([tsWheelScrolling, tsWheelPanning] * FStates = []) and - ((Integer(FRangeX) > ClientWidth) or (Integer(FRangeY) > ClientHeight)) then - begin - FLastClickPos := SmallPointToPoint(Message.Pos); - StartWheelPanning(FLastClickPos); - end - else - begin - StopWheelPanning; - - // Get information about the hit. - if toMiddleClickSelect in FOptions.FSelectionOptions then - begin - GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); - HandleMouseDown(Message, HitInfo); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMMButtonUp(var Message: TWMMButtonUp); - -var - HitInfo: THitInfo; - -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 FHeader.FStates = [] then - begin - inherited; - - // get information about the hit - if toMiddleClickSelect in FOptions.FSelectionOptions then - begin - GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); - HandleMouseUp(Message, HitInfo); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMNCCalcSize(var Message: TWMNCCalcSize); - -begin - inherited; - - with FHeader do - if hoVisible in FHeader.FOptions then - with Message.CalcSize_Params^ do - Inc(rgrc[0].Top, FHeight); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMNCDestroy(var Message: TWMNCDestroy); - -// Used to release a reference of the drag manager. This is the only reliable way we get notified about -// window destruction, because of the automatic release of a window if its parent window is freed. - -begin - InterruptValidation; - - StopTimer(ChangeTimer); - StopTimer(StructureChangeTimer); - - if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) then - RevokeDragDrop(Handle); - - // Clean up other stuff. - DeleteObject(FDottedBrush); - FDottedBrush := 0; - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMNCHitTest(var Message: TWMNCHitTest); - -begin - inherited; - if (hoVisible in FHeader.FOptions) and - FHeader.InHeader(ScreenToClient(SmallPointToPoint(Message.Pos))) then - Message.Result := HTBORDER; -end; - -//---------------------------------------------------------------------------------------------------------------------- - - -procedure TBaseVirtualTree.WMNCPaint(var Message: TWMNCPaint); - -var - DC: HDC; - R: TRect; - Flags: DWORD; - ExStyle: Integer; - TempRgn: HRGN; - BorderWidth, - BorderHeight: Integer; - -begin - if tsUseThemes in FStates then - begin - // If theming is enabled and the client edge border is set for the window then prevent the default window proc - // from painting the old border to avoid flickering. - ExStyle := GetWindowLong(Handle, GWL_EXSTYLE); - if (ExStyle and WS_EX_CLIENTEDGE) <> 0 then - begin - GetWindowRect(Handle, R); - // Determine width of the client edge. - BorderWidth := GetSystemMetrics(SM_CXEDGE); - BorderHeight := GetSystemMetrics(SM_CYEDGE); - InflateRect(R, -BorderWidth, -BorderHeight); - TempRgn := CreateRectRgnIndirect(R); - // Exclude the border from the message region if there is one. Otherwise just use the inflated - // window area region. - if Message.Rgn <> 1 then - CombineRgn(TempRgn, Message.Rgn, TempRgn, RGN_AND); - DefWindowProc(Handle, Message.Msg, WPARAM(TempRgn), 0); - DeleteObject(TempRgn); - end - else - DefaultHandler(Message); - end - else - DefaultHandler(Message); - - Flags := DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE; - - if (Message.Rgn = 1) then - DC := GetDCEx(Handle, 0, Flags) - else - DC := GetDCEx(Handle, Message.Rgn, Flags or DCX_INTERSECTRGN); - - if DC <> 0 then - try - OriginalWMNCPaint(DC); - finally - ReleaseDC(Handle, DC); - end; - if (((tsUseThemes in FStates) and not VclStyleEnabled) or (VclStyleEnabled and (seBorder in StyleElements))) then - StyleServices.PaintBorder(Self, False) - else - if (VclStyleEnabled and not (seBorder in StyleElements)) then - TStyleManager.SystemStyle.PaintBorder(Self, False) -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMPaint(var Message: TWMPaint); -var - DC: HDC; -begin - if tsVCLDragging in FStates then - ImageList_DragShowNolock(False); - if csPaintCopy in ControlState then - FUpdateRect := ClientRect - else - GetUpdateRect(Handle, FUpdateRect, True); - - inherited; - - if tsVCLDragging in FStates then - ImageList_DragShowNolock(True); - - if hoVisible in FHeader.FOptions then - begin - DC := GetDCEx(Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE); - if DC <> 0 then - try - FHeader.FColumns.PaintHeader(DC, FHeaderRect, -FEffectiveOffsetX); - finally - ReleaseDC(Handle, DC); - end; - end;//if header visible -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMPaste(var Message: TWMPaste); - -begin - PasteFromClipboard; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMPrint(var Message: TWMPrint); - -// This message is sent to request that the tree draws itself to a given device context. This includes not only -// the client area but also the non-client area (header!). - -begin - // Draw only if the window is visible or visibility is not required. - if ((Message.Flags and PRF_CHECKVISIBLE) = 0) or IsWindowVisible(Handle) then - Header.Columns.PaintHeader(Message.DC, FHeaderRect, -FEffectiveOffsetX); - - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMPrintClient(var Message: TWMPrintClient); - -var - Window: TRect; - Target: TPoint; - Canvas: TCanvas; - -begin - // Draw only if the window is visible or visibility is not required. - if ((Message.Flags and PRF_CHECKVISIBLE) = 0) or IsWindowVisible(Handle) then - begin - // Determine area of the entire tree to be displayed in the control. - Window := ClientRect; - Target := Window.TopLeft; - - // The Window rectangle is given in client coordinates. We have to convert it into - // a sliding window of the tree image. - OffsetRect(Window, FEffectiveOffsetX, -FOffsetY); - - Canvas := TCanvas.Create; - try - Canvas.Handle := Message.DC; - PaintTree(Canvas, Window, Target, [poBackground, poDrawFocusRect, poDrawDropMark, poDrawSelection, poGridLines]); - finally - Canvas.Handle := 0; - Canvas.Free; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMRButtonDblClk(var Message: TWMRButtonDblClk); - -var - HitInfo: THitInfo; - -begin - DoStateChange([tsRightDblClick]); - inherited; - - // get information about the hit - if toMiddleClickSelect in FOptions.FSelectionOptions then - begin - GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); - HandleMouseDblClick(Message, HitInfo); - end; - DoStateChange([], [tsRightDblClick]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMRButtonDown(var Message: TWMRButtonDown); - -var - HitInfo: THitInfo; - RemoveSynchMode: Boolean; // Needed to restore tsSynchMode correctly - -begin - DoStateChange([tsRightButtonDown]); - - if FHeader.FStates = [] then - begin - inherited; - - // get information about the hit - if toRightClickSelect in FOptions.FSelectionOptions then - begin - GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); - // Go temporarily into sync mode to avoid a delayed change event for the node when selecting. #679 - RemoveSynchMode := not (tsSynchMode in FStates); - Include(FStates, tsSynchMode); - HandleMouseDown(Message, HitInfo); - if RemoveSynchMode then - Exclude(FStates, tsSynchMode); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMRButtonUp(var Message: TWMRButtonUp); - -// handle right click selection and node specific popup menu - -var - HitInfo: THitInfo; - -begin - DoStateChange([], [tsPopupMenuShown, tsRightButtonDown]); - - if FHeader.FStates = [] then - begin - Application.CancelHint; - - if IsMouseSelecting and Assigned(PopupMenu) then - begin - // Reset selection state already here, before the inherited handler opens the default menu. - DoStateChange([], [tsDrawSelecting, tsDrawSelPending]); - Invalidate; - end; - - inherited; - - // get information about the hit - GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); - - if toRightClickSelect in FOptions.FSelectionOptions then - HandleMouseUp(Message, HitInfo); - - if not Assigned(PopupMenu) then - DoPopupMenu(HitInfo.HitNode, HitInfo.HitColumn, Point(Message.XPos, Message.YPos)); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMSetCursor(var Message: TWMSetCursor); - -// Sets the hot node mouse cursor for the tree. Cursor changes for the header are handled in Header.HandleMessage. - -var - NewCursor: TCursor; - HitInfo: THitInfo; - P: TPoint; - Node: PVirtualNode; - -begin - with Message do - 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 - begin - if not FHeader.HandleMessage(TMessage(Message)) then - begin - // Apply own cursors only if there is no global cursor set. - if Screen.Cursor = crDefault then - begin - // node resizing and hot tracking - for run-time only - if not (csDesigning in ComponentState) then - begin - NewCursor := crDefault; - if (toNodeHeightResize in FOptions.FMiscOptions) then - begin - GetCursorPos(P); - P := ScreenToClient(P); - GetHitTestInfoAt(P.X, P.Y, True, HitInfo); - if (hiOnItem in HitInfo.HitPositions) and - ([hiUpperSplitter, hiLowerSplitter] * HitInfo.HitPositions <> []) then - begin - if hiUpperSplitter in HitInfo.HitPositions then - Node := GetPreviousVisible(HitInfo.HitNode, True) - else - Node := HitInfo.HitNode; - - if CanSplitterResizeNode(P, Node, HitInfo.HitColumn) then - NewCursor := crVertSplit; - end; - end; - - if (NewCursor = crDefault) then - if (toHotTrack in FOptions.PaintOptions) and Assigned(FCurrentHotNode) and (FHotCursor <> crDefault) then - NewCursor := FHotCursor - else - NewCursor := Cursor; - - DoGetCursor(NewCursor); - end - else - NewCursor := Cursor; - Winapi.Windows.SetCursor(Screen.Cursors[NewCursor]); - Message.Result := 1; - end - else - inherited; - end; - end - else - inherited; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMSetFocus(var Msg: TWMSetFocus); - -begin - inherited; - if (FSelectionCount > 0) or not (toGhostedIfUnfocused in FOptions.FPaintOptions) then - Invalidate; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMSize(var Message: TWMSize); - -begin - inherited; - - // Need to update scroll bars here. This will cause a recursion because of the change of the client area - // when changing a scrollbar. Usually this is no problem since with the second level recursion no change of the - // window size happens (the same values for the scrollbars are set, which shouldn't cause a window size change). - // Appearently, this applies not to all systems, however. - if HandleAllocated and ([tsSizing, tsWindowCreating] * FStates = []) and (ClientHeight > 0) then - try - DoStateChange([tsSizing]); - // This call will invalidate the entire non-client area which needs recalculation on resize. - FHeader.RescaleHeader; - FHeader.UpdateSpringColumns; - UpdateScrollBars(True); - - if (tsEditing in FStates) and not FHeader.UseColumns then - UpdateEditBounds; - finally - DoStateChange([], [tsSizing]); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMThemeChanged(var Message: TMessage); - -begin - inherited; - - if StyleServices.Enabled and (toThemeAware in TreeOptions.PaintOptions) then - DoStateChange([tsUseThemes]) - else - DoStateChange([], [tsUseThemes]); - - // Updating the visuals here will not work correctly. Therefore we postpone - // the update by using a timer. - if not FChangingTheme then - SetTimer(Handle, ThemeChangedTimer, ThemeChangedTimerDelay, nil); - FChangingTheme := False; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMTimer(var Message: TWMTimer); - -// centralized timer handling happens here - -begin - with Message do - begin - case TimerID of - ExpandTimer: - DoDragExpand; - EditTimer: - DoEdit; - ScrollTimer: - begin - if tsScrollPending in FStates then - begin - Application.CancelHint; - // Scroll delay has elapsed, set to normal scroll interval now. - SetTimer(Handle, ScrollTimer, FAutoScrollInterval, nil); - DoStateChange([tsScrolling], [tsScrollPending]); - end; - DoTimerScroll; - end; - ChangeTimer: - if tsChangePending in FStates then // see issue #602 - DoChange(FLastChangedNode); - StructureChangeTimer: - DoStructureChange(FLastStructureChangeNode, FLastStructureChangeReason); - SearchTimer: - begin - // When this event triggers then the user did not pressed any key for the specified timeout period. - // Hence incremental searching is stopped. - DoStateChange([], [tsIncrementalSearching]); - StopTimer(SearchTimer); - FSearchBuffer := ''; - FLastSearchNode := nil; - end; - ThemeChangedTimer: - begin - StopTimer(ThemeChangedTimer); - RecreateWnd; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WMVScroll(var Message: TWMVScroll); - - //--------------- local functions ------------------------------------------- - - function GetRealScrollPosition: Integer; - - var - SI: TScrollInfo; - Code: Integer; - - begin - SI.cbSize := SizeOf(TScrollInfo); - SI.fMask := SIF_TRACKPOS; - Code := SB_VERT; - GetScrollInfo(Handle, Code, SI); - Result := SI.nTrackPos; - end; - - //--------------- end local functions --------------------------------------- - -begin - case Message.ScrollCode of - SB_BOTTOM: - SetOffsetY(-Integer(FRoot.TotalHeight)); - SB_ENDSCROLL: - begin - DoStateChange([], [tsThumbTracking]); - // Avoiding to adjust the horizontal scroll position while tracking makes scrolling much smoother - // but we need to adjust the final position here then. - UpdateScrollBars(True); - // Really weird invalidation needed here (and I do it only because it happens so rarely), because - // when showing the horizontal scrollbar while scrolling down using the down arrow button, - // the button will be repainted on mouse up (at the wrong place in the far right lower corner)... - RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_NOERASE or RDW_NOCHILDREN); - end; - SB_LINEUP: - SetOffsetY(FOffsetY + FScrollBarOptions.FIncrementY); - SB_LINEDOWN: - SetOffsetY(FOffsetY - FScrollBarOptions.FIncrementY); - SB_PAGEUP: - SetOffsetY(FOffsetY + ClientHeight); - SB_PAGEDOWN: - SetOffsetY(FOffsetY - ClientHeight); - - SB_THUMBPOSITION, - SB_THUMBTRACK: - begin - DoStateChange([tsThumbTracking]); - SetOffsetY(-GetRealScrollPosition); - end; - SB_TOP: - SetOffsetY(0); - end; - Message.Result := 0; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.AddToSelection(Node: PVirtualNode; NotifySynced: Boolean); - -var - Changed: Boolean; - RemoveSyncAfterChange: Boolean; -begin - if not FSelectionLocked then - begin - Assert(Assigned(Node), 'Node must not be nil!'); - Changed := InternalAddToSelection(Node, False); - if Changed then - begin - UpdateNextNodeToSelect(Node); - if (SelectedCount = 1) then - FocusedNode := Node; // if only one node is selected, make sure the focused node changes with the selected node - InvalidateNode(Node); - RemoveSyncAfterChange := NotifySynced and not (tsSynchMode in fStates); - if RemoveSyncAfterChange then - Include(FStates, tsSynchMode); - try - Change(Node); - finally - if RemoveSyncAfterChange then - Exclude(FStates, tsSynchMode); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.AddToSelection(const NewItems: TNodeArray; NewLength: Integer; ForceInsert: Boolean = False); - -// Adds the given items all at once into the current selection array. NewLength is the amount of -// nodes to add (necessary to allow NewItems to be larger than the actual used entries). -// ForceInsert is True if nodes must be inserted without consideration of level select constraint or -// already set selected flags (e.g. when loading from stream). -// Note: In the case ForceInsert is True the caller is responsible for making sure the new nodes aren't already in the -// selection array! - -var - Changed: Boolean; - -begin - Changed := InternalAddToSelection(NewItems, NewLength, ForceInsert); - if Changed then - begin - if NewLength = 1 then - begin - InvalidateNode(NewItems[0]); - Change(NewItems[0]); - end - else - begin - Invalidate; - Change(nil); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var NextNonEmpty: TColumnIndex); - -// Used in descendants to modify the paint rectangle of the current column while painting a certain node. - -begin - // Since cells are always drawn from left to right the next column index is independent of the - // bidi mode, but not the column borders, which might change depending on the cell's content. - NextNonEmpty := FHeader.FColumns.GetNextVisibleColumn(PaintInfo.Column); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.AdjustPanningCursor(X, Y: Integer); - -// Triggered by a mouse move when wheel panning/scrolling is active. -// Loads the proper cursor which indicates into which direction scrolling is done. - -var - Name: string; - NewCursor: HCURSOR; - ScrollHorizontal, - ScrollVertical: Boolean; - -begin - ScrollHorizontal := Integer(FRangeX) > ClientWidth; - ScrollVertical := Integer(FRangeY) > ClientHeight; - - if (Abs(X - FLastClickPos.X) < 8) and (Abs(Y - FLastClickPos.Y) < 8) then - begin - // Mouse is in the neutral zone. - if ScrollHorizontal then - begin - if ScrollVertical then - Name := 'VT_MOVEALL' - else - Name := 'VT_MOVEEW'; - end - else - Name := 'VT_MOVENS'; - end - else - begin - // One of 8 directions applies: north, north-east, east, south-east, south, south-west, west and north-west. - // Check also if scrolling in the particular direction is possible. - if ScrollVertical and ScrollHorizontal then - begin - // All directions allowed. - if X - FLastClickPos.X < -8 then - begin - // Left hand side. - if Y - FLastClickPos.Y < -8 then - Name := 'VT_MOVENW' - else - if Y - FLastClickPos.Y > 8 then - Name := 'VT_MOVESW' - else - Name := 'VT_MOVEW'; - end - else - if X - FLastClickPos.X > 8 then - begin - // Right hand side. - if Y - FLastClickPos.Y < -8 then - Name := 'VT_MOVENE' - else - if Y - FLastClickPos.Y > 8 then - Name := 'VT_MOVESE' - else - Name := 'VT_MOVEE'; - end - else - begin - // Up or down. - if Y < FLastClickPos.Y then - Name := 'VT_MOVEN' - else - Name := 'VT_MOVES'; - end; - end - else - if ScrollHorizontal then - begin - // Only horizontal movement allowed. - if X < FLastClickPos.X then - Name := 'VT_MOVEW' - else - Name := 'VT_MOVEE'; - end - else - begin - // Only vertical movement allowed. - if Y < FLastClickPos.Y then - Name := 'VT_MOVEN' - else - Name := 'VT_MOVES'; - end; - end; - - // Now load the cursor and apply it. - NewCursor := LoadCursor(HInstance, PChar(Name)); - if FPanningCursor <> NewCursor then - begin - DeleteObject(FPanningCursor); - FPanningCursor := NewCursor; - Winapi.Windows.SetCursor(FPanningCursor); - end - else - DeleteObject(NewCursor); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.AdviseChangeEvent(StructureChange: Boolean; Node: PVirtualNode; Reason: TChangeReason); - -// Used to register a delayed change event. If StructureChange is False then we have a selection change event (without -// a specific reason) otherwise it is a structure change. - -begin - if StructureChange then - begin - if tsStructureChangePending in FStates then - StopTimer(StructureChangeTimer) - else - DoStateChange([tsStructureChangePending]); - - FLastStructureChangeNode := Node; - if FLastStructureChangeReason = crIgnore then - FLastStructureChangeReason := Reason - else - if Reason <> crIgnore then - FLastStructureChangeReason := crAccumulated; - end - else - begin - if tsChangePending in FStates then - StopTimer(ChangeTimer) - else - DoStateChange([tsChangePending]); - - FLastChangedNode := Node; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.AllocateInternalDataArea(Size: Cardinal): Cardinal; - -// Simple registration method to be called by each descendant to claim their internal data area. -// Result is the offset from the begin of the node to the internal data area of the calling tree class. - -begin - Assert((FRoot = nil) or (FRoot.ChildCount = 0), 'Internal data allocation must be done before any node is created.'); - Result := TreeNodeSize + FTotalInternalDataSize; - Inc(FTotalInternalDataSize, (Size + (SizeOf(Pointer) - 1)) and not (SizeOf(Pointer) - 1)); - InitRootNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.Animate(Steps, Duration: Cardinal; Callback: TVTAnimationCallback; Data: Pointer); - -// This method does the calculation part of an animation as used for node toggling and hint animations. -// Steps is the maximum amount of animation steps to do and Duration determines the milliseconds the animation -// has to run. Callback is a task specific method which is called in the loop for every step and Data is simply -// something to pass on to the callback. -// The callback is called with the current step, the current step size and the Data parameter. Since the step amount -// as well as the step size are possibly adjusted during the animation, it is impossible to determine if the current -// step is the last step, even if the original step amount is known. To solve this problem the callback will be -// called after the loop has finished with a step size of 0 indicating so to execute any post processing. - -var - StepSize, - RemainingTime, - RemainingSteps, - NextTimeStep, - CurrentStep, - StartTime: Cardinal; - CurrentTime: Int64; - -begin - if not (tsInAnimation in FStates) and (Duration > 0) then - begin - DoStateChange([tsInAnimation]); - try - RemainingTime := Duration; - RemainingSteps := Steps; - - // Determine the initial step size which is either 1 if the needed steps are less than the number of - // steps possible given by the duration or > 1 otherwise. - StepSize := Round(Max(1, RemainingSteps / Duration)); - RemainingSteps := RemainingSteps div StepSize; - CurrentStep := 0; - - while (RemainingSteps > 0) and (RemainingTime > 0) and not Application.Terminated do - begin - StartTime := timeGetTime; - NextTimeStep := StartTime + RemainingTime div RemainingSteps; - if not Callback(CurrentStep, StepSize, Data) then - Break; - - // Keep duration for this step for rest calculation. - CurrentTime := timeGetTime; - // Wait until the calculated time has been reached. - while CurrentTime < NextTimeStep do - CurrentTime := timeGetTime; - - // Subtract the time this step really needed. - if RemainingTime >= CurrentTime - StartTime then - begin - Dec(RemainingTime, CurrentTime - StartTime); - Dec(RemainingSteps); - end - else - begin - RemainingTime := 0; - RemainingSteps := 0; - end; - // If the remaining time per step is less than one time step then we have to decrease the - // step count and increase the step size. - if (RemainingSteps > 0) and ((RemainingTime div RemainingSteps) < 1) then - begin - repeat - Inc(StepSize); - RemainingSteps := RemainingTime div StepSize; - until (RemainingSteps <= 0) or ((RemainingTime div RemainingSteps) >= 1); - end; - CurrentStep := Steps - RemainingSteps; - end; - - if not Application.Terminated then - Callback(0, 0, Data); - finally - DoStateChange([], [tsInAnimation]); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.StartOperation(OperationKind: TVTOperationKind); - -// Called to indicate that a long-running operation has been started. - -begin - Inc(FOperationCount); - if FOperationCount = 1 then - FOperationCanceled := False; - DoStartOperation(OperationKind); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CalculateSelectionRect(X, Y: Integer): Boolean; - -// Recalculates old and new selection rectangle given that X, Y are new mouse coordinates. -// Returns True if there was a change since the last call. - -var - MaxValue: Integer; - -begin - if tsDrawSelecting in FStates then - FLastSelRect := FNewSelRect; - FNewSelRect.BottomRight := Point(X + FEffectiveOffsetX, Y - FOffsetY); - if FNewSelRect.Right < 0 then - FNewSelRect.Right := 0; - if FNewSelRect.Bottom < 0 then - FNewSelRect.Bottom := 0; - MaxValue := ClientWidth; - if FRangeX > Cardinal(MaxValue) then - MaxValue := FRangeX; - if FNewSelRect.Right > MaxValue then - FNewSelRect.Right := MaxValue; - MaxValue := ClientHeight; - if FRangeY > Cardinal(MaxValue) then - MaxValue := FRangeY; - if FNewSelRect.Bottom > MaxValue then - FNewSelRect.Bottom := MaxValue; - - Result := not CompareMem(@FLastSelRect, @FNewSelRect, SizeOf(FNewSelRect)); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CanAutoScroll: Boolean; - -// Determines if auto scrolling is currently allowed. - -var - IsDropTarget: Boolean; - IsDrawSelecting: Boolean; - IsWheelPanning: Boolean; - -begin - // Don't scroll the client area if the header is currently doing tracking or dragging. - // Do auto scroll only if there is a draw selection in progress or the tree is the current drop target or - // wheel panning/scrolling is active. - IsDropTarget := Assigned(FDragManager) and DragManager.IsDropTarget; - IsDrawSelecting := [tsDrawSelPending, tsDrawSelecting] * FStates <> []; - IsWheelPanning := [tsWheelPanning, tsWheelScrolling] * FStates <> []; - Result := ((toAutoScroll in FOptions.FAutoOptions) or IsWheelPanning) and - (FHeader.FStates = []) and (IsDrawSelecting or IsDropTarget or (tsVCLDragging in FStates) or IsWheelPanning); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CanShowDragImage: Boolean; - -// Determines whether a drag image should be shown. - -begin - Result := FDragImageKind <> diNoImage; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex): Boolean; - -begin - Result := (toNodeHeightResize in FOptions.FMiscOptions) and Assigned(Node) and (Node <> FRoot) and - (Column > NoColumn) and (coFixed in FHeader.FColumns[Column].FOptions); - DoCanSplitterResizeNode(P, Node, Column, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.Change(Node: PVirtualNode); - -begin - AdviseChangeEvent(False, Node, crIgnore); - - if FUpdateCount = 0 then - begin - if (FChangeDelay > 0) and HandleAllocated and not (tsSynchMode in FStates) then - SetTimer(Handle, ChangeTimer, FChangeDelay, nil) - else - DoChange(Node); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ChangeScale(M, D: Integer{$if CompilerVersion >= 31}; isDpiChange: Boolean{$ifend}); -{$if CompilerVersion < 27} -const - DefaultScalingFlags = [sfLeft, sfTop, sfWidth, sfHeight, sfFont]; // Was introduced with XE6: http://docwiki.embarcadero.com/Libraries/XE6/en/Vcl.Controls.TControl.DefaultScalingFlags -{$ifend} -var - Flags: TScalingFlags; - Run: PVirtualNode; -begin - if (toAutoChangeScale in FOptions.FAutoOptions) then - begin - if (M <> D) then - begin - // It is important to evaluate the TScalingFlags before calling inherited, becuase they are differetn afterwards! - if csLoading in ComponentState then - Flags := ScalingFlags - else - Flags := DefaultScalingFlags; // Important for #677 - if (sfHeight in Flags) then begin - FHeader.ChangeScale(M, D); - SetDefaultNodeHeight(MulDiv(FDefaultNodeHeight, M, D)); - Indent := MulDiv(Indent, M, D); - FTextMargin := MulDiv(FTextMargin, M, D); - FMargin := MulDiv(FMargin, M, D); - FImagesMargin := MulDiv(FImagesMargin, M, D); - // Scale utility images, #796 - if FCheckImageKind = ckSystemDefault then begin - FreeAndNil(FCheckImages); - if HandleAllocated then - FCheckImages := CreateSystemImageSet(Self); - end; - UpdateHeaderRect(); - // Scale also node heights - BeginUpdate(); - try - Run := GetFirst(); - while Assigned(Run) do - begin - if vsInitialized in Run.States then - SetNodeHeight(Run, MulDiv(Run.NodeHeight, M, D)) - else // prevent initialization of non-initialzed nodes - Run.NodeHeight := MulDiv(Run.NodeHeight, M, D); - Run := GetNextNoInit(Run); - end; // while - finally - EndUpdate(); - end; - end;//if sfHeight - end;// if M<>D - end;//if toAutoChangeScale - inherited ChangeScale(M, D{$if CompilerVersion >= 31}, isDpiChange{$ifend}); - // It is important to do this call after calling inherited, so that the Font has been updated. - AutoScale(M <> D); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ChangeTreeStatesAsync(EnterStates, LeaveStates: TVirtualTreeStates); -begin - //TODO: If this works reliable, move to TWorkerThread - if (Self.HandleAllocated) then - TThread.Synchronize(nil, procedure begin DoStateChange(EnterStates, LeaveStates) end); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CheckParentCheckState(Node: PVirtualNode; NewCheckState: TCheckState): Boolean; - -// Checks all siblings of node to determine which check state Node's parent must get. - -var - CheckCount, - BoxCount: Cardinal; - PartialCheck: Boolean; - Run: PVirtualNode; - -begin - CheckCount := 0; - BoxCount := 0; - PartialCheck := False; - Run := Node.Parent.FirstChild; - while Assigned(Run) do - begin - if Run = Node then - begin - // The given node cannot be checked because it does not yet have its new check state (as this depends - // on the outcome of this method). Instead NewCheckState is used as this contains the new state the node - // will get if this method returns True. - if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then - begin - Inc(BoxCount); - if NewCheckState.IsChecked then - Inc(CheckCount); - PartialCheck := PartialCheck or (NewCheckState = csMixedNormal); - end; - end - else - if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then - begin - Inc(BoxCount); - if GetCheckState(Run).IsChecked then - Inc(CheckCount); - PartialCheck := PartialCheck or (GetCheckState(Run) = csMixedNormal); - end; - Run := Run.NextSibling; - end; - - if (CheckCount = 0) and not PartialCheck then - NewCheckState := csUncheckedNormal - else - if CheckCount < BoxCount then - NewCheckState := csMixedNormal - else - NewCheckState := csCheckedNormal; - - Node := Node.Parent; - Result := DoChecking(Node, NewCheckState); - if Result then - begin - DoCheckClick(Node, NewCheckState); - // Recursively adjust parent of parent. - // This is already done in the function DoCheckClick() called in the above line - // We revent unnecessary upward recursion by commenting this code. - // with Node^ do - // begin - // if not (vsInitialized in Parent.States) then - // InitNode(Parent); - // if ([vsChecking, vsDisabled] * Parent.States = []) and (Parent <> FRoot) and - // (Parent.CheckType = ctTriStateCheckBox) then - // Result := CheckParentCheckState(Node, NewCheckState); - // end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ClearTempCache; - -// make sure the temporary node cache is in a reliable state - -begin - FTempNodeCache := nil; - FTempNodeCount := 0; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; - -// Returns True if the given column is to be considered as being empty. This will usually be determined by -// descendants as the base tree implementation has not enough information to decide. - -begin - Result := True; - if Assigned(FOnGetCellIsEmpty) then - FOnGetCellIsEmpty(Self, Node, Column, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ComputeRTLOffset(ExcludeScrollBar: Boolean): Integer; - -// Computes the horizontal offset needed when all columns are automatically right aligned (in RTL bidi mode). -// ExcludeScrollBar determines if the left-hand vertical scrollbar is to be included (if visible) or not. - -var - HeaderWidth: Integer; - ScrollBarVisible: Boolean; -begin - ScrollBarVisible := (Integer(FRangeY) > ClientHeight) and (ScrollBarOptions.ScrollBars in [ssVertical, ssBoth]); - if ScrollBarVisible then - Result := GetSystemMetrics(SM_CXVSCROLL) - else - Result := 0; - - // Make everything right aligned. - HeaderWidth := FHeaderRect.Right - FHeaderRect.Left; - if Integer(FRangeX) + Result <= HeaderWidth then - Result := HeaderWidth - Integer(FRangeX); - // Otherwise take only left-hand vertical scrollbar into account. - - if ScrollBarVisible and ExcludeScrollBar then - Dec(Result, GetSystemMetrics(SM_CXVSCROLL)); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CountLevelDifference(Node1, Node2: PVirtualNode): Integer; - -// This method counts how many indentation levels the given nodes are apart. If both nodes have the same parent then the -// difference is 0 otherwise the result is basically GetNodeLevel(Node2) - GetNodeLevel(Node1), but with sign. -// If the result is negative then Node2 is less intended than Node1. - -var - Level1, Level2: Integer; - -begin - Assert(Assigned(Node1) and Assigned(Node2), 'Both nodes must be Assigned.'); - - Level1 := 0; - while Node1.Parent <> FRoot do - begin - Inc(Level1); - Node1 := Node1.Parent; - end; - - Level2 := 0; - while Node2.Parent <> FRoot do - begin - Inc(Level2); - Node2 := Node2.Parent; - end; - - Result := Level2 - Level1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CountVisibleChildren(Node: PVirtualNode): Cardinal; - -// Returns the number of visible child nodes of the given node. - -begin - Result := 0; - - // The node's direct children... - if vsExpanded in Node.States then - begin - // ...and their children. - Node := Node.FirstChild; - while Assigned(Node) do - begin - if vsVisible in Node.States then - Inc(Result, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); - Node := Node.NextSibling; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CreateParams(var Params: TCreateParams); - -const - ScrollBar: array[TScrollStyle] of Cardinal = (0, WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL); - -begin - inherited CreateParams(Params); - - with Params do - begin - Style := Style or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or ScrollBar[ScrollBarOptions.FScrollBars]; - if toFullRepaintOnResize in FOptions.FMiscOptions then - WindowClass.style := WindowClass.style or CS_HREDRAW or CS_VREDRAW - else - WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW); - if FBorderStyle = bsSingle then - begin - if Ctl3D then - begin - ExStyle := ExStyle or WS_EX_CLIENTEDGE; - Style := Style and not WS_BORDER; - end - else - Style := Style or WS_BORDER; - end - else - Style := Style and not WS_BORDER; - - AddBiDiModeExStyle(ExStyle); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CreateWnd; - -// Initializes data which depends on a valid window handle. - -begin - DoStateChange([tsWindowCreating]); - inherited; - DoStateChange([], [tsWindowCreating]); - - if not Assigned(FCheckImages) then - FCheckImages := CreateSystemImageSet(Self); - - if ((StyleServices.Enabled ) and (toThemeAware in TreeOptions.PaintOptions) ) then - begin - DoStateChange([tsUseThemes]); - if (toUseExplorerTheme in FOptions.FPaintOptions) and IsWinVistaOrAbove then - begin - DoStateChange([tsUseExplorerTheme]); - SetWindowTheme('explorer'); - end - else - DoStateChange([], [tsUseExplorerTheme]); - end - else - DoStateChange([], [tsUseThemes, tsUseExplorerTheme]); - - // Because of the special recursion and update stopper when creating the window (or resizing it) - // we have to manually trigger the auto size calculation here. - if hsNeedScaling in FHeader.FStates then - FHeader.RescaleHeader; - if hoAutoResize in FHeader.FOptions then - FHeader.FColumns.AdjustAutoSize(InvalidColumn); - - PrepareBitmaps(True, True); - - // Register tree as OLE drop target. - if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) 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); - - UpdateScrollBars(True); - UpdateHeaderRect; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.FakeReadIdent(Reader: TReader); -begin - Assert(Reader.NextValue = vaIdent); - Reader.ReadIdent; -end; - - -procedure TBaseVirtualTree.DefineProperties(Filer: TFiler); - -// There were heavy changes in some properties during development of VT. This method helps to make migration easier -// by reading old properties manually and put them into the new properties as appropriate. -// Note: these old properties are never written again and silently disappear. -// June 2002: Meanwhile another task is done here too: working around the problem that TCollection is not streamed -// correctly when using Visual Form Inheritance (VFI). - -var - StoreIt: Boolean; - -begin - inherited; - - // The header can prevent writing columns altogether. - if FHeader.CanWriteColumns then - begin - // Check if we inherit from an ancestor form (Visual Form Inheritance). - StoreIt := Filer.Ancestor = nil; - // If there is an ancestor then save columns only if they are different to the base set. - if not StoreIt then - StoreIt := not FHeader.Columns.Equals(TBaseVirtualTree(Filer.Ancestor).FHeader.Columns); - end - else - StoreIt := False; - - Filer.DefineProperty('Columns', FHeader.ReadColumns, FHeader.WriteColumns, StoreIt); - - // #622 made old DFMs incompatible with new VTW - so the program is compiled successfully - // and then suddenly crashes at user site in runtime. - Filer.DefineProperty('CheckImageKind', FakeReadIdent, nil, false); - /// #730 removed property HintAnimation - Filer.DefineProperty('HintAnimation', FakeReadIdent, nil, false); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect): TDropMode; - -// Determine the DropMode. - -var - ImageHit: Boolean; - LabelHit: Boolean; - ItemHit: Boolean; - -begin - ImageHit := HitInfo.HitPositions * [hiOnNormalIcon, hiOnStateIcon] <> []; - LabelHit := hiOnItemLabel in HitInfo.HitPositions; - ItemHit := ((hiOnItem in HitInfo.HitPositions) and - ((toFullRowDrag in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions))); - - // In report mode only direct hits of the node captions/images in the main column are accepted as hits. - if (toReportMode in FOptions.FMiscOptions) and not (ItemHit or ((LabelHit or ImageHit) and - (HitInfo.HitColumn = FHeader.MainColumn))) then - HitInfo.HitNode := nil; - - if Assigned(HitInfo.HitNode) then - begin - if LabelHit or ImageHit or not (toShowDropmark in FOptions.FPaintOptions) then - Result := dmOnNode - else - if ((NodeRect.Top + NodeRect.Bottom) div 2) > P.Y then - Result := dmAbove - else - Result := dmBelow; - end - else - Result := dmNowhere; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DetermineHiddenChildrenFlag(Node: PVirtualNode); - -// Update the hidden children flag of the given node. - -var - Run: PVirtualNode; - -begin - if Node.ChildCount = 0 then - begin - if vsHasChildren in Node.States then - Exclude(Node.States, vsAllChildrenHidden) - else - Include(Node.States, vsAllChildrenHidden); - end - else - begin - // Iterate through all siblings and stop when one visible is found. - Run := Node.FirstChild; - while Assigned(Run) and not IsEffectivelyVisible[Run] do - Run := Run.NextSibling; - if Assigned(Run) then - Exclude(Node.States, vsAllChildrenHidden) - else - Include(Node.States, vsAllChildrenHidden); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DetermineHiddenChildrenFlagAllNodes; - -var - Run: PVirtualNode; - -begin - Run := GetFirstNoInit(False); - while Assigned(Run) do - begin - DetermineHiddenChildrenFlag(Run); - Run := GetNextNoInit(Run); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: Integer; - Alignment: TAlignment); - -// This method determines the hit position within a node with left-to-right orientation. - -var - MainColumnHit: Boolean; - lIndent, - TextWidth, - ImageOffset: Integer; - lOffsets: TVTOffsets; -begin - MainColumnHit := HitInfo.HitColumn = FHeader.MainColumn; - GetOffsets(HitInfo.HitNode, lOffsets, ofsRightOfText, HitInfo.HitColumn); - - if (MainColumnHit and (Offset < lOffsets[ofsCheckbox])) then - begin - // Position is to the left of calculated indentation which can only happen for the main column. - // Check whether it corresponds to a button/checkbox. - if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in HitInfo.HitNode.States) then - begin - // Position of button is interpreted very generously to avoid forcing the user - // to click exactly into the 9x9 pixels area. The entire node height and one full - // indentation level is accepted as button hit. - if Offset >= lOffsets[ofsCheckbox] - Integer(FIndent) then - Include(HitInfo.HitPositions, hiOnItemButton); - if Offset > lOffsets[ofsToggleButton] then - Include(HitInfo.HitPositions, hiOnItemButtonExact); - end; - // no button hit so position is on indent - if HitInfo.HitPositions = [] then - Include(HitInfo.HitPositions, hiOnItemIndent); - end - else - begin - // The next hit positions can be: - // - on the check box - // - on the state image - // - on the normal image - // - to the left of the text area - // - on the label or - // - to the right of the text area - // (in this order). - - // In report mode no hit other than in the main column is possible. - if MainColumnHit or not (toReportMode in FOptions.FMiscOptions) then - begin - if MainColumnHit and (Offset < lOffsets[ofsStateImage]) then - begin - HitInfo.HitPositions := [hiOnItem]; - if (HitInfo.HitNode.CheckType <> ctNone) then - Include(HitInfo.HitPositions, hiOnItemCheckBox); - end - else - begin - ImageOffset := lOffsets[ofsImage]; - if Offset < ImageOffset then - Include(HitInfo.HitPositions, hiOnStateIcon) - else - begin - ImageOffset := lOffsets[ofsLabel]; - if Offset < ImageOffset then - Include(HitInfo.HitPositions, hiOnNormalIcon) - else - begin - TextWidth := lOffsets[ofsRightOfText] - lOffsets[ofsText]; - // ImageOffset contains now the left border of the node label area. This is used to calculate the - // correct alignment in the column. - - // Check if the text can be aligned at all. This is only possible if there is enough room - // in the remaining text rectangle. - if TextWidth > Right - ImageOffset then - Include(HitInfo.HitPositions, hiOnItemLabel) - else - begin - case Alignment of - taCenter: - begin - lIndent := (ImageOffset + Right - TextWidth) div 2; - if Offset < lIndent then - Include(HitInfo.HitPositions, hiOnItemLeft) - else - if Offset < lIndent + TextWidth then - Include(HitInfo.HitPositions, hiOnItemLabel) - else - Include(HitInfo.HitPositions, hiOnItemRight); - end; - taRightJustify: - begin - lIndent := Right - TextWidth; - if Offset < lIndent then - Include(HitInfo.HitPositions, hiOnItemLeft) - else - Include(HitInfo.HitPositions, hiOnItemLabel); - end; - else // taLeftJustify - if Offset < ImageOffset + TextWidth then - Include(HitInfo.HitPositions, hiOnItemLabel) - else - Include(HitInfo.HitPositions, hiOnItemRight); - end; - end; - end; - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DetermineHitPositionRTL(var HitInfo: THitInfo; Offset, Right: Integer; Alignment: TAlignment); - -// This method determines the hit position within a node with right-to-left orientation. - -var - MainColumnHit: Boolean; - Run: PVirtualNode; - Indent, - TextWidth, - ImageOffset: Integer; - -begin - MainColumnHit := HitInfo.HitColumn = FHeader.MainColumn; - - // If columns are not used or the main column is hit then the tree indentation must be considered too. - if MainColumnHit then - begin - if toFixedIndent in FOptions.FPaintOptions then - Dec(Right, FIndent) - else - begin - Run := HitInfo.HitNode; - while (Run.Parent <> FRoot) do - begin - Dec(Right, FIndent); - Run := Run.Parent; - end; - if toShowRoot in FOptions.FPaintOptions then - Dec(Right, FIndent); - end; - end; - - if Offset >= Right then - begin - // Position is to the right of calculated indentation which can only happen for the main column. - // Check whether it corresponds to a button/checkbox. - if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in HitInfo.HitNode.States) then - begin - // Position of button is interpreted very generously to avoid forcing the user - // to click exactly into the 9x9 pixels area. The entire node height and one full - // indentation level is accepted as button hit. - if Offset <= Right + Integer(FIndent) then - Include(HitInfo.HitPositions, hiOnItemButton); - if Offset <= Right + FPlusBM.Width then - Include(HitInfo.HitPositions, hiOnItemButtonExact); - end; - // no button hit so position is on indent - if HitInfo.HitPositions = [] then - Include(HitInfo.HitPositions, hiOnItemIndent); - end - else - begin - // The next hit positions can be: - // - on the check box - // - on the state image - // - on the normal image - // - to the left of the text area - // - on the label or - // - to the right of the text area - // (in this order). - - // In report mode no hit other than in the main column is possible. - if MainColumnHit or not (toReportMode in FOptions.FMiscOptions) then - begin - ImageOffset := Right - FMargin; - - // Check support is only available for the main column. - if MainColumnHit and (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and - (HitInfo.HitNode.CheckType <> ctNone) then - Dec(ImageOffset, FCheckImages.Width + FImagesMargin); - - if MainColumnHit and (Offset > ImageOffset) then - begin - HitInfo.HitPositions := [hiOnItem]; - if (HitInfo.HitNode.CheckType <> ctNone) then - Include(HitInfo.HitPositions, hiOnItemCheckBox); - end - else - begin - Dec(ImageOffset, GetImageSize(HitInfo.HitNode, ikState, HitInfo.HitColumn).cx); - if Offset > ImageOffset then - Include(HitInfo.HitPositions, hiOnStateIcon) - else - begin - Dec(ImageOffset, GetImageSize(HitInfo.HitNode, ikNormal, HitInfo.HitColumn).cx); - if Offset > ImageOffset then - Include(HitInfo.HitPositions, hiOnNormalIcon) - else - begin - // ImageOffset contains now the right border of the node label area. This is used to calculate the - // correct alignment in the column. - TextWidth := DoGetNodeWidth(HitInfo.HitNode, HitInfo.HitColumn); - - // Check if the text can be aligned at all. This is only possible if there is enough room - // in the remaining text rectangle. - if TextWidth > ImageOffset then - Include(HitInfo.HitPositions, hiOnItemLabel) - else - begin - // Consider bidi mode here. In RTL context does left alignment actually mean right alignment - // and vice versa. - ChangeBiDiModeAlignment(Alignment); - - case Alignment of - taCenter: - begin - Indent := (ImageOffset - TextWidth) div 2; - if Offset < Indent then - Include(HitInfo.HitPositions, hiOnItemLeft) - else - if Offset < Indent + TextWidth then - Include(HitInfo.HitPositions, hiOnItemLabel) - else - Include(HitInfo.HitPositions, hiOnItemRight); - end; - taRightJustify: - begin - Indent := ImageOffset - TextWidth; - if Offset < Indent then - Include(HitInfo.HitPositions, hiOnItemLeft) - else - Include(HitInfo.HitPositions, hiOnItemLabel); - end; - else // taLeftJustify - if Offset > TextWidth then - Include(HitInfo.HitPositions, hiOnItemRight) - else - Include(HitInfo.HitPositions, hiOnItemLabel); - end; - end; - end; - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DetermineLineImageAndSelectLevel(Node: PVirtualNode; var LineImage: TLineImage): Integer; - -// This method is used during paint cycles and initializes an array of line type IDs. These IDs are used to paint -// the tree lines in front of the given node. -// Additionally an initial count of selected parents is determined and returned which is used for specific painting. - -var - X: Integer; - Indent: Integer; - Run: PVirtualNode; - -begin - Result := 0; - if toShowRoot in FOptions.FPaintOptions then - X := 1 - else - X := 0; - Run := Node; - // Determine indentation level of top node. - while Run.Parent <> FRoot do - begin - Inc(X); - Run := Run.Parent; - // Count selected nodes (FRoot is never selected). - if vsSelected in Run.States then - Inc(Result); - end; - - // Set initial size of line index array, this will automatically initialized all entries to ltNone. - SetLength(LineImage, X); - Indent := X - 1; - - // Only use lines if requested. - if (toShowTreeLines in FOptions.FPaintOptions) and - (not (toHideTreeLinesIfThemed in FOptions.FPaintOptions) or not (tsUseThemes in FStates)) then - begin - if toChildrenAbove in FOptions.FPaintOptions then - begin - Dec(X); - if not HasVisiblePreviousSibling(Node) then - begin - if (Node.Parent <> FRoot) or HasVisibleNextSibling(Node) then - LineImage[X] := ltBottomRight - else - LineImage[X] := ltRight; - end - else - if (Node.Parent = FRoot) and (not HasVisibleNextSibling(Node)) then - LineImage[X] := ltTopRight - else - LineImage[X] := ltTopDownRight; - - // Now go up to the root to determine the rest. - Run := Node.Parent; - while Run <> FRoot do - begin - Dec(X); - if HasVisiblePreviousSibling(Run) then - LineImage[X] := ltTopDown - else - LineImage[X] := ltNone; - - Run := Run.Parent; - end; - end - else - begin - // Start over parent traversal if necessary. - Run := Node; - - if Run.Parent <> FRoot then - begin - // The very last image (the one immediately before the item label) is different. - if HasVisibleNextSibling(Run) then - LineImage[X - 1] := ltTopDownRight - else - LineImage[X - 1] := ltTopRight; - Run := Run.Parent; - - // Now go up all parents. - repeat - if Run.Parent = FRoot then - Break; - Dec(X); - if HasVisibleNextSibling(Run) then - LineImage[X - 1] := ltTopDown - else - LineImage[X - 1] := ltNone; - Run := Run.Parent; - until False; - end; - - // Prepare root level. Run points at this stage to a top level node. - if (toShowRoot in FOptions.FPaintOptions) and ((toShowTreeLines in FOptions.FPaintOptions) and - (not (toHideTreeLinesIfThemed in FOptions.FPaintOptions) or not (tsUseThemes in FStates))) then - begin - // Is the top node a root node? - if Run = Node then - begin - // First child gets the bottom-right bitmap if it isn't also the only child. - if IsFirstVisibleChild(FRoot, Run) then - // Is it the only child? - if IsLastVisibleChild(FRoot, Run) then - LineImage[0] := ltRight - else - LineImage[0] := ltBottomRight - else - // real last child - if IsLastVisibleChild(FRoot, Run) then - LineImage[0] := ltTopRight - else - LineImage[0] := ltTopDownRight; - end - else - begin - // No, top node is not a top level node. So we need different painting. - if HasVisibleNextSibling(Run) then - LineImage[0] := ltTopDown - else - LineImage[0] := ltNone; - end; - end; - end; - end; - - if (tsUseExplorerTheme in FStates) and HasChildren[Node] and (Indent >= 0) - and not ((vsAllChildrenHidden in Node.States) and (toAutoHideButtons in TreeOptions.FAutoOptions)) then - LineImage[Indent] := ltNone; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DetermineNextCheckState(CheckType: TCheckType; CheckState: TCheckState): TCheckState; - -// Determines the next check state in case the user click the check image or pressed the space key. - -begin - case CheckType of - ctTriStateCheckBox, - ctButton, - ctCheckBox: - begin - Result := CheckState.GetToggled(); - end;//ctCheckbox - ctRadioButton: - Result := csCheckedNormal; - else - Result := csMixedNormal; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DetermineScrollDirections(X, Y: Integer): TScrollDirections; - -// Determines which direction the client area must be scrolled depending on the given position. - -begin - Result:= []; - - if CanAutoScroll then - begin - // Calculation for wheel panning/scrolling is a bit different to normal auto scroll. - if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then - begin - if (X - FLastClickPos.X) < -8 then - Include(Result, sdLeft); - if (X - FLastClickPos.X) > 8 then - Include(Result, sdRight); - - if (Y - FLastClickPos.Y) < -8 then - Include(Result, sdUp); - if (Y - FLastClickPos.Y) > 8 then - Include(Result, sdDown); - end - else - begin - if (X < Integer(FDefaultNodeHeight)) and (FEffectiveOffsetX <> 0) then - Include(Result, sdLeft); - if (ClientWidth + FEffectiveOffsetX < Integer(FRangeX)) and (X > ClientWidth - Integer(FDefaultNodeHeight)) then - Include(Result, sdRight); - - if (Y < Integer(FDefaultNodeHeight)) and (FOffsetY <> 0) then - Include(Result, sdUp); - if (ClientHeight - FOffsetY < Integer(FRangeY)) and (Y > ClientHeight - Integer(FDefaultNodeHeight)) then - Include(Result, sdDown); - - // Since scrolling during dragging is not handled via the timer we do a check here whether the auto - // scroll timeout already has elapsed or not. - if (Result <> []) and - ((Assigned(FDragManager) and DragManager.IsDropTarget) or - (FindDragTarget(Point(X, Y), False) = Self)) then - begin - if FDragScrollStart = 0 then - FDragScrollStart := timeGetTime; - // Reset any scroll direction to avoid scroll in the case the user is dragging and the auto scroll time has not - // yet elapsed. - if ((Int64(timeGetTime) - FDragScrollStart) < FAutoScrollDelay) then - Result := []; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoAdvancedHeaderDraw(var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements); - -begin - if Assigned(FOnAdvancedHeaderDraw) then - FOnAdvancedHeaderDraw(FHeader, PaintInfo, Elements); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoAfterCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); - -begin - if Assigned(FOnAfterCellPaint) then - FOnAfterCellPaint(Self, Canvas, Node, Column, CellRect); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoAfterItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); - -begin - if Assigned(FOnAfterItemErase) then - FOnAfterItemErase(Self, Canvas, Node, ItemRect); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoAfterItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); - -begin - if Assigned(FOnAfterItemPaint) then - FOnAfterItemPaint(Self, Canvas, Node, ItemRect); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoAfterPaint(Canvas: TCanvas); - -begin - if Assigned(FOnAfterPaint) then - FOnAfterPaint(Self, Canvas); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoAutoScroll(X, Y: Integer); - -begin - FScrollDirections := DetermineScrollDirections(X, Y); - - if FStates * [tsWheelPanning, tsWheelScrolling] = [] then - begin - if FScrollDirections = [] then - begin - if ((FStates * [tsScrollPending, tsScrolling]) <> []) then - begin - StopTimer(ScrollTimer); - DoStateChange([], [tsScrollPending, tsScrolling]); - end; - end - else - begin - // start auto scroll if not yet done - if (FStates * [tsScrollPending, tsScrolling]) = [] then - begin - DoStateChange([tsScrollPending]); - SetTimer(Handle, ScrollTimer, FAutoScrollDelay, nil); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoBeforeDrag(Node: PVirtualNode; Column: TColumnIndex): Boolean; - -begin - Result := False; - if Assigned(FOnDragAllowed) then - FOnDragAllowed(Self, Node, Column, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoBeforeCellPaint(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); - -var - UpdateRect: TRect; - -begin - if Assigned(FOnBeforeCellPaint) then - begin - if CellPaintMode = cpmGetContentMargin then - begin - // Prevent drawing if we are only about to get the margin. As this also clears the update rect we need to save it. - GetUpdateRect(Handle, UpdateRect, False); - SetUpdateState(True); - end; - - Canvas.Font := Self.Font; // Fixes issue #298 - FOnBeforeCellPaint(Self, Canvas, Node, Column, CellPaintMode, CellRect, ContentRect); - - if CellPaintMode = cpmGetContentMargin then - SetUpdateState(False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoBeforeItemErase(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect; var Color: TColor; - var EraseAction: TItemEraseAction); - -begin - if Assigned(FOnBeforeItemErase) then - FOnBeforeItemErase(Self, Canvas, Node, ItemRect, Color, EraseAction); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoBeforeItemPaint(Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect): Boolean; - -begin - // By default custom draw will not be used, so the tree handles drawing the node. - Result := False; - if Assigned(FOnBeforeItemPaint) then - FOnBeforeItemPaint(Self, Canvas, Node, ItemRect, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoBeforePaint(Canvas: TCanvas); - -begin - if Assigned(FOnBeforePaint) then - FOnBeforePaint(Self, Canvas); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoCancelEdit: Boolean; - -// Called when the current edit action or a pending edit must be cancelled. - -begin - StopTimer(EditTimer); - DoStateChange([], [tsEditPending]); - Result := (tsEditing in FStates) and FEditLink.CancelEdit; - if Result then - begin - DoStateChange([], [tsEditing]); - if Assigned(FOnEditCancelled) then - FOnEditCancelled(Self, FEditColumn); - if not (csDestroying in ComponentState) then - FEditLink := nil; - end; - SetFocus(); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoCanEdit(Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); - -begin - if Assigned(FOnEditing) then - FOnEditing(Self, Node, Column, Allowed); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoCanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex; - var Allowed: Boolean); - -begin - if Assigned(FOnCanSplitterResizeNode) then - FOnCanSplitterResizeNode(Self, P, Node, Column, Allowed); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoChange(Node: PVirtualNode); - -begin - StopTimer(ChangeTimer); - if Assigned(FOnChange) then - FOnChange(Self, Node); - - // This is a good place to reset the cached node. This is the same as the node passed in here. - // This is necessary to allow descendants to override this method and get the node then. - DoStateChange([], [tsChangePending]); - FLastChangedNode := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoCheckClick(Node: PVirtualNode; NewCheckState: TCheckState); - -begin - if ChangeCheckState(Node, NewCheckState) then - begin - DoChecked(Node); - if SyncCheckstateWithSelection[Node] then - begin - // selection should follow check state - if (NewCheckState = csCheckedNormal) then - Selected[node] := true - else - Selected[node] := false; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoChecked(Node: PVirtualNode); - -begin - if Assigned(FOnChecked) then - FOnChecked(Self, Node); - if Assigned(FAccessibleItem) then - NotifyWinEvent(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoChecking(Node: PVirtualNode; var NewCheckState: TCheckState): Boolean; - -// Determines if a node is allowed to change its check state to NewCheckState. - -begin - if (toReadOnly in FOptions.FMiscOptions) or (vsDisabled in Node.States) then - Result := False - else - begin - Result := True; - if Assigned(FOnChecking) then - FOnChecking(Self, Node, NewCheckState, Result); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoCollapsed(Node: PVirtualNode); -var - lFirstSelected: PVirtualNode; - lParent: PVirtualNode; -begin - if Assigned(FOnCollapsed) then - FOnCollapsed(Self, Node); - - if Assigned(FAccessibleItem) then - NotifyWinEvent(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); - - if (toAlwaysSelectNode in TreeOptions.SelectionOptions) then - begin - // Select the next visible parent if the currently selected node gets invisible due to a collapse - // This makes the VT behave more like the Win32 custom TreeView control - // This makes only sense no no multi selection is allowed and if there is a selected node at all - lFirstSelected := GetFirstSelected(); - if Assigned(lFirstSelected) and not FullyVisible[lFirstSelected] then - begin - lParent := GetVisibleParent(lFirstSelected); - Selected[lFirstSelected] := False; - Selected[lParent] := True; - end;//if - //if there is (still) no selected node, then use FNextNodeToSelect to select one - if SelectedCount = 0 then - EnsureNodeSelected(); - end;//if -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoCollapsing(Node: PVirtualNode): Boolean; - -begin - Result := True; - if Assigned(FOnCollapsing) then - FOnCollapsing(Self, Node, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoColumnClick(Column: TColumnIndex; Shift: TShiftState); - -begin - if Assigned(FOnColumnClick) then - FOnColumnClick(Self, Column, Shift); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoColumnDblClick(Column: TColumnIndex; Shift: TShiftState); - -begin - if Assigned(FOnColumnDblClick) then - FOnColumnDblClick(Self, Column, Shift); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoColumnResize(Column: TColumnIndex); - -var - R: TRect; - Run: PVirtualNode; - -begin - if not (csLoading in ComponentState) and HandleAllocated then -begin - // Reset all vsHeightMeasured flags if we are in multiline mode. - Run := GetFirstInitialized; - while Assigned(Run) do - begin - if vsMultiline in Run.States then - Exclude(Run.States, vsHeightMeasured); - Run := GetNextInitialized(Run); - end; - - UpdateHorizontalScrollBar(True); - if Column > NoColumn then - begin - // Invalidate client area from the current column all to the right (or left in RTL mode). - R := ClientRect; - if not (toAutoSpanColumns in FOptions.FAutoOptions) then - if UseRightToLeftAlignment then - R.Right := FHeader.Columns[Column].Left + FHeader.Columns[Column].Width + ComputeRTLOffset - else - R.Left := FHeader.Columns[Column].Left; - InvalidateRect(Handle, @R, False); - FHeader.Invalidate(FHeader.Columns[Column], True); - end; - if [hsColumnWidthTracking, hsResizing] * FHeader.States = [hsColumnWidthTracking] then - UpdateWindow(Handle); - - if not (tsUpdating in FStates) then - UpdateDesigner; // design time only - - if Assigned(FOnColumnResize) and not (hsResizing in FHeader.States) then - FOnColumnResize(FHeader, Column); - - // If the tree is currently in edit state then notify edit link. - if tsEditing in FStates then - UpdateEditBounds; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoColumnVisibilityChanged(const Column: TColumnIndex; Visible: Boolean); - // Triggers the OnColumnVisibilityChanged event. -begin - if Assigned(OnColumnVisibilityChanged) then - OnColumnVisibilityChanged(Self, Column, Visible); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoCompare(Node1, Node2: PVirtualNode; Column: TColumnIndex): Integer; - -begin - Result := 0; - if Assigned(FOnCompareNodes) then - FOnCompareNodes(Self, Node1, Node2, Column, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoCreateDataObject: IDataObject; - -begin - Result := nil; - if Assigned(FOnCreateDataObject) then - FOnCreateDataObject(Self, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoCreateDragManager: IVTDragManager; - -begin - Result := nil; - if Assigned(FOnCreateDragManager) then - FOnCreateDragManager(Self, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; - -begin - Result := nil; - if Assigned(FOnCreateEditor) then - FOnCreateEditor(Self, Node, Column, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoDragging(P: TPoint); - -// Initiates finally the drag'n drop operation and returns after DD is finished. - - //--------------- local function -------------------------------------------- - - function GetDragOperations: Integer; - - begin - if FDragOperations = [] then - Result := DROPEFFECT_COPY or DROPEFFECT_MOVE or DROPEFFECT_LINK - else - begin - Result := 0; - if doCopy in FDragOperations then - Result := Result or DROPEFFECT_COPY; - if doLink in FDragOperations then - Result := Result or DROPEFFECT_LINK; - if doMove in FDragOperations then - Result := Result or DROPEFFECT_MOVE; - end; - end; - - //--------------- end local function ---------------------------------------- - -var - AllowedEffects: Integer; - DragObject: TDragObject; - - DataObject: IDataObject; - -begin - DataObject := nil; - // Dragging is dragging, nothing else. - DoCancelEdit; - - if Assigned(FCurrentHotNode) then - begin - InvalidateNode(FCurrentHotNode); - FCurrentHotNode := nil; - end; - // Select the focused node if not already done. - if Assigned(FFocusedNode) and not (vsSelected in FFocusedNode.States) then - begin - InternalAddToSelection(FFocusedNode, False); - InvalidateNode(FFocusedNode); - end; - - UpdateWindow(Handle); - - // Keep a list of all currently selected nodes as this list might change, - // but we have probably to delete currently selected nodes. - FDragSelection := GetSortedSelection(True); - try - DoStateChange([tsOLEDragging], [tsOLEDragPending, tsClearPending]); - - // An application might create a drag object like used during VCL dd. This is not required for OLE dd but - // required as parameter. - DragObject := nil; - DoStartDrag(DragObject); - DragObject.Free; - - DataObject := DragManager.DataObject; - PrepareDragImage(P, DataObject); - - FLastDropMode := dmOnNode; - // Don't forget to initialize the result. It might never be touched. - FLastDragEffect := DROPEFFECT_NONE; - AllowedEffects := GetDragOperations; - try - DragAndDrop(AllowedEffects, DataObject, FLastDragEffect); - DragManager.ForceDragLeave; - finally - GetCursorPos(P); - P := ScreenToClient(P); - DoEndDrag(Self, P.X, P.Y); - - FDragImage.EndDrag; - - // Finish the operation. - if (FLastDragEffect = DROPEFFECT_MOVE) and (toAutoDeleteMovedNodes in TreeOptions.AutoOptions) then - begin - // The operation was a move so delete the previously selected nodes. - DeleteSelectedNodes; - end; - - DoStateChange([], [tsOLEDragging]); - end; - finally - FDragSelection := nil; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoDragExpand; - -var - SourceTree: TBaseVirtualTree; - -begin - StopTimer(ExpandTimer); - if Assigned(FDropTargetNode) and (vsHasChildren in FDropTargetNode.States) and - not (vsExpanded in FDropTargetNode.States) then - begin - if Assigned(FDragManager) then - SourceTree := DragManager.DragSource - else - SourceTree := nil; - - if not DragManager.DropTargetHelperSupported and Assigned(SourceTree) then - SourceTree.FDragImage.HideDragImage; - ToggleNode(FDropTargetNode); - UpdateWindow(Handle); - if not DragManager.DropTargetHelperSupported and Assigned(SourceTree) then - SourceTree.FDragImage.ShowDragImage; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoDragOver(Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; - var Effect: Integer): Boolean; - -begin - Result := False; - if Assigned(FOnDragOver) then - FOnDragOver(Self, Source, Shift, State, Pt, Mode, Effect, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoDragDrop(Source: TObject; const DataObject: IDataObject; const Formats: TFormatArray; - Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); - -begin - if Assigned(FOnDragDrop) then - FOnDragDrop(Self, Source, DataObject, Formats, Shift, Pt, Effect, Mode); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoBeforeDrawLineImage(Node: PVirtualNode; Level: Integer; var XPos: Integer); - -begin - if Assigned(FOnBeforeDrawLineImage) then - FOnBeforeDrawLineImage(Self, Node, Level, XPos); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoEdit; - -begin - Application.CancelHint; - StopTimer(ScrollTimer); - StopTimer(EditTimer); - DoStateChange([], [tsEditPending]); - if Assigned(FFocusedNode) and not (vsDisabled in FFocusedNode.States) and - not (toReadOnly in FOptions.FMiscOptions) and (FEditLink = nil) then - begin - FEditLink := DoCreateEditor(FFocusedNode, FEditColumn); - if Assigned(FEditLink) then - begin - DoStateChange([tsEditing], [tsDrawSelecting, tsDrawSelPending, tsToggleFocusedSelection, tsOLEDragPending, - tsOLEDragging, tsClearPending, tsDrawSelPending, tsScrollPending, tsScrolling]); - ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions, - not (toDisableAutoscrollOnEdit in FOptions.AutoOptions)); - if FEditLink.PrepareEdit(Self, FFocusedNode, FEditColumn) then - begin - UpdateEditBounds; - // Node needs repaint because the selection rectangle and static text must disappear. - InvalidateNode(FFocusedNode); - if not FEditLink.BeginEdit then - DoStateChange([], [tsEditing]); - end - else - DoStateChange([], [tsEditing]); - if not (tsEditing in FStates) then - FEditLink := nil; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoEndDrag(Target: TObject; X, Y: Integer); - -// Does some housekeeping for VCL drag'n drop; - -begin - inherited; - - DragFinished; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoEndEdit: Boolean; - -// Called to finish a current edit action or stop the edit timer if an edit operation is pending. -// Returns True if editing was successfully ended or the control was not in edit mode -// Returns False if the control could not leave the edit mode e.g. due to an invalid value that was entered. - -begin - StopTimer(EditTimer); - Result := (tsEditing in FStates) and FEditLink.EndEdit; - if Result then - begin - DoStateChange([], [tsEditing]); - FEditLink := nil; - if Assigned(FOnEdited) then - FOnEdited(Self, FFocusedNode, FEditColumn); - end; - DoStateChange([], [tsEditPending]); - SetFocus(); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoEndOperation(OperationKind: TVTOperationKind); - -begin - if Assigned(FOnEndOperation) then - FOnEndOperation(Self, OperationKind); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoEnter(); -begin - inherited; - EnsureNodeSelected(); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoExpanded(Node: PVirtualNode); - -begin - if Assigned(FOnExpanded) then - FOnExpanded(Self, Node); - - if Assigned(FAccessibleItem) then - NotifyWinEvent(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoExpanding(Node: PVirtualNode): Boolean; - -begin - Result := True; - if Assigned(FOnExpanding) then - FOnExpanding(Self, Node, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoFocusChange(Node: PVirtualNode; Column: TColumnIndex); - -begin - if Assigned(FOnFocusChanged) then - FOnFocusChanged(Self, Node, Column); - - if Assigned(FAccessibleItem) then - begin - NotifyWinEvent(EVENT_OBJECT_LOCATIONCHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); - NotifyWinEvent(EVENT_OBJECT_NAMECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); - NotifyWinEvent(EVENT_OBJECT_VALUECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); - NotifyWinEvent(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); - NotifyWinEvent(EVENT_OBJECT_SELECTION, Handle, OBJID_CLIENT, CHILDID_SELF); - NotifyWinEvent(EVENT_OBJECT_FOCUS, Handle, OBJID_CLIENT, CHILDID_SELF); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoFocusChanging(OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex): Boolean; - -begin - Result := (OldColumn = NewColumn) or FHeader.AllowFocus(NewColumn); - if Assigned(FOnFocusChanging) then - FOnFocusChanging(Self, OldNode, NewNode, OldColumn, NewColumn, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoFocusNode(Node: PVirtualNode; Ask: Boolean); - -begin - if not (tsEditing in FStates) or EndEditNode then - begin - if Node = FRoot then - Node := nil; - if (FFocusedNode <> Node) and (not Ask or DoFocusChanging(FFocusedNode, Node, FFocusedColumn, FFocusedColumn)) then - begin - if Assigned(FFocusedNode) then - begin - // Do automatic collapsing of last focused node if enabled. This is however only done if - // old and new focused node have a common parent node. - if (toAutoExpand in FOptions.FAutoOptions) and Assigned(Node) and (Node.Parent = FFocusedNode.Parent) and - (vsExpanded in FFocusedNode.States) then - ToggleNode(FFocusedNode) - else - InvalidateNode(FFocusedNode); - end; - FFocusedNode := Node; - end; - - // Have to scroll the node into view, even it is the same node as before. - if Assigned(FFocusedNode) then - begin - // Make sure a valid column is set if columns are used and no column has currently the focus. - if FHeader.UseColumns and (not FHeader.FColumns.IsValidColumn(FFocusedColumn)) then - FFocusedColumn := FHeader.MainColumn; - // Do automatic expansion of the newly focused node if enabled. - if (toAutoExpand in FOptions.FAutoOptions) and not (vsExpanded in FFocusedNode.States) then - ToggleNode(FFocusedNode); - InvalidateNode(FFocusedNode); - if (FUpdateCount = 0) and not (toDisableAutoscrollOnFocus in FOptions.FAutoOptions) then - ScrollIntoView(FFocusedNode, (toCenterScrollIntoView in FOptions.SelectionOptions) and - (MouseButtonDown * FStates = []), not (toFullRowSelect in FOptions.SelectionOptions) ); - end; - - // Reset range anchor if necessary. - if FSelectionCount = 0 then - ResetRangeAnchor; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoFreeNode(Node: PVirtualNode); - -var - IntfData: IInterface; -begin - // Prevent invalid references - if Node = FLastChangedNode then - FLastChangedNode := nil; - if Node = FCurrentHotNode then - FCurrentHotNode := nil; - if Node = FDropTargetNode then - FDropTargetNode := nil; - if Node = FLastStructureChangeNode then - FLastStructureChangeNode := nil; - if Node = FFocusedNode then - FFocusedNode := nil; - if Node = FNextNodeToSelect then - UpdateNextNodeToSelect(Node); - if Node = FLastHitInfo.HitNode then - FLastHitInfo.HitNode := nil; - // fire event - if Assigned(FOnFreeNode) and ([vsInitialized, vsOnFreeNodeCallRequired] * Node.States <> []) then - FOnFreeNode(Self, Node); - - if vsReleaseCallOnUserDataRequired in Node.States then - begin - // Data may have been set to nil, in which case we can't call _Release on it - IntfData := GetInterfaceFromNodeData(Node); - if Assigned(IntfData) then - IntfData._Release(); - end; - - FreeMem(Node); - if Self.UpdateCount = 0 then - EnsureNodeSelected(); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; - CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; - -// Determines the margins of the content rectangle caused by DoBeforeCellPaint. -// Note that shrinking the content rectangle results in positive margins whereas enlarging the content rectangle results -// in negative margins. - -var - CellRect, - ContentRect: TRect; - -begin - Result := Point(0, 0); - - if Assigned(FOnBeforeCellPaint) then // Otherwise DoBeforeCellPaint has no effect. - begin - if Canvas = nil then - Canvas := Self.Canvas; - - // Determine then node's cell rectangle and content rectangle before calling DoBeforeCellPaint. - CellRect := GetDisplayRect(Node, Column, True); - ContentRect := CellRect; - DoBeforeCellPaint(Canvas, Node, Column, cpmGetContentMargin, CellRect, ContentRect); - - // Calculate the changes caused by DoBeforeCellPaint. - case CellContentMarginType of - ccmtAllSides: - // Calculate the width difference and high difference. - Result := Point((CellRect.Right - CellRect.Left) - (ContentRect.Right - ContentRect.Left), - (CellRect.Bottom - CellRect.Top) - (ContentRect.Bottom - ContentRect.Top)); - ccmtTopLeftOnly: - // Calculate the left margin and top margin only. - Result := Point(ContentRect.Left - CellRect.Left, ContentRect.Top - CellRect.Top); - ccmtBottomRightOnly: - // Calculate the right margin and bottom margin only. - Result := Point(CellRect.Right - ContentRect.Right, CellRect.Bottom - ContentRect.Bottom); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoGetCursor(var Cursor: TCursor); - -begin - if Assigned(FOnGetCursor) then - FOnGetCursor(Self, Cursor); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoGetHeaderCursor(var Cursor: HCURSOR); - -begin - if Assigned(FOnGetHeaderCursor) then - FOnGetHeaderCursor(FHeader, Cursor); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoGetImageIndex(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; - var Ghosted: Boolean; var Index: TImageIndex): TCustomImageList; - -// Queries the application/descendant about certain image properties for a node. -// Returns a custom image list if given by the callee, otherwise nil. -const - cTVTImageKind2String: Array [TVTImageKind] of string = ('ikNormal', 'ikSelected', 'ikState', 'ikOverlay'); -begin - if Kind = ikState then - Result := Self.StateImages - else - Result := Self.Images; - // First try the enhanced event to allow for custom image lists. - if Assigned(FOnGetImageEx) then - FOnGetImageEx(Self, Node, Kind, Column, Ghosted, Index, Result) - else if Assigned(FOnGetImage) then - FOnGetImage(Self, Node, Kind, Column, Ghosted, Index); - - Assert((Index < 0) or Assigned(Result), 'An image index was supplied for TVTImageKind.' + cTVTImageKind2String[Kind] + ' but no image list was supplied.'); - if not Assigned(Result) then - Index := -1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoGetImageText(Node: PVirtualNode; Kind: TVTImageKind; - Column: TColumnIndex; var ImageText: string); - -// Queries the application/descendant about alternative image text for a node. - -begin - if Assigned(FOnGetImageText) then - FOnGetImageText(Self, Node, Kind, Column, ImageText); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoGetLineStyle(var Bits: Pointer); - -begin - if Assigned(FOnGetLineStyle) then - FOnGetLineStyle(Self, Bits); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; - var LineBreakStyle: TVTTooltipLineBreakStyle): string; - -begin - Result := Hint; - LineBreakStyle := hlbDefault; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex; - var LineBreakStyle: TVTTooltipLineBreakStyle): string; - -begin - Result := Hint; - LineBreakStyle := hlbDefault; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; - -// Returns the pixel width of extra space occupied by node contents (for example, static text). - -begin - Result := 0; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; - -// Returns the pixel width of a node. - -begin - Result := 0; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoGetPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint): TPopupMenu; - -// Queries the application whether there is a node specific popup menu. - -var - Run: PVirtualNode; - AskParent: Boolean; - -begin - Result := nil; - if Assigned(FOnGetPopupMenu) then - begin - Run := Node; - - if Assigned(Run) then - begin - AskParent := True; - repeat - FOnGetPopupMenu(Self, Run, Column, Position, AskParent, Result); - Run := Run.Parent; - until (Run = FRoot) or Assigned(Result) or not AskParent; - end - else - FOnGetPopupMenu(Self, nil, NoColumn, Position, AskParent, Result); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoGetUserClipboardFormats(var Formats: TFormatEtcArray); - -begin - if Assigned(FOnGetUserClipboardFormats) then - FOnGetUserClipboardFormats(Self, Formats); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderAddPopupItem(const Column: TColumnIndex; var Cmd: TAddPopupItemType); - -begin - if Assigned(FOnHeaderAddPopupItem) then - FOnHeaderAddPopupItem(Self, Column, Cmd); - -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderClick(const HitInfo: TVTHeaderHitInfo); - -begin - if Assigned(FOnHeaderClick) then - FOnHeaderClick(FHeader, HitInfo); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderDblClick(const HitInfo: TVTHeaderHitInfo); - -begin - if Assigned(FOnHeaderDblClick) then - FOnHeaderDblClick(FHeader, HitInfo); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderDragged(Column: TColumnIndex; OldPosition: TColumnPosition); - -begin - if Assigned(FOnHeaderDragged) then - FOnHeaderDragged(FHeader, Column, OldPosition); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderDraggedOut(Column: TColumnIndex; DropPosition: TPoint); - -begin - if Assigned(FOnHeaderDraggedOut) then - FOnHeaderDraggedOut(FHeader, Column, DropPosition); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoHeaderDragging(Column: TColumnIndex): Boolean; - -begin - Result := True; - if Assigned(FOnHeaderDragging) then - FOnHeaderDragging(FHeader, Column, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderDraw(Canvas: TCanvas; Column: TVirtualTreeColumn; R: TRect; Hover, Pressed: Boolean; - DropMark: TVTDropMarkMode); - -begin - if Assigned(FOnHeaderDraw) then - FOnHeaderDraw(FHeader, Canvas, Column, R, Hover, Pressed, DropMark); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderDrawQueryElements(var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); - -begin - if Assigned(FOnHeaderDrawQueryElements) then - FOnHeaderDrawQueryElements(FHeader, PaintInfo, Elements); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - -begin - if Assigned(FOnHeaderMouseDown) then - FOnHeaderMouseDown(FHeader, Button, Shift, X, Y); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderMouseMove(Shift: TShiftState; X, Y: Integer); - -begin - if Assigned(FOnHeaderMouseMove) then - FOnHeaderMouseMove(FHeader, Shift, X, Y); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - -begin - if Assigned(FOnHeaderMouseUp) then - FOnHeaderMouseUp(FHeader, Button, Shift, X, Y); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHotChange(Old, New: PVirtualNode); - -begin - if Assigned(FOnHotChange) then - FOnHotChange(Self, Old, New); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoIncrementalSearch(Node: PVirtualNode; const Text: string): Integer; - -begin - Result := 0; - if Assigned(FOnIncrementalSearch) then - FOnIncrementalSearch(Self, Node, Text, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoInitChildren(Node: PVirtualNode; var ChildCount: Cardinal): Boolean; -/// The function calls the OnInitChildren and returns True if the event was called; it returns False if the caller can expect that no changes have been made to ChildCount -begin - if Assigned(FOnInitChildren) then - begin - FOnInitChildren(Self, Node, ChildCount); - Result := True; - end - else - Result := False; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoInitNode(Parent, Node: PVirtualNode; var InitStates: TVirtualNodeInitStates); - -begin - if Assigned(FOnInitNode) then - FOnInitNode(Self, Parent, Node, InitStates); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoKeyAction(var CharCode: Word; var Shift: TShiftState): Boolean; - -begin - Result := True; - if Assigned(FOnKeyAction) then - FOnKeyAction(Self, CharCode, Shift, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoLoadUserData(Node: PVirtualNode; Stream: TStream); - -begin - if Assigned(FOnLoadNode) then - if Node = FRoot then - FOnLoadNode(Self, nil, Stream) - else - FOnLoadNode(Self, Node, Stream); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoMeasureItem(TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer); - -begin - if not (vsInitialized in Node.States) then - InitNode(Node); - if Assigned(FOnMeasureItem) then - FOnMeasureItem(Self, TargetCanvas, Node, NodeHeight); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoMouseEnter(); - -begin - if Assigned(FOnMouseEnter) then - FOnMouseEnter(Self); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoMouseLeave; - -begin - if Assigned(FOnMouseLeave) then - FOnMouseLeave(Self); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoNodeCopied(Node: PVirtualNode); - -begin - if Assigned(FOnNodeCopied) then - FOnNodeCopied(Self, Node); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoNodeCopying(Node, NewParent: PVirtualNode): Boolean; - -begin - Result := True; - if Assigned(FOnNodeCopying) then - FOnNodeCopying(Self, Node, NewParent, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoNodeClick(const HitInfo: THitInfo); - -begin - if Assigned(FOnNodeClick) then - FOnNodeClick(Self, HitInfo); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoNodeDblClick(const HitInfo: THitInfo); - -begin - if Assigned(FOnNodeDblClick) then - FOnNodeDblClick(Self, HitInfo); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoNodeHeightDblClickResize(Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; - P: TPoint): Boolean; - -begin - Result := True; - if Assigned(FOnNodeHeightDblClickResize) then - FOnNodeHeightDblClickResize(Self, Node, Column, Shift, P, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoNodeHeightTracking(Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; - var TrackPoint: TPoint; P: TPoint): Boolean; - -begin - Result := True; - if Assigned(FOnNodeHeightTracking) then - FOnNodeHeightTracking(Self, Node, Column, Shift, TrackPoint, P, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoNodeMoved(Node: PVirtualNode); - -begin - if Assigned(FOnNodeMoved) then - FOnNodeMoved(Self, Node); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoNodeMoving(Node, NewParent: PVirtualNode): Boolean; - -begin - Result := True; - if Assigned(FOnNodeMoving) then - FOnNodeMoving(Self, Node, NewParent, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoPaintBackground(Canvas: TCanvas; R: TRect): Boolean; - -begin - Result := False; - if Assigned(FOnPaintBackground) then - FOnPaintBackground(Self, Canvas, R, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoPaintDropMark(Canvas: TCanvas; Node: PVirtualNode; R: TRect); - -// draws the drop mark into the given rectangle -// Note: Changed properties of the given canvas should be reset to their previous values. - -var - SaveBrushColor: TColor; - SavePenStyle: TPenStyle; - -begin - if FLastDropMode in [dmAbove, dmBelow] then - with Canvas do - begin - SavePenStyle := Pen.Style; - Pen.Style := psClear; - SaveBrushColor := Brush.Color; - Brush.Color := FColors.DropMarkColor; - - if FLastDropMode = dmAbove then - begin - Polygon([Point(R.Left + 2, R.Top), - Point(R.Right - 2, R.Top), - Point(R.Right - 2, R.Top + 6), - Point(R.Right - 6, R.Top + 2), - Point(R.Left + 6 , R.Top + 2), - Point(R.Left + 2, R.Top + 6) - ]); - end - else - Polygon([Point(R.Left + 2, R.Bottom - 1), - Point(R.Right - 2, R.Bottom - 1), - Point(R.Right - 2, R.Bottom - 8), - Point(R.Right - 7, R.Bottom - 3), - Point(R.Left + 7 , R.Bottom - 3), - Point(R.Left + 2, R.Bottom - 8) - ]); - Brush.Color := SaveBrushColor; - Pen.Style := SavePenStyle; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoPaintNode(var PaintInfo: TVTPaintInfo); - -begin -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Position: TPoint); - -// Support for node dependent popup menus. - -var - Menu: TPopupMenu; - -begin - Menu := DoGetPopupMenu(Node, Column, Position); - - if Assigned(Menu) then - begin - DoStateChange([tsPopupMenuShown]); - StopTimer(EditTimer); - Menu.PopupComponent := Self; - with ClientToScreen(Position) do - Menu.Popup(X, Y); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoRemoveFromSelection(Node: PVirtualNode); - -begin - if Assigned(FOnRemoveFromSelection) then - FOnRemoveFromSelection(Self, Node); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoRenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; - ForClipboard: Boolean): HRESULT; - -begin - Result := E_FAIL; - if Assigned(FOnRenderOLEData) then - FOnRenderOLEData(Self, FormatEtcIn, Medium, ForClipboard, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoReset(Node: PVirtualNode); - -begin - if Assigned(FOnResetNode) then - FOnResetNode(Self, Node); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoSaveUserData(Node: PVirtualNode; Stream: TStream); - -begin - if Assigned(FOnSaveNode) then - if Node = FRoot then - FOnSaveNode(Self, nil, Stream) - else - FOnSaveNode(Self, Node, Stream); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoScroll(DeltaX, DeltaY: Integer); - -begin - if Assigned(FOnScroll) then - FOnScroll(Self, DeltaX, DeltaY); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOptions; ClipRect: PRect = nil): Boolean; - -// Actual offset setter used to scroll the client area, update scroll bars and invalidating the header (all optional). -// Returns True if the offset really changed otherwise False is returned. - -var - DeltaX: Integer; - DeltaY: Integer; - DWPStructure: HDWP; - I: Integer; - P: TPoint; - R: TRect; - -begin - // Range check, order is important here. - if Value.X < (ClientWidth - Integer(FRangeX)) then - Value.X := ClientWidth - Integer(FRangeX); - if Value.X > 0 then - Value.X := 0; - DeltaX := Value.X - FOffsetX; - if UseRightToLeftAlignment then - DeltaX := -DeltaX; - if Value.Y < (ClientHeight - Integer(FRangeY)) then - Value.Y := ClientHeight - Integer(FRangeY); - if Value.Y > 0 then - Value.Y := 0; - DeltaY := Value.Y - FOffsetY; - - Result := (DeltaX <> 0) or (DeltaY <> 0); - if Result then - begin - FOffsetX := Value.X; - FOffsetY := Value.Y; - Result := True; - - if tsHint in Self.FStates then - Application.CancelHint; - if FUpdateCount = 0 then - begin - // The drag image from VCL controls need special consideration. - if tsVCLDragging in FStates then - ImageList_DragShowNolock(False); - - if (suoScrollClientArea in Options) and not (tsToggling in FStates) then - begin - // Have to invalidate the entire window if there's a background. - if (toShowBackground in FOptions.FPaintOptions) and Assigned(FBackground.Graphic) then - begin - // Since we don't use ScrollWindow here we have to move all client windows ourselves. - DWPStructure := BeginDeferWindowPos(ControlCount); - for I := 0 to ControlCount - 1 do - if Controls[I] is TWinControl then - begin - with Controls[I] as TWinControl do - DWPStructure := DeferWindowPos(DWPStructure, Handle, 0, Left + DeltaX, Top + DeltaY, 0, 0, - SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOSIZE); - if DWPStructure = 0 then - Break; - end; - if DWPStructure <> 0 then - EndDeferWindowPos(DWPStructure); - InvalidateRect(Handle, nil, False); - end - else - begin - if (DeltaX <> 0) and (Header.Columns.GetVisibleFixedWidth > 0) then - begin - // When fixed columns exists we have to scroll separately horizontally and vertically. - // Horizontally is scroll only the client area not occupied by fixed columns and - // vertically entire client area (or clipping area if one exists). - R := ClientRect; - R.Left := Header.Columns.GetVisibleFixedWidth; - - ScrollWindow(Handle, DeltaX, 0, @R, @R); - if DeltaY <> 0 then - ScrollWindow(Handle, 0, DeltaY, ClipRect, ClipRect); - end - else - ScrollWindow(Handle, DeltaX, DeltaY, ClipRect, ClipRect); - end; - end; - - if suoUpdateNCArea in Options then - begin - if DeltaX <> 0 then - begin - if (suoRepaintHeader in Options) and (hoVisible in FHeader.FOptions) then - FHeader.Invalidate(nil); - if not (tsSizing in FStates) and (FScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssHorizontal, System.UITypes.TScrollStyle.ssBoth]) then - UpdateHorizontalScrollBar(suoRepaintScrollBars in Options); - end; - - if (DeltaY <> 0) and ([tsThumbTracking, tsSizing] * FStates = []) then - begin - UpdateVerticalScrollBar(suoRepaintScrollBars in Options); - if not (FHeader.UseColumns or IsMouseSelecting) and - (FScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssHorizontal, System.UITypes.TScrollStyle.ssBoth]) then - UpdateHorizontalScrollBar(suoRepaintScrollBars in Options); - end; - end; - - if tsVCLDragging in FStates then - ImageList_DragShowNolock(True); - end; - - // Finally update "hot" node if hot tracking is activated - GetCursorPos(P); - P := ScreenToClient(P); - if PtInRect(ClientRect, P) then - HandleHotTrack(P.X, P.Y); - - DoScroll(DeltaX, DeltaY); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoShowScrollBar(Bar: Integer; Show: Boolean); - -begin - ShowScrollBar(Handle, Bar, Show); - if Assigned(FOnShowScrollBar) then - FOnShowScrollBar(Self, Bar, Show); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoStartDrag(var DragObject: TDragObject); - -begin - inherited; - - // Check if the application created an own drag object. This is needed to pass the correct source in - // OnDragOver and OnDragDrop. - if Assigned(DragObject) then - DoStateChange([tsUserDragObject]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoStartOperation(OperationKind: TVTOperationKind); - -begin - if Assigned(FOnStartOperation) then - FOnStartOperation(Self, OperationKind); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoStateChange(Enter: TVirtualTreeStates; Leave: TVirtualTreeStates = []); - -var - ActualEnter, - ActualLeave: TVirtualTreeStates; - -begin - if Assigned(FOnStateChange) then - begin - ActualEnter := Enter - FStates; - ActualLeave := FStates * Leave; - if (ActualEnter + ActualLeave) <> [] then - FOnStateChange(Self, Enter, Leave); - end; - FStates := FStates + Enter - Leave; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoStructureChange(Node: PVirtualNode; Reason: TChangeReason); - -begin - StopTimer(StructureChangeTimer); - if Assigned(FOnStructureChange) then - FOnStructureChange(Self, Node, Reason); - - // This is a good place to reset the cached node and reason. These are the same as the values passed in here. - // This is necessary to allow descendants to override this method and get them. - DoStateChange([], [tsStructureChangePending]); - FLastStructureChangeNode := nil; - FLastStructureChangeReason := crIgnore; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoTimerScroll; - -var - P, - ClientP: TPoint; - InRect, - Panning: Boolean; - R, - ClipRect: TRect; - DeltaX, - DeltaY: Integer; - -begin - GetCursorPos(P); - R := ClientRect; - ClipRect := R; - MapWindowPoints(Handle, 0, R, 2); - InRect := PtInRect(R, P); - ClientP := ScreenToClient(P); - Panning := [tsWheelPanning, tsWheelScrolling] * FStates <> []; - - if IsMouseSelecting or InRect or Panning then - begin - DeltaX := 0; - DeltaY := 0; - if sdUp in FScrollDirections then - begin - if Panning then - DeltaY := FLastClickPos.Y - ClientP.Y - 8 - else - if InRect then - DeltaY := Min(FScrollBarOptions.FIncrementY, ClientHeight) - else - DeltaY := Min(FScrollBarOptions.FIncrementY, ClientHeight) * Abs(R.Top - P.Y); - if FOffsetY = 0 then - Exclude(FScrollDirections, sdUp); - end; - - if sdDown in FScrollDirections then - begin - if Panning then - DeltaY := FLastClickPos.Y - ClientP.Y + 8 - else - if InRect then - DeltaY := -Min(FScrollBarOptions.FIncrementY, ClientHeight) - else - DeltaY := -Min(FScrollBarOptions.FIncrementY, ClientHeight) * Abs(P.Y - R.Bottom); - if (ClientHeight - FOffsetY) = Integer(FRangeY) then - Exclude(FScrollDirections, sdDown); - end; - - if sdLeft in FScrollDirections then - begin - if Panning then - DeltaX := FLastClickPos.X - ClientP.X - 8 - else - if InRect then - DeltaX := FScrollBarOptions.FIncrementX - else - DeltaX := FScrollBarOptions.FIncrementX * Abs(R.Left - P.X); - if FEffectiveOffsetX = 0 then - Exclude(FScrollDirections, sdleft); - end; - - if sdRight in FScrollDirections then - begin - if Panning then - DeltaX := FLastClickPos.X - ClientP.X + 8 - else - if InRect then - DeltaX := -FScrollBarOptions.FIncrementX - else - DeltaX := -FScrollBarOptions.FIncrementX * Abs(P.X - R.Right); - - if (ClientWidth + FEffectiveOffsetX) = Integer(FRangeX) then - Exclude(FScrollDirections, sdRight); - end; - - if UseRightToLeftAlignment then - DeltaX := - DeltaX; - - if IsMouseSelecting then - begin - // In order to avoid scrolling the area which needs a repaint due to the changed selection rectangle - // we limit the scroll area explicitely. - OffsetRect(ClipRect, DeltaX, DeltaY); - DoSetOffsetXY(Point(FOffsetX + DeltaX, FOffsetY + DeltaY), DefaultScrollUpdateFlags, @ClipRect); - // When selecting with the mouse then either update only the parts of the window which have been uncovered - // by the scroll operation if no change in the selection happend or invalidate and redraw the entire - // client area otherwise (to avoid the time consuming task of determining the display rectangles of every - // changed node). - if CalculateSelectionRect(ClientP.X, ClientP.Y) and HandleDrawSelection(ClientP.X, ClientP.Y) then - InvalidateRect(Handle, nil, False) - else - begin - // The selection did not change so invalidate only the part of the window which really needs an update. - // 1) Invalidate the parts uncovered by the scroll operation. Add another offset range, we have to - // scroll only one stripe but have to update two. - OffsetRect(ClipRect, DeltaX, DeltaY); - SubtractRect(ClipRect, ClientRect, ClipRect); - InvalidateRect(Handle, @ClipRect, False); - - // 2) Invalidate the selection rectangles. - UnionRect(ClipRect, OrderRect(FNewSelRect), OrderRect(FLastSelRect)); - OffsetRect(ClipRect, FOffsetX, FOffsetY); - InvalidateRect(Handle, @ClipRect, False); - end; - end - else - begin - // Scroll only if there is no drag'n drop in progress. Drag'n drop scrolling is handled in DragOver. - if ((FDragManager = nil) or not DragManager.IsDropTarget) and ((DeltaX <> 0) or (DeltaY <> 0)) then - DoSetOffsetXY(Point(FOffsetX + DeltaX, FOffsetY + DeltaY), DefaultScrollUpdateFlags, nil); - end; - UpdateWindow(Handle); - - if (FScrollDirections = []) and ([tsWheelPanning, tsWheelScrolling] * FStates = []) then - begin - StopTimer(ScrollTimer); - DoStateChange([], [tsScrollPending, tsScrolling]); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoUpdating(State: TVTUpdateState); - -begin - if Assigned(FOnUpdating) then - FOnUpdating(Self, State); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DoValidateCache: Boolean; - -// This method fills the cache, which is used to speed up searching for nodes. -// The strategy is simple: Take the current number of visible nodes and distribute evenly a number of marks -// (which are stored in FPositionCache) so that iterating through the tree doesn't cost too much time. -// If there are less than 'CacheThreshold' nodes in the tree then the cache remains empty. -// Result is True if the cache was filled without interruption, otherwise False. -// Note: You can adjust the maximum number of nodes between two cache entries by changing CacheThreshold. - -var - EntryCount, - CurrentTop, - Index: Cardinal; - CurrentNode, - Temp: PVirtualNode; - -begin - EntryCount := 0; - if not (tsStopValidation in FStates) then - begin - if FStartIndex = 0 then - FPositionCache := nil; - - EntryCount := CalculateCacheEntryCount; - SetLength(FPositionCache, EntryCount); - if FStartIndex > EntryCount then - FStartIndex := EntryCount; - - // Optimize validation by starting with FStartIndex if set. - if (FStartIndex > 0) and Assigned(FPositionCache[FStartIndex - 1].Node) then - begin - // Index is the current entry in FPositionCache. - Index := FStartIndex - 1; - // Running term for absolute top value. - CurrentTop := FPositionCache[Index].AbsoluteTop; - // Running node pointer. - CurrentNode := FPositionCache[Index].Node; - end - else - begin - // Index is the current entry in FPositionCache. - Index := 0; - // Running term for absolute top value. - CurrentTop := 0; - // Running node pointer. - CurrentNode := GetFirstVisibleNoInit(nil, True); - end; - - // EntryCount serves as counter for processed nodes here. This value can always start at 0 as - // the validation either starts also at index 0 or an index which is always a multiple of CacheThreshold - // and EntryCount is only used with modulo CacheThreshold. - EntryCount := 0; - if Assigned(CurrentNode) then - begin - while not (tsStopValidation in FStates) do - begin - // If the cache is full then stop the loop. - if (Integer(Index) > Length(FPositionCache)) then // ADDED: 17.09.2013 - Veit Zimmermann - Break; // ADDED: 17.09.2013 - Veit Zimmermann - if (EntryCount mod CacheThreshold) = 0 then - begin - // New cache entry to set up. - with FPositionCache[Index] do - begin - Node := CurrentNode; // EAccessViolation seen here in TreeSize V4.3.1 - AbsoluteTop := CurrentTop; - end; - Inc(Index); - end; - - Inc(CurrentTop, NodeHeight[CurrentNode]); - // Advance to next visible node. - Temp := GetNextVisibleNoInit(CurrentNode, True); - // If there is no further node then stop the loop. - if (Temp = nil) then // CHANGED: 17.09.2013 - Veit Zimmermann - Break; // CHANGED: 17.09.2013 - Veit Zimmermann - - CurrentNode := Temp; - Inc(EntryCount); - end; - end; - // Finalize the position cache so no nil entry remains there. - if not (tsStopValidation in FStates) and (Integer(Index) <= High(FPositionCache)) then - begin - SetLength(FPositionCache, Index + 1); - with FPositionCache[Index] do - begin - Node := CurrentNode; - AbsoluteTop := CurrentTop; - end; - end; - end; - - Result := (EntryCount > 0) and not (tsStopValidation in FStates); - - // In variable node height mode it might have happend that some or all of the nodes have been adjusted in their - // height. During validation updates of the scrollbars is disabled so let's do this here. - if Result and (toVariableNodeHeight in FOptions.FMiscOptions) then - begin - TThread.Queue(nil, procedure begin UpdateScrollBars(True) end); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DragAndDrop(AllowedEffects: Dword; const DataObject: IDataObject; var DragEffect: Integer); -var - lDragEffect: DWord; // required for type compatibility with SHDoDragDrop -begin - if IsWinVistaOrAbove then - begin - lDragEffect := DWord(DragEffect); - SHDoDragDrop(Self.Handle, DataObject, nil, AllowedEffects, lDragEffect); // supports drag hints on Windows Vista and later - DragEffect := Integer(lDragEffect); - end - else - Winapi.ActiveX.DoDragDrop(DataObject, DragManager as IDropSource, AllowedEffects, DragEffect); - end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DragCanceled; - -// Does some housekeeping for VCL drag'n drop; - -begin - inherited; - - DragFinished; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DragDrop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; - var Effect: Integer): HResult; - -var - Shift: TShiftState; - EnumFormat: IEnumFormatEtc; - Fetched: Integer; - OLEFormat: TFormatEtc; - Formats: TFormatArray; - -begin - StopTimer(ExpandTimer); - StopTimer(ScrollTimer); - DoStateChange([], [tsScrollPending, tsScrolling]); - Formats := nil; - - // Ask explicitly again whether the action is allowed. Otherwise we may accept a drop which is intentionally not - // allowed but cannot be prevented by the application because when the tree was scrolling while dropping - // no DragOver event is created by the OLE subsystem. - Result := DragOver(DragManager.DragSource, KeyState, dsDragMove, Pt, Effect); - try - if (Result <> NOERROR) or ((Effect and not DROPEFFECT_SCROLL) = DROPEFFECT_NONE) then - Result := E_FAIL - else - begin - try - Shift := KeysToShiftState(KeyState); - if tsRightButtonDown in FStates then - Include(Shift, ssRight) - else if tsMiddleButtonDown in FStates then - Include(Shift, ssMiddle) - else - Include(Shift, ssLeft); - Pt := ScreenToClient(Pt); - // Determine which formats we can get and pass them along with the data object to the drop handler. - Result := DataObject.EnumFormatEtc(DATADIR_GET, EnumFormat); - if Failed(Result) then - Abort; - Result := EnumFormat.Reset; - if Failed(Result) then - Abort; - // create a list of available formats - while EnumFormat.Next(1, OLEFormat, @Fetched) = S_OK do - begin - SetLength(Formats, Length(Formats) + 1); - Formats[High(Formats)] := OLEFormat.cfFormat; - end; - DoDragDrop(DragManager.DragSource, DataObject, Formats, Shift, Pt, Effect, FLastDropMode); - except - // An unhandled exception here leaks memory. - Application.HandleException(Self); - Result := E_UNEXPECTED; - end; - end; - finally - if Assigned(FDropTargetNode) then - begin - InvalidateNode(FDropTargetNode); - FDropTargetNode := nil; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DragEnter(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; - -// callback routine for the drop target interface - -var - Shift: TShiftState; - Accept: Boolean; - R: TRect; - HitInfo: THitInfo; - -begin - try - // Determine acceptance of drag operation and reset scroll start time. - FDragScrollStart := 0; - - Shift := KeysToShiftState(KeyState); - if tsLeftButtonDown in FStates then - Include(Shift, ssLeft); - if tsMiddleButtonDown in FStates then - Include(Shift, ssMiddle); - if tsRightButtonDown in FStates then - Include(Shift, ssRight); - Pt := ScreenToClient(Pt); - Effect := SuggestDropEffect(DragManager.DragSource, Shift, Pt, Effect); - Accept := DoDragOver(DragManager.DragSource, Shift, dsDragEnter, Pt, FLastDropMode, Effect); - if not Accept then - Effect := DROPEFFECT_NONE - else - begin - // Set initial drop target node and drop mode. - GetHitTestInfoAt(Pt.X, Pt.Y, True, HitInfo); - if Assigned(HitInfo.HitNode) then - begin - FDropTargetNode := HitInfo.HitNode; - R := GetDisplayRect(HitInfo.HitNode, FHeader.MainColumn, False); - if (hiOnItemLabel in HitInfo.HitPositions) or ((hiOnItem in HitInfo.HitPositions) and - ((toFullRowDrag in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions)))then - FLastDropMode := dmOnNode - else - if ((R.Top + R.Bottom) div 2) > Pt.Y then - FLastDropMode := dmAbove - else - FLastDropMode := dmBelow; - end - else - FLastDropMode := dmNowhere; - end; - - // If the drag source is a virtual tree then we know how to control the drag image - // and can show it even if the source is not the target tree. - // This is only necessary if we cannot use the drag image helper interfaces. - if not DragManager.DropTargetHelperSupported and Assigned(DragManager.DragSource) then - DragManager.DragSource.FDragImage.ShowDragImage; - Result := NOERROR; - except - Result := E_UNEXPECTED; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DragFinished; - -// Called by DragCancelled or EndDrag to make up for the still missing mouse button up messages. -// These are important for such important things like popup menus. - -var - P: TPoint; - -begin - if [tsOLEDragging, tsVCLDragPending, tsVCLDragging, tsVCLDragFinished] * FStates = [] then - Exit; - - DoStateChange([], [tsVCLDragPending, tsVCLDragging, tsUserDragObject, tsVCLDragFinished]); - - GetCursorPos(P); - P := ScreenToClient(P); - if tsRightButtonDown in FStates then - Perform(WM_RBUTTONUP, 0, LPARAM(Integer(PointToSmallPoint(P)))) - else - if tsMiddleButtonDown in FStates then - Perform(WM_MBUTTONUP, 0, LPARAM(Integer(PointToSmallPoint(P)))) - else - Perform(WM_LBUTTONUP, 0, LPARAM(Integer(PointToSmallPoint(P)))); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DragLeave; - -var - Effect: Integer; - -begin - StopTimer(ExpandTimer); - - if not DragManager.DropTargetHelperSupported and Assigned(DragManager.DragSource) then - DragManager.DragSource.FDragImage.HideDragImage; - - if Assigned(FDropTargetNode) then - begin - InvalidateNode(FDropTargetNode); - FDropTargetNode := nil; - end; - UpdateWindow(Handle); - - Effect := 0; - DoDragOver(nil, [], dsDragLeave, Point(0, 0), FLastDropMode, Effect); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.DragOver(Source: TObject; KeyState: Integer; DragState: TDragState; Pt: TPoint; - var Effect: Integer): HResult; - -// callback routine for the drop target interface - -var - Shift: TShiftState; - Accept, - DragImageWillMove, - WindowScrolled: Boolean; - OldR, R: TRect; - NewDropMode: TDropMode; - HitInfo: THitInfo; - DragPos: TPoint; - Tree: TBaseVirtualTree; - LastNode: PVirtualNode; - DeltaX, - DeltaY: Integer; - ScrollOptions: TScrollUpdateOptions; - -begin - if not DragManager.DropTargetHelperSupported and (Source is TBaseVirtualTree) then - begin - Tree := Source as TBaseVirtualTree; - ScrollOptions := [suoUpdateNCArea]; - end - else - begin - Tree := nil; - ScrollOptions := DefaultScrollUpdateFlags; - end; - - try - DragPos := Pt; - Pt := ScreenToClient(Pt); - - // Check if we have to scroll the client area. - FScrollDirections := DetermineScrollDirections(Pt.X, Pt.Y); - DeltaX := 0; - DeltaY := 0; - if FScrollDirections <> [] then - begin - // Determine amount to scroll. - if sdUp in FScrollDirections then - begin - DeltaY := Min(FScrollBarOptions.FIncrementY, ClientHeight); - if FOffsetY = 0 then - Exclude(FScrollDirections, sdUp); - end; - if sdDown in FScrollDirections then - begin - DeltaY := -Min(FScrollBarOptions.FIncrementY, ClientHeight); - if (ClientHeight - FOffsetY) = Integer(FRangeY) then - Exclude(FScrollDirections, sdDown); - end; - if sdLeft in FScrollDirections then - begin - DeltaX := FScrollBarOptions.FIncrementX; - if FEffectiveOffsetX = 0 then - Exclude(FScrollDirections, sdleft); - end; - if sdRight in FScrollDirections then - begin - DeltaX := -FScrollBarOptions.FIncrementX; - if (ClientWidth + FEffectiveOffsetX) = Integer(FRangeX) then - Exclude(FScrollDirections, sdRight); - end; - WindowScrolled := DoSetOffsetXY(Point(FOffsetX + DeltaX, FOffsetY + DeltaY), ScrollOptions, nil); - end - else - WindowScrolled := False; - - // Determine acceptance of drag operation as well as drag target. - Shift := KeysToShiftState(KeyState); - if tsLeftButtonDown in FStates then - Include(Shift, ssLeft); - if tsMiddleButtonDown in FStates then - Include(Shift, ssMiddle); - if tsRightButtonDown in FStates then - Include(Shift, ssRight); - GetHitTestInfoAt(Pt.X, Pt.Y, True, HitInfo); - - if Assigned(HitInfo.HitNode) then - R := GetDisplayRect(HitInfo.HitNode, NoColumn, False) - else - R := Rect(0, 0, 0, 0); - NewDropMode := DetermineDropMode(Pt, HitInfo, R); - - if Assigned(Tree) then - DragImageWillMove := Tree.FDragImage.WillMove(DragPos) - else - DragImageWillMove := False; - - if (HitInfo.HitNode <> FDropTargetNode) or (FLastDropMode <> NewDropMode) then - begin - // Something in the tree will change. This requires to update the screen and/or the drag image. - FLastDropMode := NewDropMode; - if HitInfo.HitNode <> FDropTargetNode then - begin - StopTimer(ExpandTimer); - // The last target node is needed for the rectangle determination but must already be set for - // the recapture call, hence it must be stored somewhere. - LastNode := FDropTargetNode; - FDropTargetNode := HitInfo.HitNode; - // In order to show a selection rectangle a column must be focused. - if FFocusedColumn <= NoColumn then - FFocusedColumn := FHeader.MainColumn; - - if Assigned(LastNode) and Assigned(FDropTargetNode) then - begin - // Optimize the case that the selection moved between two nodes. - OldR := GetDisplayRect(LastNode, NoColumn, False); - UnionRect(R, R, OldR); - if Assigned(Tree) then - begin - if WindowScrolled then - UpdateWindowAndDragImage(Tree, ClientRect, True, not DragImageWillMove) - else - UpdateWindowAndDragImage(Tree, R, False, not DragImageWillMove); - end - else - InvalidateRect(Handle, @R, False); - end - else - begin - if Assigned(LastNode) then - begin - // Repaint last target node. - OldR := GetDisplayRect(LastNode, NoColumn, False); - if Assigned(Tree) then - begin - if WindowScrolled then - UpdateWindowAndDragImage(Tree, ClientRect, WindowScrolled, not DragImageWillMove) - else - UpdateWindowAndDragImage(Tree, OldR, False, not DragImageWillMove); - end - else - InvalidateRect(Handle, @OldR, False); - end - else - begin - if Assigned(Tree) then - begin - if WindowScrolled then - UpdateWindowAndDragImage(Tree, ClientRect, WindowScrolled, not DragImageWillMove) - else - UpdateWindowAndDragImage(Tree, R, False, not DragImageWillMove); - end - else - InvalidateRect(Handle, @R, False); - end; - end; - - // Start auto expand timer if necessary. - if (toAutoDropExpand in FOptions.FAutoOptions) and Assigned(FDropTargetNode) and - (vsHasChildren in FDropTargetNode.States) then - SetTimer(Handle, ExpandTimer, FAutoExpandDelay, nil); - end - else - begin - // Only the drop mark position changed so invalidate the current drop target node. - if Assigned(Tree) then - begin - if WindowScrolled then - UpdateWindowAndDragImage(Tree, ClientRect, WindowScrolled, not DragImageWillMove) - else - UpdateWindowAndDragImage(Tree, R, False, not DragImageWillMove); - end - else - InvalidateRect(Handle, @R, False); - end; - end - else - begin - // No change in the current drop target or drop mode. This might still mean horizontal or vertical scrolling. - if Assigned(Tree) and ((DeltaX <> 0) or (DeltaY <> 0)) then - UpdateWindowAndDragImage(Tree, ClientRect, WindowScrolled, not DragImageWillMove); - end; - - Update; - - if Assigned(Tree) and DragImageWillMove then - Tree.FDragImage.DragTo(DragPos, False); - - Effect := SuggestDropEffect(Source, Shift, Pt, Effect); - Accept := DoDragOver(Source, Shift, DragState, Pt, FLastDropMode, Effect); - if not Accept then - Effect := DROPEFFECT_NONE; - if WindowScrolled then - Effect := Effect or Integer(DROPEFFECT_SCROLL); - Result := NOERROR; - except - Result := E_UNEXPECTED; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DrawDottedHLine(const PaintInfo: TVTPaintInfo; Left, Right, Top: Integer); - -// Draws a horizontal line with alternating pixels (this style is not supported for pens under Win9x). - -var - R: TRect; - -begin - with PaintInfo, Canvas do - begin - Brush.Color := FColors.BackGroundColor; - R := Rect(Min(Left, Right), Top, Max(Left, Right) + 1, Top + 1); - Winapi.Windows.FillRect(Handle, R, FDottedBrush - ); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DrawDottedVLine(const PaintInfo: TVTPaintInfo; Top, Bottom, Left: Integer; UseSelectedBkColor: Boolean = False); - -// Draws a horizontal line with alternating pixels (this style is not supported for pens under Win9x). - -var - R: TRect; - -begin - with PaintInfo, Canvas do - begin - if UseSelectedBkColor then - begin - if Focused or (toPopupMode in FOptions.FPaintOptions) then - Brush.Color := FColors.FocusedSelectionColor - else - Brush.Color := FColors.UnfocusedSelectionColor; - end - else - Brush.Color := FColors.BackGroundColor; - R := Rect(Left, Min(Top, Bottom), Left + 1, Max(Top, Bottom) + 1); - Winapi.Windows.FillRect(Handle, R, FDottedBrush); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.EndOperation(OperationKind: TVTOperationKind); - -// Called to indicate that a long-running operation has finished. - -begin - Assert(FOperationCount > 0, 'EndOperation must not be called when no operation in progress.'); - Dec(FOperationCount); - DoEndOperation(OperationKind); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.EnsureNodeFocused(); -begin - if FocusedNode = nil then - FocusedNode := Self.GetFirstSelected(); - if FocusedNode = nil then - FocusedNode := Self.GetFirstVisible(); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.EnsureNodeSelected(); -begin - if (toAlwaysSelectNode in TreeOptions.SelectionOptions) and not IsEmpty then - begin - if (SelectedCount = 0) and not SelectionLocked then - begin - if Assigned(FNextNodeToSelect) then - Selected[FNextNodeToSelect] := True - else - Selected[GetFirstVisible] := True; - Self.ScrollIntoView(Self.GetFirstSelected, False); - end;// if nothing selected - EnsureNodeFocused(); - end;//if toAlwaysSelectNode -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.FindNodeInSelection(P: PVirtualNode; var Index: Integer; LowBound, - HighBound: Integer): Boolean; - -// Search routine to find a specific node in the selection array. -// LowBound and HighBound determine the range in which to search the node. -// Either value can be -1 to denote the maximum range otherwise LowBound must be less or equal HighBound. - -var - L, H, - I: Integer; - -begin - Result := False; - L := 0; - if LowBound >= 0 then - L := LowBound; - H := FSelectionCount - 1; - if HighBound >= 0 then - H := HighBound; - while L <= H do - begin - I := (L + H) shr 1; - if PAnsiChar(FSelection[I]) < PAnsiChar(P) then - L := I + 1 - else - begin - H := I - 1; - if FSelection[I] = P then - begin - Result := True; - L := I; - end; - end; - end; - Index := L; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.FinishChunkHeader(Stream: TStream; StartPos, EndPos: Integer); - -// used while streaming out a node to finally write out the size of the chunk - -var - Size: Integer; - -begin - // seek back to the second entry in the chunk header - Stream.Position := StartPos + SizeOf(Size); - // determine size of chunk without the chunk header - Size := EndPos - StartPos - SizeOf(TChunkHeader); - // write the size... - Stream.Write(Size, SizeOf(Size)); - // ... and seek to the last endposition - Stream.Position := EndPos; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.FontChanged(AFont: TObject); - -// Little helper function for font changes (as they are not tracked in TBitmap/TCanvas.OnChange). - -begin - FFontChanged := True; - if Assigned(FOldFontChange) then - FOldFontChange(AFont); - //if not (tsPainting in TreeStates) then AutoScale(); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetBorderDimensions: TSize; - -// Returns the overall width of the current window border, depending on border styles. -// Note: these numbers represent the system's standards not special properties, which can be set for TWinControl -// (e.g. bevels, border width). - -var - Styles: Integer; - -begin - Result.cx := 0; - Result.cy := 0; - - Styles := GetWindowLong(Handle, GWL_STYLE); - if (Styles and WS_BORDER) <> 0 then - begin - Dec(Result.cx); - Dec(Result.cy); - end; - if (Styles and WS_THICKFRAME) <> 0 then - begin - Dec(Result.cx, GetSystemMetrics(SM_CXFIXEDFRAME)); - Dec(Result.cy, GetSystemMetrics(SM_CYFIXEDFRAME)); - end; - Styles := GetWindowLong(Handle, GWL_EXSTYLE); - if (Styles and WS_EX_CLIENTEDGE) <> 0 then - begin - Dec(Result.cx, GetSystemMetrics(SM_CXEDGE)); - Dec(Result.cy, GetSystemMetrics(SM_CYEDGE)); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetCheckImage(Node: PVirtualNode; ImgCheckType: TCheckType = ctNone; ImgCheckState: - TCheckState = csUncheckedNormal; ImgEnabled: Boolean = True): Integer; - -// Determines the index into the check image list for the given node depending on the check type -// and enabled state. - -const - // Four dimensional array consisting of image indices for the check type, the check state, the enabled state and the - // hot state. - CheckStateToCheckImage: array[ctCheckBox..ctButton, csUncheckedNormal..csMixedPressed, Boolean, Boolean] of Integer = ( - // ctCheckBox, ctTriStateCheckBox - ( - // csUncheckedNormal (disabled [not hot, hot], enabled [not hot, hot]) - ((ckCheckUncheckedDisabled, ckCheckUncheckedDisabled), (ckCheckUncheckedNormal, ckCheckUncheckedHot)), - // csUncheckedPressed (disabled [not hot, hot], enabled [not hot, hot]) - ((ckCheckUncheckedDisabled, ckCheckUncheckedDisabled), (ckCheckUncheckedPressed, ckCheckUncheckedPressed)), - // csCheckedNormal - ((ckCheckCheckedDisabled, ckCheckCheckedDisabled), (ckCheckCheckedNormal, ckCheckCheckedHot)), - // csCheckedPressed - ((ckCheckCheckedDisabled, ckCheckCheckedDisabled), (ckCheckCheckedPressed, ckCheckCheckedPressed)), - // csMixedNormal - ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedNormal, ckCheckMixedHot)), - // csMixedPressed - ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedPressed, ckCheckMixedPressed)) - ), - // ctRadioButton - ( - // csUncheckedNormal (disabled [not hot, hot], enabled [not hot, hot]) - ((ckRadioUncheckedDisabled, ckRadioUncheckedDisabled), (ckRadioUncheckedNormal, ckRadioUncheckedHot)), - // csUncheckedPressed (disabled [not hot, hot], enabled [not hot, hot]) - ((ckRadioUncheckedDisabled, ckRadioUncheckedDisabled), (ckRadioUncheckedPressed, ckRadioUncheckedPressed)), - // csCheckedNormal - ((ckRadioCheckedDisabled, ckRadioCheckedDisabled), (ckRadioCheckedNormal, ckRadioCheckedHot)), - // csCheckedPressed - ((ckRadioCheckedDisabled, ckRadioCheckedDisabled), (ckRadioCheckedPressed, ckRadioCheckedPressed)), - // csMixedNormal (should never appear with ctRadioButton) - ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedNormal, ckCheckMixedHot)), - // csMixedPressed (should never appear with ctRadioButton) - ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedPressed, ckCheckMixedPressed)) - ), - // ctButton - ( - // csUncheckedNormal (disabled [not hot, hot], enabled [not hot, hot]) - ((ckButtonDisabled, ckButtonDisabled), (ckButtonNormal, ckButtonHot)), - // csUncheckedPressed (disabled [not hot, hot], enabled [not hot, hot]) - ((ckButtonDisabled, ckButtonDisabled), (ckButtonPressed, ckButtonPressed)), - // csCheckedNormal - ((ckButtonDisabled, ckButtonDisabled), (ckButtonNormal, ckButtonHot)), - // csCheckedPressed - ((ckButtonDisabled, ckButtonDisabled), (ckButtonPressed, ckButtonPressed)), - // csMixedNormal (should never appear with ctButton) - ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedNormal, ckCheckMixedHot)), - // csMixedPressed (should never appear with ctButton) - ((ckCheckMixedDisabled, ckCheckMixedDisabled), (ckCheckMixedPressed, ckCheckMixedPressed)) - ) - ); - -var - IsHot: Boolean; - -begin - if Assigned(Node) then - begin - ImgCheckType := Node.CheckType; - ImgCheckState := GetCheckState(Node); - ImgEnabled := not (vsDisabled in Node.States) and Self.Enabled; - - IsHot := Node = FCurrentHotNode; - end - else - IsHot := False; - - if ImgCheckState.IsDisabled then begin // disabled image? - // We need to use disabled images, so map ImgCheckState value from disabled to normal, as disabled state is expressed by ImgEnabled. - ImgEnabled := False; - ImgCheckState := ImgCheckState.GetEnabled(); - end;//if - - if ImgCheckType = ctTriStateCheckBox then - ImgCheckType := ctCheckBox; - if IsHot and (ImgCheckState in [csCheckedNormal, csUncheckedNormal]) and (GetKeyState(VK_LBUTTON) < 0) and (hiOnItemCheckbox in FLastHitInfo.HitPositions) then - Inc(ImgCheckState); // Advance to pressed state - - if ImgCheckType = ctNone then - Result := -1 - else - Result := CheckStateToCheckImage[ImgCheckType, ImgCheckState, ImgEnabled, IsHot]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetColumnClass: TVirtualTreeColumnClass; - -begin - Result := TVirtualTreeColumn; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetHeaderClass: TVTHeaderClass; - -begin - Result := TVTHeader; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetHintWindowClass: THintWindowClass; - -// Returns the default hint window class used for the tree. Descendants can override it to use their own classes. - -begin - Result := TVirtualTreeHintWindow; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.GetImageIndex(var Info: TVTPaintInfo; Kind: TVTImageKind; InfoIndex: TVTImageInfoIndex); - -// Retrieves the image index and an eventual customized image list for drawing. - -var - CustomImages: TCustomImageList; - -begin - with Info do - begin - ImageInfo[InfoIndex].Index := -1; - ImageInfo[InfoIndex].Ghosted := False; - - CustomImages := DoGetImageIndex(Node, Kind, Column, ImageInfo[InfoIndex].Ghosted, ImageInfo[InfoIndex].Index); - if Assigned(CustomImages) then - ImageInfo[InfoIndex].Images := CustomImages - end; -end; - -function TBaseVirtualTree.GetImageSize(Node: PVirtualNode; Kind: TVTImageKind = TVTImageKind.ikNormal; Column: TColumnIndex = 0; IncludePadding: Boolean = True): TSize; - -// Determines whether the given node has got an image of the given kind in the given column. -// Returns the size of the image, or (0,0) if no image is available -// The given node will be implicitly initialized if needed. - -var - Ghosted: Boolean; - Index: TImageIndex; - lImageList: TCustomImageList; -begin - if not Assigned(OnGetImageIndexEx) and (((Kind = TVTImageKind.ikNormal) and not Assigned(fImages)) - or ((Kind = TVTImageKind.ikState) and not Assigned(fStateImages))) then - begin - Result.cx := 0; - Result.cy := 0; - end; - if not (vsInitialized in Node.States) then - InitNode(Node); - Index := -1; - Ghosted := False; - lImageList := DoGetImageIndex(Node, Kind, Column, Ghosted, Index); - if Index >= 0 then begin - if IncludePadding then - Result.cx := lImageList.Width + ScaledPixels(2) - else - Result.cx := lImageList.Width; - Result.cy := lImageList.Height; - end - else begin - Result.cx := 0; - Result.cy := 0; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.IsEmpty: Boolean; -begin - Result := (Self.ChildCount[nil] = 0); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNodeImageSize(Node: PVirtualNode): TSize; - - // Returns the size of an image - // Override if you need different sized images for certain nodes. -begin - Result := GetImageSize(Node); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetMaxRightExtend(): Cardinal; - -// Determines the maximum with of the currently visible part of the tree, depending on the length -// of the node texts. This method is used for determining the horizontal scroll range if no columns are used. - -var - Node, - NextNode: PVirtualNode; - TopPosition: Integer; - CurrentWidth: Integer; - -begin - Node := GetNodeAt(0, 0, True, TopPosition); - Result := 0; - if not Assigned(Node) then - exit; - - while Assigned(Node) do - begin - if not (vsInitialized in Node.States) then - InitNode(Node); - CurrentWidth := GetOffset(TVTElement.ofsRightOfText, Node); - if Integer(Result) < (CurrentWidth) then - Result := CurrentWidth; - Inc(TopPosition, NodeHeight[Node]); - if TopPosition > Height then - Break; - - // Get next visible node and update left node position. - NextNode := GetNextVisible(Node, True); - if NextNode = nil then - Break; - Node := NextNode; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.GetNativeClipboardFormats(var Formats: TFormatEtcArray); - -// Returns the supported clipboard formats of the tree. - -begin - TClipboardFormatList.EnumerateFormats(TVirtualTreeClass(ClassType), Formats, FClipboardFormats); - // Ask application/descendants for self defined formats. - DoGetUserClipboardFormats(Formats); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetOperationCanceled; - -begin - Result := FOperationCanceled and (FOperationCount > 0); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetOptionsClass: TTreeOptionsClass; - -begin - Result := TCustomVirtualTreeOptions; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetTreeFromDataObject(const DataObject: IDataObject): 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; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.HandleHotTrack(X, Y: Integer); - -// Updates the current "hot" node. - -var - HitInfo: THitInfo; - CheckPositions: THitPositions; - ButtonIsHit, - DoInvalidate: Boolean; - oldHotNode : PVirtualNode; -begin - if not IsMouseCursorVisible then - begin - if Assigned(FCurrentHotNode) then - begin - InvalidateNode(FCurrentHotNode); - FCurrentHotNode := nil; - end; - Exit; - end;//if not IsMouseCursorVisible - - DoInvalidate := False; - oldHotNode := FCurrentHotNode; - // Get information about the hit. - GetHitTestInfoAt(X, Y, True, HitInfo); - - // Only make the new node being "hot" if its label is hit or full row selection is enabled. - CheckPositions := [hiOnItemLabel, hiOnItemCheckbox]; - - // If running under Windows Vista using the explorer theme hitting the buttons makes the node hot, too. - if tsUseExplorerTheme in FStates then - Include(CheckPositions, hiOnItemButtonExact); - - if (CheckPositions * HitInfo.HitPositions = []) and - (not (toFullRowSelect in FOptions.FSelectionOptions) or (hiNowhere in HitInfo.HitPositions)) then - FCurrentHotNode := nil - else - FCurrentHotNode := HitInfo.HitNode; - if (FCurrentHotNode <> oldHotNode) or (HitInfo.HitColumn <> FCurrentHotColumn) then - begin - DoInvalidate := (toHotTrack in FOptions.PaintOptions) or (toCheckSupport in FOptions.FMiscOptions); - DoHotChange(oldHotNode, HitInfo.HitNode); - if Assigned(oldHotNode) and DoInvalidate then - InvalidateNode(oldHotNode); - FCurrentHotColumn := HitInfo.HitColumn; - end; - - ButtonIsHit := (hiOnItemButtonExact in HitInfo.HitPositions); - if Assigned(HitInfo.HitNode) and ((FHotNodeButtonHit <> ButtonIsHit) or DoInvalidate) then - begin - FHotNodeButtonHit := ButtonIsHit; - InvalidateNode(HitInfo.HitNode); - end - else - if not Assigned(HitInfo.HitNode) then - FHotNodeButtonHit := False; - - if (oldHotNode <> FCurrentHotNode) and (oldHotNode <> nil) then - InvalidateNode(oldHotNode); - -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.HandleIncrementalSearch(CharCode: Word); - -var - Run, Stop: PVirtualNode; - GetNextNode: TGetNextNodeProc; - NewSearchText: string; - SingleLetter, - PreviousSearch: Boolean; // True if VK_BACK was sent. - SearchDirection: TVTSearchDirection; - - //--------------- local functions ------------------------------------------- - - procedure SetupNavigation; - - // If the search buffer is empty then we start searching with the next node after the last one, otherwise - // we continue with the last one. Node navigation function is set up too here, to avoid frequent checks. - - var - FindNextNode: Boolean; - - begin - FindNextNode := (Length(FSearchBuffer) = 0) or (Run = nil) or SingleLetter or PreviousSearch; - case FIncrementalSearch of - isVisibleOnly: - if SearchDirection = sdForward then - begin - GetNextNode := GetNextVisible; - if FindNextNode then - begin - if Run = nil then - Run := GetFirstVisible(nil, True) - else - begin - Run := GetNextVisible(Run, True); - // Do wrap around. - if Run = nil then - Run := GetFirstVisible(nil, True); - end; - end; - end - else - begin - GetNextNode := GetPreviousVisible; - if FindNextNode then - begin - if Run = nil then - Run := GetLastVisible(nil, True) - else - begin - Run := GetPreviousVisible(Run, True); - // Do wrap around. - if Run = nil then - Run := GetLastVisible(nil, True); - end; - end; - end; - isInitializedOnly: - if SearchDirection = sdForward then - begin - GetNextNode := GetNextNoInit; - if FindNextNode then - begin - if Run = nil then - Run := GetFirstNoInit - else - begin - Run := GetNextNoInit(Run); - // Do wrap around. - if Run = nil then - Run := GetFirstNoInit; - end; - end; - end - else - begin - GetNextNode := GetPreviousNoInit; - if FindNextNode then - begin - if Run = nil then - Run := GetLastNoInit - else - begin - Run := GetPreviousNoInit(Run); - // Do wrap around. - if Run = nil then - Run := GetLastNoInit; - end; - end; - end; - else - // isAll - if SearchDirection = sdForward then - begin - GetNextNode := GetNext; - if FindNextNode then - begin - if Run = nil then - Run := GetFirst - else - begin - Run := GetNext(Run); - // Do wrap around. - if Run = nil then - Run := GetFirst; - end; - end; - end - else - begin - GetNextNode := GetPrevious; - if FindNextNode then - begin - if Run = nil then - Run := GetLast - else - begin - Run := GetPrevious(Run); - // Do wrap around. - if Run = nil then - Run := GetLast; - end; - end; - end; - end; - end; - - //--------------------------------------------------------------------------- - - function CodePageFromLocale(Language: LCID): Integer; - - // Determines the code page for a given locale. - // Unfortunately there is no easier way than this, currently. - - var - Buf: array[0..6] of Char; - - begin - GetLocaleInfo(Language, LOCALE_IDEFAULTANSICODEPAGE, Buf, 6); - Result := StrToIntDef(Buf, GetACP); - end; - - //--------------------------------------------------------------------------- - - function KeyUnicode(C: Char): WideChar; - // Converts the given character into its corresponding Unicode character - // depending on the active keyboard layout. - begin - Result := C; //!!!!!! - end; - - //--------------- end local functions --------------------------------------- - -var - FoundMatch: Boolean; - NewChar: WideChar; - -begin - StopTimer(SearchTimer); - - if FIncrementalSearch <> isNone then - begin - if CharCode <> 0 then - begin - DoStateChange([tsIncrementalSearching]); - - // Convert the given virtual key code into a Unicode character based on the current locale. - NewChar := KeyUnicode(Char(CharCode)); - PreviousSearch := NewChar = WideChar(VK_BACK); - // We cannot do a search with an empty search buffer. - if not PreviousSearch or (FSearchBuffer <> '') then - begin - // Determine which method to use to advance nodes and the start node to search from. - case FSearchStart of - ssAlwaysStartOver: - Run := nil; - ssFocusedNode: - Run := FFocusedNode; - else // ssLastHit - Run := FLastSearchNode; - end; - - // Make sure the start node corresponds to the search criterion. - if Assigned(Run) then - begin - case FIncrementalSearch of - isInitializedOnly: - if not (vsInitialized in Run.States) then - Run := nil; - isVisibleOnly: - if not FullyVisible[Run] or IsEffectivelyFiltered[Run] then - Run := nil; - end; - end; - Stop := Run; - - // VK_BACK temporarily changes search direction to opposite mode. - if PreviousSearch then - begin - if SearchDirection = sdBackward then - SearchDirection := sdForward - else - SearchDirection := sdBackward; - end - else - SearchDirection := FSearchDirection; - // The "single letter mode" is used to advance quickly from node to node when pressing the same key several times. - SingleLetter := (Length(FSearchBuffer) = 1) and not PreviousSearch and (FSearchBuffer[1] = NewChar); - // However if the current hit (if there is one) would fit also with a repeated character then - // don't use single letter mode. - if SingleLetter and (DoIncrementalSearch(Run, FSearchBuffer + NewChar) = 0) then - SingleLetter := False; - SetupNavigation; - FoundMatch := False; - - if Assigned(Run) then - begin - if SingleLetter then - NewSearchText := FSearchBuffer - else - if PreviousSearch then - begin - SetLength(FSearchBuffer, Length(FSearchBuffer) - 1); - NewSearchText := FSearchBuffer; - end - else - NewSearchText := FSearchBuffer + NewChar; - - repeat - if DoIncrementalSearch(Run, NewSearchText) = 0 then - begin - FoundMatch := True; - Break; - end; - - // Advance to next node if we have not found a match. - Run := GetNextNode(Run); - // Do wrap around start or end of tree. - if (Run <> Stop) and (Run = nil) then - SetupNavigation; - until Run = Stop; - end; - - if FoundMatch then - begin - ClearSelection; - FSearchBuffer := NewSearchText; - FLastSearchNode := Run; - FocusedNode := Run; - Selected[Run] := True; - FLastSearchNode := Run; - end - else - // Play an acoustic signal if nothing could be found but don't beep if only the currently - // focused node matches. - if Assigned(Run) and (DoIncrementalSearch(Run, NewSearchText) <> 0) then - Beep; - end; - end; - - // Restart search timeout interval. - SetTimer(Handle, SearchTimer, FSearchTimeout, nil); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.HandleMouseDblClick(var Message: TWMMouse; const HitInfo: THitInfo); - -var - NewCheckState: TCheckState; - Node: PVirtualNode; - MayEdit: Boolean; - -begin - MayEdit := not (tsEditing in FStates) and (toEditOnDblClick in FOptions.FMiscOptions); - if tsEditPending in FStates then - begin - StopTimer(EditTimer); - DoStateChange([], [tsEditPending]); - end; - - if not (tsEditing in FStates) or DoEndEdit then - begin - if HitInfo.HitColumn = FHeader.FColumns.FClickIndex then - DoColumnDblClick(HitInfo.HitColumn, KeysToShiftState(Message.Keys)); - - if HitInfo.HitNode <> nil then - DoNodeDblClick(HitInfo); - - Node := nil; - if (hiOnItem in HitInfo.HitPositions) and (HitInfo.HitColumn > NoColumn) and - (coFixed in FHeader.FColumns[HitInfo.HitColumn].FOptions) then - begin - if hiUpperSplitter in HitInfo.HitPositions then - Node := GetPreviousVisible(HitInfo.HitNode, True) - else - if hiLowerSplitter in HitInfo.HitPositions then - Node := HitInfo.HitNode; - end; - - if Assigned(Node) and (Node <> FRoot) and (toNodeHeightDblClickResize in FOptions.FMiscOptions) then - begin - if DoNodeHeightDblClickResize(Node, HitInfo.HitColumn, KeysToShiftState(Message.Keys), Point(Message.XPos, Message.YPos)) then - begin - SetNodeHeight(Node, FDefaultNodeHeight); - UpdateWindow(Handle); - MayEdit := False; - end; - end - else - if hiOnItemCheckBox in HitInfo.HitPositions then - begin - NewCheckState := DetermineNextCheckState(HitInfo.HitNode.CheckType, HitInfo.HitNode.CheckState); - if (ssLeft in KeysToShiftState(Message.Keys)) and DoChecking(HitInfo.HitNode, NewCheckState) then - begin - SetCheckState(HitInfo.HitNode, NewCheckState); - MayEdit := False; - end; - end// if hiOnItemCheckBox - else - begin - if hiOnItemButton in HitInfo.HitPositions then - begin - ToggleNode(HitInfo.HitNode); - MayEdit := False; - end - else - begin - if toToggleOnDblClick in FOptions.FMiscOptions then - begin - if ((([hiOnItemButton, hiOnItemLabel, hiOnNormalIcon, hiOnStateIcon] * HitInfo.HitPositions) <> []) or - ((toFullRowSelect in FOptions.FSelectionOptions) and Assigned(HitInfo.HitNode))) then - begin - ToggleNode(HitInfo.HitNode); - MayEdit := False; - end; - end; - end; - end; - end; - - if MayEdit and Assigned(FFocusedNode) and (FFocusedNode = HitInfo.HitNode) and - (FFocusedColumn = HitInfo.HitColumn) and CanEdit(FFocusedNode, HitInfo.HitColumn) then - begin - DoStateChange([tsEditPending]); - FEditColumn := FFocusedColumn; - SetTimer(Handle, EditTimer, 0, nil); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: THitInfo); - -// centralized mouse button down handling - -var - LastFocused: PVirtualNode; - Column: TColumnIndex; - ShiftState: TShiftState; - - // helper variables to shorten boolean equations/expressions - AutoDrag, // automatic (or allowed) drag start - IsLabelHit, // the node's caption or images are hit - IsCellHit, // for grid extension or full row select (but not check box, button) - IsAnyHit, // either IsHit or IsCellHit - IsHeightTracking, // height tracking - MultiSelect, // multiselection is enabled - ShiftEmpty, // ShiftState = [] - NodeSelected: Boolean; // the new node (if any) is selected - NewColumn: Boolean; // column changed - NewNode: Boolean; // Node changed. - NeedChangeEvent: Boolean; // change event is required for selection change - CanClear: Boolean; - NewCheckState: TCheckState; - AltPressed: Boolean; // Pressing the Alt key enables special processing for selection. - FullRowDrag: Boolean; // Start dragging anywhere within a node's bound. - NodeRect: TRect; - - //--------------- local functions ------------------------------------------- - - //Fix for issue: 310 whenever there is a need to invalidate a column, consider - //auto spanned columns if applicable - procedure invalidateWithAutoSpan(acolumn: TColumnIndex; anode: PVirtualNode); - var - NextColumn: Integer; - Dummy: TColumnIndex; - begin - if (not FHeader.UseColumns) or (not (toAutoSpanColumns in FOptions.FAutoOptions)) - or (acolumn = FHeader.MainColumn) then - begin - //no need to find auto spanned next columns - InvalidateColumn(acolumn); - exit; - end; - //invalidate auto spanned columns too - with FHeader.FColumns do //standard loop for auto span - begin - NextColumn := acolumn; - repeat - InvalidateColumn(NextColumn); - Dummy := GetNextVisibleColumn(NextColumn); - if (Dummy = InvalidColumn) or - not ColumnIsEmpty(anode, Dummy) - or - (Items[Dummy].BidiMode <> bdLeftToRight) then - Break; - NextColumn := Dummy; - until False; - end; - end; - - //--------------- end local functions --------------------------------------- - -begin - if IsEmpty then - Exit; // Nothing to do - if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then - begin - StopWheelPanning; - Exit; - end; - - if tsEditPending in FStates then - begin - StopTimer(EditTimer); - DoStateChange([], [tsEditPending]); - end; - - FLastHitInfo := HitInfo; // Save for later use in OnNodeClick event, see issue #692 - if (tsEditing in FStates) then begin - if not DoEndEdit then - exit; - // Repeat the hit test as an OnEdited event might got triggered that could modify the tree. - GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo); - end;//if tsEditing - - // Focus change. Don't use the SetFocus method as this does not work for MDI Winapi.Windows. - if not Focused and CanFocus then - 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); - end; - - // Keep clicked column in case the application needs it. - FHeader.FColumns.FClickIndex := HitInfo.HitColumn; - - // Change column only if we have hit the node label. - if (hiOnItemLabel in HitInfo.HitPositions) or - (toFullRowSelect in FOptions.FSelectionOptions) or - (toGridExtensions in FOptions.FMiscOptions) then - begin - NewColumn := FFocusedColumn <> HitInfo.HitColumn; - if toExtendedFocus in FOptions.FSelectionOptions then - Column := HitInfo.HitColumn - else - Column := FHeader.MainColumn; - end - else - begin - NewColumn := False; - Column := FFocusedColumn; - end; - - if NewColumn and not FHeader.AllowFocus(Column) then - begin - NewColumn := False; - Column := FFocusedColumn; - end; - - NewNode := FFocusedNode <> HitInfo.HitNode; - - // Translate keys and filter out shift and control key. - ShiftState := KeysToShiftState(Message.Keys) * [ssShift, ssCtrl, ssAlt]; - if ssAlt in ShiftState then - begin - AltPressed := True; - // Remove the Alt key from the shift state. It is not meaningful there. - Exclude(ShiftState, ssAlt); - end - else - AltPressed := False; - - // Various combinations determine what states the tree enters now. - // We initialize shorthand variables to avoid the following expressions getting too large - // and to avoid repeative expensive checks. - IsLabelHit := not AltPressed and not (toSimpleDrawSelection in FOptions.FSelectionOptions) and - ((hiOnItemLabel in HitInfo.HitPositions) or (hiOnNormalIcon in HitInfo.HitPositions)); - - IsCellHit := not AltPressed and not IsLabelHit and Assigned(HitInfo.HitNode) and - ([hiOnItemButton, hiOnItemCheckBox, hiNoWhere] * HitInfo.HitPositions = []) and - ((toFullRowSelect in FOptions.FSelectionOptions) or - ((toGridExtensions in FOptions.FMiscOptions) and (HitInfo.HitColumn > NoColumn))); - - IsAnyHit := IsLabelHit or IsCellHit; - MultiSelect := toMultiSelect in FOptions.FSelectionOptions; - ShiftEmpty := ShiftState = []; - NodeSelected := IsAnyHit and (vsSelected in HitInfo.HitNode.States); - - // Determine the Drag behavior. - if MultiSelect and not (toDisableDrawSelection in FOptions.FSelectionOptions) then - begin - // We have MultiSelect and want to draw a selection rectangle. - // We will start a full row drag only in case a label was hit, - // otherwise a multi selection will start. - FullRowDrag := (toFullRowDrag in FOptions.FMiscOptions) and IsCellHit and - not (hiNowhere in HitInfo.HitPositions) and - (NodeSelected or (hiOnItemLabel in HitInfo.HitPositions) or (hiOnNormalIcon in HitInfo.HitPositions)); - end - else // No MultiSelect, hence we can start a drag anywhere in the row. - FullRowDrag := toFullRowDrag in FOptions.FMiscOptions; - - IsHeightTracking := (Message.Msg = WM_LBUTTONDOWN) and - (hiOnItem in HitInfo.HitPositions) and - ([hiUpperSplitter, hiLowerSplitter] * HitInfo.HitPositions <> []); - - // Dragging might be started in the inherited handler manually (which is discouraged for stability reasons) - // the test for manual mode is done below (after the focused node is set). - AutoDrag := ((DragMode = dmAutomatic) or Dragging) and (not IsCellHit or FullRowDrag); - - // Query the application to learn if dragging may start now (if set to dmManual). - if Assigned(HitInfo.HitNode) and not AutoDrag and (DragMode = dmManual) then - AutoDrag := DoBeforeDrag(HitInfo.HitNode, Column) and (FullRowDrag or IsLabelHit); - - // handle node height tracking - if IsHeightTracking then - begin - if hiUpperSplitter in HitInfo.HitPositions then - FHeightTrackNode := GetPreviousVisible(HitInfo.HitNode, True) - else - FHeightTrackNode := HitInfo.HitNode; - - if CanSplitterResizeNode(Point(Message.XPos, Message.YPos), FHeightTrackNode, HitInfo.HitColumn) then - begin - FHeightTrackColumn := HitInfo.HitColumn; - NodeRect := GetDisplayRect(FHeightTrackNode, FHeightTrackColumn, False); - FHeightTrackPoint := Point(NodeRect.Left, NodeRect.Top); - DoStateChange([tsNodeHeightTrackPending]); - Exit; - end; - end; - - // handle button clicks - if (hiOnItemButton in HitInfo.HitPositions) and (vsHasChildren in HitInfo.HitNode.States) then - begin - ToggleNode(HitInfo.HitNode); - Exit; - end; - - // check event - if hiOnItemCheckBox in HitInfo.HitPositions then - begin - NewCheckState := DetermineNextCheckState(HitInfo.HitNode.CheckType, HitInfo.HitNode.CheckState); - if (ssLeft in KeysToShiftState(Message.Keys)) and DoChecking(HitInfo.HitNode, NewCheckState) then - begin - if (Self.SelectedCount > 1) and (Selected[HitInfo.HitNode]) then - SetCheckStateForAll(NewCheckState, True) - else - DoCheckClick(HitInfo.HitNode, NewCheckState); - end;//if ssLeft - Exit; - end; - - // Keep this node's level in case we need it for constraint selection. - if (FRoot.ChildCount > 0) and ShiftEmpty or (FSelectionCount = 0) then - if Assigned(HitInfo.HitNode) then - FLastSelectionLevel := GetNodeLevelForSelectConstraint(HitInfo.HitNode) - else - FLastSelectionLevel := GetNodeLevelForSelectConstraint(GetLastVisibleNoInit(nil, True)); - - // immediate clearance - // Determine for the right mouse button if there is a popup menu. In this case and if drag'n drop is pending - // the current selection has to stay as it is. - with HitInfo, Message do - CanClear := not AutoDrag and - (not (tsRightButtonDown in FStates) or not HasPopupMenu(HitNode, HitColumn, Point(XPos, YPos))); - - // pending clearance - if MultiSelect and ShiftEmpty and not (hiOnItemCheckbox in HitInfo.HitPositions) and IsAnyHit and AutoDrag and - NodeSelected and not FSelectionLocked - then - DoStateChange([tsClearPending]); - - // User starts a selection with a selection rectangle. - if not (toDisableDrawSelection in FOptions.FSelectionOptions) and not (IsLabelHit or FullRowDrag) and MultiSelect then - begin - SetCapture(Handle); - DoStateChange([tsDrawSelPending]); - FDrawSelShiftState := ShiftState; - FNewSelRect := Rect(Message.XPos + FEffectiveOffsetX, Message.YPos - FOffsetY, Message.XPos + FEffectiveOffsetX, - Message.YPos - FOffsetY); - FLastSelRect := Rect(0, 0, 0, 0); - end; - - NeedChangeEvent := FSelectionCount >= 1; - 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 - // on node captions and images. Here the previous selection state does not matter, though. - if NodeSelected or (AltPressed and Assigned(HitInfo.HitNode) and (HitInfo.HitColumn = FHeader.MainColumn)) and not (hiNowhere in HitInfo.HitPositions) then - begin - InternalClearSelection; - InternalAddToSelection(HitInfo.HitNode, True); - if NeedChangeEvent then - begin - Invalidate; - Change(nil); - end; - end - else if (toAlwaysSelectNode in Self.TreeOptions.SelectionOptions) then - begin - if not (hiNowhere in HitInfo.HitPositions) then - ClearSelection(False) - else - if not (ssCtrl in ShiftState) then - DoStateChange([tsClearOnNewSelection], []); - end - else - ClearSelection(False); - end; - - // pending node edit - if Focused and - ((hiOnItemLabel in HitInfo.HitPositions) or ((toGridExtensions in FOptions.FMiscOptions) and - (hiOnItem in HitInfo.HitPositions))) and NodeSelected and not NewColumn and ShiftEmpty and (SelectedCount = 1) then - begin - DoStateChange([tsEditPending]); - end; - - if not (toDisableDrawSelection in FOptions.FSelectionOptions) - and not (IsLabelHit or FullRowDrag) and (MultiSelect or (hiNowhere in HitInfo.HitPositions)) then - begin - // The original code here was moved up to fix issue #187. - // In order not to break the semantics of this procedure, we are leaving these if statements here - if not IsCellHit then begin - if NeedChangeEvent then - Change(nil); - Exit; - end; - end; - - // Keep current mouse position. - FLastClickPos := Point(Message.XPos, Message.YPos); - - // Handle selection and node focus change. - if (IsLabelHit or IsCellHit) and - DoFocusChanging(FFocusedNode, HitInfo.HitNode, FFocusedColumn, Column) then - begin - if NewColumn then - begin - - if not Assigned(FFocusedNode) then - InvalidateColumn(FFocusedColumn) - else - invalidateWithAutoSpan(FFocusedColumn, FFocusedNode); //fix: issue 310 - if not Assigned(HitInfo.HitNode) then - InvalidateColumn(Column) - else - invalidateWithAutoSpan(Column, HitInfo.HitNode); //fix: issue 310 - FFocusedColumn := Column; - end; - if DragKind = dkDock then - begin - StopTimer(ScrollTimer); - DoStateChange([], [tsScrollPending, tsScrolling]); - end; - // Get the currently focused node to make multiple multi-selection blocks possible. - LastFocused := FFocusedNode; - if NewNode then - DoFocusNode(HitInfo.HitNode, False); - - if MultiSelect and not ShiftEmpty and not (tsRightButtonDown in FStates) then - HandleClickSelection(LastFocused, HitInfo.HitNode, ShiftState, AutoDrag) - else - begin - if ShiftEmpty then - FRangeAnchor := HitInfo.HitNode; - - // If the hit node is not yet selected then do it now. - if not NodeSelected then - AddToSelection(HitInfo.HitNode, True); - end; - - if NewNode or NewColumn then - begin - ScrollIntoView(FFocusedNode, False, - not (toDisableAutoscrollOnFocus in FOptions.FAutoOptions) - and not (toFullRowSelect in FOptions.SelectionOptions)); - - DoFocusChange(FFocusedNode, FFocusedColumn); - end; - end; - - if (SelectedCount = 0) and NeedChangeEvent then - Change(nil); - - // Drag'n drop initiation - // If we lost focus in the interim the button states would be cleared in WM_KILLFOCUS. - if AutoDrag and IsAnyHit and (FStates * [tsLeftButtonDown, tsRightButtonDown, tsMiddleButtonDown] <> []) then - BeginDrag(False); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.HandleMouseUp(var Message: TWMMouse; const HitInfo: THitInfo); - -// Counterpart to the mouse down handler. - -var - ReselectFocusedNode: Boolean; - -begin - ReleaseCapture; - - if not (tsVCLDragPending in FStates) then - begin - // reset pending or persistent states - if IsMouseSelecting then - begin - DoStateChange([], [tsDrawSelecting, tsDrawSelPending, tsToggleFocusedSelection, tsClearOnNewSelection]); - Invalidate; - end; - - if tsClearPending in FStates then - begin - ReselectFocusedNode := Assigned(FFocusedNode) and (vsSelected in FFocusedNode.States); - ClearSelection; - if ReselectFocusedNode then - AddToSelection(FFocusedNode, False); - end; - - if (tsToggleFocusedSelection in FStates) and (HitInfo.HitNode = FFocusedNode) and Assigned(HitInfo.HitNode) then //Prevent AV when dereferencing HitInfo.HitNode below, see bug #100 - begin - if vsSelected in HitInfo.HitNode.States then - begin - if not (toAlwaysSelectNode in TreeOptions.SelectionOptions) or (Self.SelectedCount > 1) then - RemoveFromSelection(HitInfo.HitNode); - end - else - AddToSelection(HitInfo.HitNode, False); - end; - - DoStateChange([], [tsOLEDragPending, tsOLEDragging, tsClearPending, tsDrawSelPending, tsToggleFocusedSelection, - tsScrollPending, tsScrolling]); - StopTimer(ScrollTimer); - - if (FHeader.FColumns.FClickIndex > NoColumn) and (FHeader.FColumns.FClickIndex = HitInfo.HitColumn) then - DoColumnClick(HitInfo.HitColumn, KeysToShiftState(Message.Keys)); - - if FLastHitInfo.HitNode <> nil then begin // Use THitInfo of mouse down here, see issue #692 - DoNodeClick(FLastHitInfo); - InvalidateNode(FLastHitInfo.HitNode); - FLastHitInfo.HitNode := nil; // prevent firing the event again - end; - - // handle a pending edit event - if tsEditPending in FStates then - begin - // Is the mouse still over the same node? - if (HitInfo.HitNode = FFocusedNode) and (hiOnItem in HitInfo.HitPositions) and - (toEditOnClick in FOptions.FMiscOptions) and (FFocusedColumn = HitInfo.HitColumn) and - CanEdit(FFocusedNode, HitInfo.HitColumn) then - begin - FEditColumn := FFocusedColumn; - SetTimer(Handle, EditTimer, FEditDelay, nil); - end - else - DoStateChange([], [tsEditPending]); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.HasImage(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex): Boolean; - -// Determines whether the given node has got an image of the given kind in the given column. -// Returns True if so, otherwise False. -// The given node will be implicitly initialized if needed. - -var - Ghosted: Boolean; - Index: TImageIndex; - -begin - if not (vsInitialized in Node.States) then - InitNode(Node); - - Index := -1; - Ghosted := False; - DoGetImageIndex(Node, Kind, Column, Ghosted, Index); - Result := Index > -1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.HasPopupMenu(Node: PVirtualNode; Column: TColumnIndex; Pos: TPoint): Boolean; - -// Determines whether the tree got a popup menu, either in its PopupMenu property, via the OnGetPopupMenu event or -// through inheritance. The latter case must be checked by the descendant which must override this method. - -begin - Result := Assigned(PopupMenu) or Assigned(DoGetPopupMenu(Node, Column, Pos)); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InitChildren(Node: PVirtualNode); - -// Initiates the initialization of the child number of the given node. - -var - Count: Cardinal; - -begin - if Assigned(Node) and (Node <> FRoot) and (vsHasChildren in Node.States) then - begin - Count := Node.ChildCount; - if DoInitChildren(Node, Count) then - begin - SetChildCount(Node, Count); - if Count = 0 then - Exclude(Node.States, vsHasChildren); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InitNode(Node: PVirtualNode); - -// Initiates the initialization of the given node to allow the application to load needed data for it. - -var - InitStates: TVirtualNodeInitStates; - MustAdjustInternalVariables: Boolean; - ParentCheckState, SelfCheckState: TCheckState; -begin - with Node^ do - begin - Include(States, vsInitializing); - try - InitStates := []; - if vsInitialized in States then - Include(InitStates, ivsReInit); - Include(States, vsInitialized); - if Parent = FRoot then - DoInitNode(nil, Node, InitStates) - else - DoInitNode(Parent, Node, InitStates); - - // Fix: Any parent check state must be propagated here. - // Because the CheckType is normally set in DoInitNode - // by the App. - if Node.CheckType in [ctTriStateCheckBox] then - begin - ParentCheckState := Self.GetCheckState(Node.Parent); - SelfCheckState := Self.GetCheckState(Node); - if ((ParentCheckState = csCheckedNormal) - or (ParentCheckState = csUncheckedNormal)) - and (not SelfCheckState.IsDisabled()) - and (SelfCheckState <> ParentCheckState) - and (Parent <> FRoot) - then - SetCheckState(Node, Node.Parent.CheckState); - end; - - if ivsDisabled in InitStates then - Include(States, vsDisabled); - if ivsHasChildren in InitStates then - Include(States, vsHasChildren); - if ivsSelected in InitStates then - InternalAddToSelection(Node, False); - if ivsMultiline in InitStates then - Include(States, vsMultiline); - if ivsFiltered in InitStates then - begin - MustAdjustInternalVariables := not ((ivsReInit in InitStates) and (vsFiltered in States)); - - Include(States, vsFiltered); - - if not (toShowFilteredNodes in FOptions.FPaintOptions) and MustAdjustInternalVariables then - begin - AdjustTotalHeight(Node, -NodeHeight, True); - if FullyVisible[Node] then - Dec(FVisibleCount); - if FUpdateCount = 0 then - UpdateScrollBars(True); - end; - end; - - // Expanded may already be set (when called from ReinitNode) or be set in DoInitNode, allow both. - if (vsExpanded in Node.States) xor (ivsExpanded in InitStates) then - begin - // Expand node if not yet done (this will automatically initialize child nodes). - if ivsExpanded in InitStates then - ToggleNode(Node) - else - // If the node already was expanded then explicitly trigger child initialization. - if vsHasChildren in Node.States then - InitChildren(Node); - end; - finally - Exclude(States, vsInitializing); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InternalAddFromStream(Stream: TStream; Version: Integer; Node: PVirtualNode); - -// Loads all details for Node (including its children) from the given stream. -// Because the new nodes might be selected this method also fixes the selection array. - -var - Stop: PVirtualNode; - Index: Integer; - LastTotalHeight: Cardinal; - WasFullyVisible: Boolean; - -begin - Assert(Node <> FRoot, 'The root node cannot be loaded from stream.'); - - // Keep the current total height value of Node as it has already been applied - // but might change in the load and fixup code. We have to adjust that afterwards. - LastTotalHeight := Node.TotalHeight; - WasFullyVisible := FullyVisible[Node] and not IsEffectivelyFiltered[Node]; - - // Read in the new nodes. - ReadNode(Stream, Version, Node); - - // One time update of node-internal states and the global visibility counter. - // This is located here to ease and speed up the loading process. - FixupTotalCount(Node); - AdjustTotalCount(Node.Parent, Node.TotalCount - 1, True); // -1 because Node itself was already set. - FixupTotalHeight(Node); - AdjustTotalHeight(Node.Parent, Integer(Node.TotalHeight) - Integer(LastTotalHeight), True); - - // New nodes are always visible, so the visible node count has been increased already. - // If Node is now invisible we have to take back this increment and don't need to add any visible child node. - if not FullyVisible[Node] or IsEffectivelyFiltered[Node] then - begin - if WasFullyVisible then - Dec(FVisibleCount); - end - else - // It can never happen that the node is now fully visible but was not before as this would require - // that the visibility state of one of its parents has changed, which cannot happen during loading. - Inc(FVisibleCount, CountVisibleChildren(Node)); - - // Fix selection array. - ClearTempCache; - if Node = FRoot then - Stop := nil - else - Stop := Node.NextSibling; - - if toMultiSelect in FOptions.FSelectionOptions then - begin - // Add all nodes which were selected before to the current selection (unless they are already there). - while Node <> Stop do - begin - if (vsSelected in Node.States) and not FindNodeInSelection(Node, Index, 0, High(FSelection)) then - InternalCacheNode(Node); - Node := GetNextNoInit(Node); - end; - if FTempNodeCount > 0 then - AddToSelection(FTempNodeCache, FTempNodeCount, True); - ClearTempCache; - end - else // No further selected nodes allowed so delete the corresponding flag in all new nodes. - while Node <> Stop do - begin - Exclude(Node.States, vsSelected); - Node := GetNextNoInit(Node); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.InternalAddToSelection(Node: PVirtualNode; ForceInsert: Boolean): Boolean; -var - lSingletonNodeArray: TNodeArray; -begin - Assert(Assigned(Node), 'Node must not be nil!'); - SetLength(lSingletonNodeArray, 1); - lSingletonNodeArray[0] := Node; - Result := InternalAddToSelection(lSingletonNodeArray, 1, ForceInsert); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.InternalAddToSelection(const NewItems: TNodeArray; NewLength: Integer; - ForceInsert: Boolean): Boolean; - -// Internal version of method AddToSelection which does not trigger OnChange events - -var - I, J: Integer; - CurrentEnd: Integer; - Constrained, - SiblingConstrained: Boolean; - lPreviousSelectedCount: Integer; - AddedNodesSize: Integer; - PTmpNode: PVirtualNode; - -begin - lPreviousSelectedCount := FSelectionCount; - // The idea behind this code is to use a kind of reverse merge sort. QuickSort is quite fast - // and would do the job here too but has a serious problem with already sorted lists like FSelection. - - // current number of valid entries - AddedNodesSize := 0; - - // 1) Remove already selected items, mark all other as being selected. - if ForceInsert then - begin - //Fix: For already selected node when selected, this path - //is used that didn't contain the Constraint logic. Added. - Constrained := toLevelSelectConstraint in FOptions.FSelectionOptions; - if Constrained and (FLastSelectionLevel = -1) then - FLastSelectionLevel := GetNodeLevelForSelectConstraint(NewItems[0]); - AddedNodesSize := NewLength; - end - else - begin - Constrained := toLevelSelectConstraint in FOptions.FSelectionOptions; - if Constrained and (FLastSelectionLevel = -1) then - FLastSelectionLevel := GetNodeLevelForSelectConstraint(NewItems[0]); - SiblingConstrained := toSiblingSelectConstraint in FOptions.FSelectionOptions; - if SiblingConstrained and (FRangeAnchor = nil) then - FRangeAnchor := NewItems[0]; - - for I := 0 to NewLength - 1 do - if ([vsSelected, vsDisabled] * NewItems[I].States <> []) or - (Constrained and (Cardinal(FLastSelectionLevel) <> GetNodeLevel(NewItems[I]))) or - (SiblingConstrained and (FRangeAnchor.Parent <> NewItems[I].Parent)) - then - Inc(PAnsiChar(NewItems[I])) // mark as invalid by setting the LSB - else - Inc(AddedNodesSize); - end; - - I := PackArray(NewItems, NewLength); - if I > -1 then - NewLength := I; - - Result := NewLength > 0; - if Result then - begin - // 2) Sort the new item list so we can easily traverse it. - if NewLength > 1 then - QuickSort(NewItems, 0, NewLength - 1); - // 3) Make room in FSelection for the new items. - if lPreviousSelectedCount + NewLength >= Length(FSelection) then - SetLength(FSelection, lPreviousSelectedCount + NewLength); - - // 4) Merge in new items - J := NewLength - 1; - CurrentEnd := lPreviousSelectedCount - 1; - - while J >= 0 do - begin - // First insert all new entries which are greater than the greatest entry in the old list. - // If the current end marker is < 0 then there's nothing more to move in the selection - // array and only the remaining new items must be inserted. - if CurrentEnd >= 0 then - begin - while (J >= 0) and (PAnsiChar(NewItems[J]) > PAnsiChar(FSelection[CurrentEnd])) do - begin - FSelection[CurrentEnd + J + 1] := NewItems[J]; - Dec(J); - end; - // early out if nothing more needs to be copied - if J < 0 then - Break; - end - else - begin - // insert remaining new entries at position 0 - Move(NewItems[0], FSelection[0], (J + 1) * SizeOf(Pointer)); - // nothing more to do so exit main loop - Break; - end; - - // find the last entry in the remaining selection list which is smaller then the largest - // entry in the remaining new items list - FindNodeInSelection(NewItems[J], I, 0, CurrentEnd); - Dec(I); - // move all entries which are greater than the greatest entry in the new items list up - // so the remaining gap travels down to where new items must be inserted - Move(FSelection[I + 1], FSelection[I + J + 2], (CurrentEnd - I) * SizeOf(Pointer)); - CurrentEnd := I; - end; - - // update selection count - Inc(FSelectionCount, AddedNodesSize); - - // post process added nodes - for I := 0 to AddedNodesSize - 1 do - begin - PTmpNode := NewItems[I]; - //sync path note: on click, multi-select ctrl-click and draw selection - Include(PTmpNode.States, vsSelected); - // call on add event callbackevent - if Assigned(FOnAddToSelection) then - FOnAddToSelection(Self, PTmpNode); - if SyncCheckstateWithSelection[PTmpNode] then - checkstate[PTmpNode] := csCheckedNormal; - end; - - Assert(FSelectionCount = (lPreviousSelectedCount + NewLength), 'Fixing issue #487 seems to ahve caused a problem here.') - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InternalCacheNode(Node: PVirtualNode); - -// Adds the given node to the temporary node cache (used when collecting possibly large amounts of nodes). - -var - Len: Cardinal; - -begin - Len := Length(FTempNodeCache); - if FTempNodeCount = Len then - begin - if Len < 100 then - Len := 100 - else - Len := Len + Len div 10; - SetLength(FTempNodeCache, Len); - end; - FTempNodeCache[FTempNodeCount] := Node; - Inc(FTempNodeCount); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InternalClearSelection; - -var - Count: Integer; - -begin - // It is possible that there are invalid node references in the selection array - // if the tree update is locked and changes in the structure were made. - // Handle this potentially dangerous situation by packing the selection array explicitely. - if FUpdateCount > 0 then - begin - Count := PackArray(FSelection, FSelectionCount); - if Count > -1 then - begin - FSelectionCount := Count; - SetLength(FSelection, FSelectionCount); - end; - end; - - while FSelectionCount > 0 do - begin - Dec(FSelectionCount); - //sync path note: deselect when click on another or on outside area - Exclude(FSelection[FSelectionCount].States, vsSelected); - if SyncCheckstateWithSelection[FSelection[FSelectionCount]] then - checkstate[FSelection[FSelectionCount]] := csUncheckedNormal; - DoRemoveFromSelection(FSelection[FSelectionCount]); - end; - ResetRangeAnchor; - FSelection := nil; - DoStateChange([], [tsClearPending]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InternalConnectNode(Node, Destination: PVirtualNode; Target: TBaseVirtualTree; - Mode: TVTNodeAttachMode); - -// Connects Node with Destination depending on Mode. -// No error checking takes place. Node as well as Destination must be valid. Node must never be a root node and -// Destination must not be a root node if Mode is amInsertBefore or amInsertAfter. - -var - Run: PVirtualNode; - -begin - // Keep in mind that the destination node might belong to another tree. - with Target do - begin - case Mode of - amInsertBefore: - begin - Node.PrevSibling := Destination.PrevSibling; - Destination.PrevSibling := Node; - Node.NextSibling := Destination; - Node.Parent := Destination.Parent; - Node.Index := Destination.Index; - if Node.PrevSibling = nil then - Node.Parent.FirstChild := Node - else - Node.PrevSibling.NextSibling := Node; - - // reindex all following nodes - Run := Destination; - while Assigned(Run) do - begin - Inc(Run.Index); - Run := Run.NextSibling; - end; - end; - amInsertAfter: - begin - Node.NextSibling := Destination.NextSibling; - Destination.NextSibling := Node; - Node.PrevSibling := Destination; - Node.Parent := Destination.Parent; - if Node.NextSibling = nil then - Node.Parent.LastChild := Node - else - Node.NextSibling.PrevSibling := Node; - Node.Index := Destination.Index; - - // reindex all following nodes - Run := Node; - while Assigned(Run) do - begin - Inc(Run.Index); - Run := Run.NextSibling; - end; - end; - amAddChildFirst: - begin - if Assigned(Destination.FirstChild) then - begin - // If there's a first child then there must also be a last child. - Destination.FirstChild.PrevSibling := Node; - Node.NextSibling := Destination.FirstChild; - Destination.FirstChild := Node; - end - else - begin - // First child node at this location. - Destination.FirstChild := Node; - Destination.LastChild := Node; - Node.NextSibling := nil; - end; - Node.PrevSibling := nil; - Node.Parent := Destination; - Node.Index := 0; - // reindex all following nodes - Run := Node.NextSibling; - while Assigned(Run) do - begin - Inc(Run.Index); - Run := Run.NextSibling; - end; - end; - amAddChildLast: - begin - if Assigned(Destination.LastChild) then - begin - // If there's a last child then there must also be a first child. - Destination.LastChild.NextSibling := Node; - Node.PrevSibling := Destination.LastChild; - Destination.LastChild := Node; - end - else - begin - // first child node at this location - Destination.FirstChild := Node; - Destination.LastChild := Node; - Node.PrevSibling := nil; - end; - Node.NextSibling := nil; - Node.Parent := Destination; - if Assigned(Node.PrevSibling) then - Node.Index := Node.PrevSibling.Index + 1 - else - Node.Index := 0; - end; - else - // amNoWhere: do nothing - end; - // Remove temporary states. - Node.States := Node.States - [vsChecking, vsCutOrCopy, vsDeleting]; - - if (Mode <> amNoWhere) then begin - Inc(Node.Parent.ChildCount); - Include(Node.Parent.States, vsHasChildren); - AdjustTotalCount(Node.Parent, Node.TotalCount, True); - - // Add the new node's height only if its parent is expanded. - if (vsExpanded in Node.Parent.States) and (vsVisible in Node.States) then begin - AdjustTotalHeight(Node.Parent, Node.TotalHeight, True); - Inc(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); - end;//if - - // Update the hidden children flag of the parent. - if (Node.Parent <> FRoot) then - begin - // If we have added a visible node then simply remove the all-children-hidden flag. - if IsEffectivelyVisible[Node] then - Exclude(Node.Parent.States, vsAllChildrenHidden) - else begin - // If we have added an invisible node and this is the only child node then - // make sure the all-children-hidden flag is in a determined state. - // If there were child nodes before then no action is needed. - if Node.Parent.ChildCount = 1 then - Include(Node.Parent.States, vsAllChildrenHidden); - end;//else - end; //if Node.Parent <> FRoot - end;//if Mode <> amNoWhere - end;//With -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.InternalData(Node: PVirtualNode): Pointer; - -begin - Result := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InternalDisconnectNode(Node: PVirtualNode; KeepFocus: Boolean; Reindex: Boolean = True; ParentClearing: Boolean = False); - -// Disconnects the given node from its parent and siblings. The node's pointer are not reset so they can still be used -// after return from this method (probably a very short time only!). -// If KeepFocus is True then the focused node is not reset. This is useful if the given node is reconnected to the tree -// immediately after return of this method and should stay being the focused node if it was it before. -// Note: Node must not be nil or the root node. - -var - Parent, - Run: PVirtualNode; - Index: Integer; - AdjustHeight: Boolean; - -begin - Assert(Assigned(Node) and (Node <> FRoot), 'Node must neither be nil nor the root node.'); - - if (Node = FFocusedNode) and not KeepFocus then - begin - DoFocusNode(nil, False); - DoFocusChange(FFocusedNode, FFocusedColumn); - end; - - if Node = FRangeAnchor then - ResetRangeAnchor; - - // Update the hidden children flag of the parent. - if (Node.Parent <> FRoot) and not (ParentClearing) then - if FUpdateCount = 0 then - DetermineHiddenChildrenFlag(Node.Parent) - else - Include(FStates, tsUpdateHiddenChildrenNeeded); - - if not (vsDeleting in Node.States) then - begin - // Some states are only temporary so take them out. - Node.States := Node.States - [vsChecking]; - Parent := Node.Parent; - Dec(Parent.ChildCount); - AdjustHeight := (vsExpanded in Parent.States) and (vsVisible in Node.States); - if Parent.ChildCount = 0 then - begin - Parent.States := Parent.States - [vsAllChildrenHidden, vsHasChildren]; - if (Parent <> FRoot) and (vsExpanded in Parent.States) then - Exclude(Parent.States, vsExpanded); - end; - AdjustTotalCount(Parent, -Integer(Node.TotalCount), True); - if AdjustHeight then - AdjustTotalHeight(Parent, -Integer(Node.TotalHeight), True); - if FullyVisible[Node] then - Dec(FVisibleCount, CountVisibleChildren(Node) + Cardinal(IfThen(IsEffectivelyVisible[Node], 1))); - - if Assigned(Node.PrevSibling) then - Node.PrevSibling.NextSibling := Node.NextSibling - else - Parent.FirstChild := Node.NextSibling; - - if Assigned(Node.NextSibling) then - begin - Node.NextSibling.PrevSibling := Node.PrevSibling; - // Reindex all following nodes. - if Reindex then - begin - Run := Node.NextSibling; - Index := Node.Index; - while Assigned(Run) do - begin - Run.Index := Index; - Inc(Index); - Run := Run.NextSibling; - end; - end; - end - else - Parent.LastChild := Node.PrevSibling; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InternalRemoveFromSelection(Node: PVirtualNode); - -// Special version to mark a node to be no longer in the current selection. PackArray must -// be used to remove finally those entries. - -var - Index: Integer; - -begin - // Because pointers are always DWORD aligned we can simply increment all those - // which we want to have removed (see also PackArray) and still have the - // order in the list preserved. - if FindNodeInSelection(Node, Index, -1, -1) then - begin - //sync path note: deselect when overlapping drawselection is made - Exclude(Node.States, vsSelected); - if SyncCheckstateWithSelection[Node] then - checkstate[Node] := csUncheckedNormal; - Inc(PAnsiChar(FSelection[Index])); - DoRemoveFromSelection(Node); - AdviseChangeEvent(False, Node, crIgnore); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InvalidateCache; - -// Marks the cache as invalid. - -begin - DoStateChange([tsValidationNeeded], [tsUseCache]); - //ChangeTreeStatesAsync([csValidationNeeded], [csUseCache]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.MarkCutCopyNodes; - -// Sets the vsCutOrCopy style in every currently selected but not disabled node to indicate it is -// now part of a clipboard operation. - -var - Nodes: TNodeArray; - I: Integer; - -begin - Nodes := nil; - if FSelectionCount > 0 then - begin - // need the current selection sorted to exclude selected nodes which are children, grandchildren etc. of - // already selected nodes - Nodes := GetSortedSelection(False); - for I := 0 to High(Nodes) do - with Nodes[I]^ do - if not (vsDisabled in States) then - Include(States, vsCutOrCopy); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.Loaded; - -var - LastRootCount: Cardinal; - IsReadOnly: Boolean; - -begin - inherited; - - // Call RegisterDragDrop after all visual inheritance changes to MiscOptions have been applied. - if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) then - if HandleAllocated 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. - if (tsNeedRootCountUpdate in FStates) and (FRoot.ChildCount > 0) then - begin - DoStateChange([], [tsNeedRootCountUpdate]); - IsReadOnly := toReadOnly in FOptions.FMiscOptions; - Exclude(FOptions.FMiscOptions, toReadOnly); - LastRootCount := FRoot.ChildCount; - FRoot.ChildCount := 0; - BeginUpdate; - SetChildCount(FRoot, LastRootCount); - EndUpdate; - if IsReadOnly then - Include(FOptions.FMiscOptions, toReadOnly); - end; - - // Prevent the object inspector at design time from marking the header as being modified - // when auto resize is enabled. - Updating; - try - FHeader.UpdateMainColumn; - FHeader.FColumns.FixPositions; - if toAutoBidiColumnOrdering in FOptions.FAutoOptions then - FHeader.FColumns.ReorderColumns(UseRightToLeftAlignment); - // Because of the special recursion and update stopper when creating the window (or resizing it) - // we have to manually trigger the auto size calculation here. - if hsNeedScaling in FHeader.FStates then - FHeader.RescaleHeader - else - FHeader.RecalculateHeader; - if hoAutoResize in FHeader.FOptions then - FHeader.FColumns.AdjustAutoSize(InvalidColumn, True); - finally - Updated; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.MainColumnChanged; - -begin - DoCancelEdit; - - if Assigned(FAccessibleItem) then - NotifyWinEvent(EVENT_OBJECT_NAMECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.MouseMove(Shift: TShiftState; X, Y: Integer); - -var - R: TRect; - -begin - if tsNodeHeightTrackPending in FStates then - begin - // Remove hint if shown currently. - Application.CancelHint; - - // Stop wheel panning if active. - StopWheelPanning; - - // Stop timers - StopTimer(ExpandTimer); - StopTimer(EditTimer); - StopTimer(HeaderTimer); - StopTimer(ScrollTimer); - StopTimer(SearchTimer); - FSearchBuffer := ''; - FLastSearchNode := nil; - - DoStateChange([tsNodeHeightTracking], [tsScrollPending, tsScrolling, tsEditPending, tsOLEDragPending, tsVCLDragPending, - tsIncrementalSearching, tsNodeHeightTrackPending]); - end; - - if tsDrawSelPending in FStates then - begin - // Remove current selection in case the user clicked somewhere in the window (but not a node) - // and moved the mouse. - if CalculateSelectionRect(X, Y) then - begin - InvalidateRect(Handle, @FNewSelRect, False); - UpdateWindow(Handle); - if (Abs(FNewSelRect.Right - FNewSelRect.Left) > Mouse.DragThreshold) or - (Abs(FNewSelRect.Bottom - FNewSelRect.Top) > Mouse.DragThreshold) then - begin - if tsClearPending in FStates then - begin - DoStateChange([], [tsClearPending]); - ClearSelection; - end; - DoStateChange([tsDrawSelecting], [tsDrawSelPending]); - - // Reset to main column for multiselection. - FocusedColumn := FHeader.MainColumn; - - // The current rectangle may already include some node captions. Handle this. - if HandleDrawSelection(X, Y) then - InvalidateRect(Handle, nil, False); - end; - end; - end - else - begin - if tsNodeHeightTracking in FStates then - begin - // Handle height tracking. - if DoNodeHeightTracking(FHeightTrackNode, FHeightTrackColumn, FHeader.GetShiftState, - FHeightTrackPoint, Point(X, Y)) then - begin - // Avoid negative (or zero) node heights. - if FHeightTrackPoint.Y >= Y then - Y := FHeightTrackPoint.Y + 1; - SetNodeHeight(FHeightTrackNode, Y - FHeightTrackPoint.Y); - UpdateWindow(Handle); - Exit; - 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 - ( - ((Abs(FLastClickPos.X - X) >= FDragThreshold) and (X > 0)) or // Check >0 to fix issue #833 - ((Abs(FLastClickPos.Y - Y) >= FDragThreshold) and (Y > 0)) - ) - then - DoDragging(FLastClickPos) - else - begin - if CanAutoScroll then - DoAutoScroll(X, Y); - if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then - AdjustPanningCursor(X, Y); - if not IsMouseSelecting then - begin - HandleHotTrack(X, Y); - inherited MouseMove(Shift, X, Y); - end - else - begin - // Handle draw selection if required, but don't do the work twice if the - // auto scrolling code already cares about the selection. - if not (tsScrolling in FStates) and CalculateSelectionRect(X, Y) then - begin - // If something in the selection changed then invalidate the entire - // tree instead trying to figure out the display rects of all changed nodes. - if HandleDrawSelection(X, Y) then - InvalidateRect(Handle, nil, False) - else - begin - UnionRect(R, OrderRect(FNewSelRect), OrderRect(FLastSelRect)); - OffsetRect(R, -FEffectiveOffsetX, FOffsetY); - InvalidateRect(Handle, @R, False); - end; - UpdateWindow(Handle); - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.Notification(AComponent: TComponent; Operation: TOperation); - -begin - if (AComponent <> Self) and (Operation = opRemove) then - begin - // Check for components linked to the tree. - if AComponent = FImages then - begin - Images := nil; - if not (csDestroying in ComponentState) then - Invalidate; - end - else - if AComponent = FStateImages then - begin - StateImages := nil; - if not (csDestroying in ComponentState) then - Invalidate; - end - else - if AComponent = FCustomCheckImages then - begin - CustomCheckImages := nil; - FCheckImageKind := ckSystemDefault; - if not (csDestroying in ComponentState) then - Invalidate; - end - else - if AComponent = PopupMenu then - PopupMenu := nil - else - // Check for components linked to the header. - if Assigned(FHeader) then - begin - if AComponent = FHeader.FImages then - FHeader.Images := nil - else - if AComponent = FHeader.PopupMenu then - FHeader.PopupMenu := nil; - end; - end; - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.OriginalWMNCPaint(DC: HDC); - -// Unfortunately, the painting for the non-client area in TControl is not always correct and does also not consider -// existing clipping regions, so it has been modified here to take this into account. - -const - InnerStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENINNER, BDR_RAISEDINNER, 0); - OuterStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENOUTER, BDR_RAISEDOUTER, 0); - EdgeStyles: array[TBevelKind] of Integer = (0, 0, BF_SOFT, BF_FLAT); - Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0); - -var - RC, RW: TRect; - EdgeSize: Integer; - Size: TSize; - -begin - if (BevelKind <> bkNone) or (BorderWidth > 0) then - begin - RC := Rect(0, 0, Width, Height); - Size := GetBorderDimensions; - InflateRect(RC, Size.cx, Size.cy); - - RW := RC; - - if BevelKind <> bkNone then - begin - DrawEdge(DC, RC, InnerStyles[BevelInner] or OuterStyles[BevelOuter], Byte(BevelEdges) or EdgeStyles[BevelKind] or - Ctl3DStyles[Ctl3D]); - - EdgeSize := 0; - if BevelInner <> bvNone then - Inc(EdgeSize, BevelWidth); - if BevelOuter <> bvNone then - Inc(EdgeSize, BevelWidth); - with TWithSafeRect(RC) do - begin - if beLeft in BevelEdges then - Inc(Left, EdgeSize); - if beTop in BevelEdges then - Inc(Top, EdgeSize); - if beRight in BevelEdges then - Dec(Right, EdgeSize); - if beBottom in BevelEdges then - Dec(Bottom, EdgeSize); - end; - end; - - // Repaint only the part in the original clipping region and not yet drawn parts. - IntersectClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom); - - // Determine inner rectangle to exclude (RC corresponds then to the client area). - InflateRect(RC, -Integer(BorderWidth), -Integer(BorderWidth)); - - // Remove the inner rectangle. - ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom); - - // Erase parts not drawn. - Brush.Color := FColors.BorderColor; - Winapi.Windows.FillRect(DC, RW, Brush.Handle); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.Paint; - -// Window paint routine. Used when the tree window needs to be updated. - -var - Window: TRect; - Target: TPoint; - Temp: Integer; - Options: TVTInternalPaintOptions; - RTLOffset: Integer; - -begin - - Options := [poBackground, poColumnColor, poDrawFocusRect, poDrawDropMark, poDrawSelection, poGridLines]; - if UseRightToLeftAlignment and FHeader.UseColumns then - RTLOffset := ComputeRTLOffset(True) - else - RTLOffset := 0; - - // The update rect has already been filled in WMPaint, as it is the window's update rect, which gets - // reset when BeginPaint is called (in the ancestor). - // The difference to the DC's clipbox is that it is also valid with internal paint operations used - // e.g. by the Explorer while dragging, but show window content while dragging is disabled. - if not IsRectEmpty(FUpdateRect) then - begin - Temp := Header.Columns.GetVisibleFixedWidth; - if Temp = 0 then - begin - Window := FUpdateRect; - Target := Window.TopLeft; - - // The clipping rectangle is given in client coordinates of the window. We have to convert it into - // a sliding window of the tree image. - OffsetRect(Window, FEffectiveOffsetX - RTLOffset, -FOffsetY); - PaintTree(Canvas, Window, Target, Options); - end - else - begin - // First part, fixed columns - Window := ClientRect; - Window.Right := Temp; - Target := Window.TopLeft; - - OffsetRect(Window, -RTLOffset, -FOffsetY); - PaintTree(Canvas, Window, Target, Options); - - // Second part, other columns - Window := GetClientRect; - - if Temp > Window.Right then - Exit; - - Window.Left := Temp; - Target := Window.TopLeft; - - OffsetRect(Window, FEffectiveOffsetX - RTLOffset, -FOffsetY); - PaintTree(Canvas, Window, Target, Options); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.PaintCheckImage(Canvas: TCanvas; const ImageInfo: TVTImageInfo; Selected: Boolean); - -var - ForegroundColor: COLORREF; - R: TRect; - Details, lSizeDetails: TThemedElementDetails; - lSize: TSize; - Theme: HTHEME; -begin - with ImageInfo do - begin - if (tsUseThemes in FStates) and (FCheckImageKind = ckSystemDefault) then - begin - Details.Element := teButton; - case Index of - // ctRadioButton - 1 : Details := StyleServices.GetElementDetails(tbRadioButtonUncheckedNormal); - 2 : Details := StyleServices.GetElementDetails(tbRadioButtonUncheckedHot); - 3 : Details := StyleServices.GetElementDetails(tbRadioButtonUncheckedPressed); - 4 : Details := StyleServices.GetElementDetails(tbRadioButtonUncheckedDisabled); - 5 : Details := StyleServices.GetElementDetails(tbRadioButtonCheckedNormal); - 6 : Details := StyleServices.GetElementDetails(tbRadioButtonCheckedHot); - 7 : Details := StyleServices.GetElementDetails(tbRadioButtonCheckedPressed); - 8 : Details := StyleServices.GetElementDetails(tbRadioButtonCheckedDisabled); - // ct(TriState)CheckBox - 9 : Details := StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal); - 10 : Details := StyleServices.GetElementDetails(tbCheckBoxUncheckedHot); - 11 : Details := StyleServices.GetElementDetails(tbCheckBoxUncheckedPressed); - 12 : Details := StyleServices.GetElementDetails(tbCheckBoxUncheckedDisabled); - 13 : Details := StyleServices.GetElementDetails(tbCheckBoxCheckedNormal); - 14 : Details := StyleServices.GetElementDetails(tbCheckBoxCheckedHot); - 15 : Details := StyleServices.GetElementDetails(tbCheckBoxCheckedPressed); - 16 : Details := StyleServices.GetElementDetails(tbCheckBoxCheckedDisabled); - 17 : Details := StyleServices.GetElementDetails(tbCheckBoxMixedNormal); - 18 : Details := StyleServices.GetElementDetails(tbCheckBoxMixedHot); - 19 : Details := StyleServices.GetElementDetails(tbCheckBoxMixedPressed); - 20 : Details := StyleServices.GetElementDetails(tbCheckBoxMixedDisabled); - // ctButton - ckButtonNormal: Details := StyleServices.GetElementDetails(tbPushButtonNormal); - ckButtonHot: Details := StyleServices.GetElementDetails(tbPushButtonHot); - ckButtonPressed: Details := StyleServices.GetElementDetails(tbPushButtonPressed); - ckButtonDisabled: Details := StyleServices.GetElementDetails(tbPushButtonDisabled); - else - Details := StyleServices.GetElementDetails(tbButtonRoot); - end; - if StyleServices.IsSystemStyle {and not (Index in [ckButtonNormal..ckButtonDisabled])} then - begin - Theme := OpenThemeData(Handle, 'BUTTON'); - GetThemePartSize(Theme, Canvas.Handle, Details.Part, Details.State, nil, TS_TRUE, lSize); - if (Index in [ckButtonNormal..ckButtonDisabled]) then begin - lSizeDetails := StyleServices.GetElementDetails(tbCheckBoxCheckedNormal); // Size of dropdown button should be based on size of checkboxes - GetThemePartSize(Theme, Canvas.Handle, lSizeDetails.Part, lSizeDetails.State, nil, TS_TRUE, lSize); - // dropdown buttons should be slightly larger than checkboxes, see issue #887 - lSize.cx := Round(lSize.cx * 1.15); - lSize.cy := Round(lSize.cy * 1.1); - end; - R := Rect(XPos, YPos, XPos + lSize.cx, YPos + lSize.cy); - if (Index in [ckButtonNormal..ckButtonDisabled]) then - R.Offset(-1, 0); // Eliminate 1 pixel border around Windows themed button - DrawThemeBackground(Theme, Canvas.Handle, Details.Part, Details.State, R, nil); - CloseThemeData(Theme); - end - else - begin - if (Index in [ckButtonNormal..ckButtonDisabled]) or not StyleServices.GetElementSize(Canvas.Handle, Details, TElementSize.esActual, lSize) then begin - // radio buttons fail in RAD Studio 10 Seattle and lower, fallback to checkbox images. See issue #615 - if not StyleServices.GetElementSize(Canvas.Handle, StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal), TElementSize.esActual, lSize) then - lSize := TSize.Create(GetSystemMetrics(SM_CXMENUCHECK), GetSystemMetrics(SM_CYMENUCHECK)); - end;//if - R := Rect(XPos, YPos, XPos + lSize.cx, YPos + lSize.cy); - StyleServices.DrawElement(Canvas.Handle, Details, R); - //Canvas.Refresh; // Why is this needed? - end; - if (Index in [ckButtonNormal..ckButtonDisabled]) then begin - Canvas.Pen.Color := clGray; - // These constants have been determined by test using various themes and dpi-scalings - 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 - begin - if Selected and not Ghosted then - begin - if Focused or (toPopupMode in FOptions.FPaintOptions) then - ForegroundColor := ColorToRGB(FColors.FocusedSelectionColor) - else - ForegroundColor := ColorToRGB(FColors.UnfocusedSelectionColor); - end - else - ForegroundColor := GetRGBColor(BlendColor); - - ImageList_DrawEx(Handle, Index, Canvas.Handle, XPos, YPos, 0, 0, GetRGBColor(BkColor), ForegroundColor, - ILD_TRANSPARENT); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - - -procedure TBaseVirtualTree.PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean); -const - Style: array[TImageType] of Cardinal = (0, ILD_MASK); -var - ExtraStyle: Cardinal; - CutNode: Boolean; - PaintFocused: Boolean; - DrawEnabled: Boolean; - CustomOverlayDrawing: Boolean; // False if the built-in overloay drawing of TImageList should be used, True if custom drawing should take place. -begin - with PaintInfo do - begin - CutNode := (vsCutOrCopy in Node.States) and (tsCutPending in FStates); - PaintFocused := Focused or (toGhostedIfUnfocused in FOptions.FPaintOptions); - - // Since the overlay image must be specified together with the image to draw - // it is meaningfull to retrieve it in advance. - if DoOverlay then - GetImageIndex(PaintInfo, ikOverlay, iiOverlay) - else - PaintInfo.ImageInfo[iiOverlay].Index := -1; - - DrawEnabled := not (vsDisabled in Node.States) and Enabled; - with ImageInfo[ImageInfoIndex] do - begin - if (vsSelected in Node.States) and not(Ghosted or CutNode) then - begin - if PaintFocused or (toPopupMode in FOptions.FPaintOptions) then - Images.BlendColor := FColors.FocusedSelectionColor - else - Images.BlendColor := FColors.UnfocusedSelectionColor; - end - else - Images.BlendColor := Color; - - ExtraStyle := ILD_TRANSPARENT; - // If the user returned an index >= 15 then we cannot use the built-in overlay image drawing. - // Instead we do it manually. Also of the image list of the normal and the overlay icon is different, - // we can't use the built-in drawing. See issue #779. - if (ImageInfo[iiOverlay].Index > -1) then begin - CustomOverlayDrawing := (ImageInfo[iiOverlay].Index >= 15) or (ImageInfo[iiOverlay].Images <> ImageInfo[iiNormal].Images); - if not CustomOverlayDrawing then - ExtraStyle := ILD_TRANSPARENT or ILD_OVERLAYMASK and IndexToOverlayMask(ImageInfo[iiOverlay].Index + 1); - end - else - CustomOverlayDrawing := False; - - // Blend image if enabled and the tree has the focus (or ghosted images must be drawn also if unfocused) ... - if (toUseBlendedImages in FOptions.FPaintOptions) and PaintFocused - // ... and the image is ghosted... - and (Ghosted or - // ... or it is not the check image and the node is selected (but selection is not for the entire row)... - ((vsSelected in Node.States) and - not (toFullRowSelect in FOptions.FSelectionOptions) and - not (toGridExtensions in FOptions.FMiscOptions)) or - // ... or the node must be shown in cut mode. - CutNode) then - ExtraStyle := ExtraStyle or ILD_BLEND50; - - if (vsSelected in Node.States) and not Ghosted then - Images.BlendColor := clDefault; - - DrawImage(Images, Index, Canvas, XPos, YPos, Style[Images.ImageType] or ExtraStyle, DrawEnabled); - - // Now, draw the overlay. This circumnavigates limitations in the overlay mask index (it has to be 4 bits in size, - // anything larger will be truncated by the ILD_OVERLAYMASK). - // However this will only be done if the overlay image index is > 15, to avoid breaking code that relies - // on overlay image indices (e.g. when using system image lists). - if CustomOverlayDrawing then begin - ExtraStyle := ExtraStyle and not ILD_BLEND50; // Fixes issue #551 - // Note: XPos and YPos are those of the normal images. - DrawImage(ImageInfo[iiOverlay].Images, ImageInfo[iiOverlay].Index, Canvas, XPos, YPos, - Style[ImageInfo[iiOverlay].Images.ImageType] or ExtraStyle, DrawEnabled); - end;//if - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const R: TRect; - ButtonX, ButtonY: Integer; BidiMode: TBiDiMode); - -var - Bitmap: TBitmap; - XPos: Integer; - IsHot: Boolean; - IsSelected : boolean; - Theme: HTHEME; - Glyph: Integer; - State: Integer; - Pos: TRect; - -begin - IsHot := (FCurrentHotNode = Node) and FHotNodeButtonHit; - IsSelected := (vsSelected in Node.States); - - // Draw the node's plus/minus button according to the directionality. - if BidiMode = bdLeftToRight then - XPos := R.Left + ButtonX - else - XPos := R.Right - ButtonX - FPlusBM.Width; - - if (tsUseExplorerTheme in FStates) and not VclStyleEnabled then - begin - Glyph := IfThen(IsHot, TVP_HOTGLYPH, TVP_GLYPH); - State := IfThen(vsExpanded in Node.States, GLPS_OPENED, GLPS_CLOSED); - Pos := Rect(XPos, R.Top + ButtonY, XPos + FPlusBM.Width, R.Top + ButtonY + FPlusBM.Height); - Theme := OpenThemeData(Handle, 'TREEVIEW'); - DrawThemeBackground(Theme, Canvas.Handle, Glyph, State, Pos, nil); - CloseThemeData(Theme); - end - else - begin - if vsExpanded in Node.States then - begin - if IsHot then - begin - if IsSelected then - BitMap := FSelectedHotMinusBM - else - Bitmap := FHotMinusBM; - end - else - Bitmap := FMinusBM; - end - else - begin - if IsHot then - begin - if IsSelected then - BitMap := FSelectedHotPlusBM - else - Bitmap := FHotPlusBM; - end - else - Bitmap := FPlusBM; - end; - // Need to draw this masked. - Canvas.Draw(XPos, R.Top + ButtonY, Bitmap); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.PaintTreeLines(const PaintInfo: TVTPaintInfo; IndentSize: Integer; const LineImage: TLineImage); - -var - I: Integer; - XPos, - Offset: Integer; - NewStyles: TLineImage; - -begin - NewStyles := nil; - - with PaintInfo do - begin - if BidiMode = bdLeftToRight then - begin - XPos := CellRect.Left + PaintInfo.Offsets[ofsMargin]; - Offset := FIndent; - end - else - begin - Offset := -Integer(FIndent); - XPos := CellRect.Right - PaintInfo.Offsets[ofsMargin] + Offset; - end; - - case FLineMode of - lmBands: - if poGridLines in PaintInfo.PaintOptions then - begin - // Convert the line images in correct bands. - SetLength(NewStyles, Length(LineImage)); - for I := IndentSize - 1 downto 0 do - begin - if (vsExpanded in Node.States) and not (vsAllChildrenHidden in Node.States) then - NewStyles[I] := ltLeft - else - case LineImage[I] of - ltRight, - ltBottomRight, - ltTopDownRight, - ltTopRight: - NewStyles[I] := ltLeftBottom; - ltNone: - // Have to take over the image to the right of this one. A no line entry can never appear as - // last entry so I don't need an end check here. - if LineImage[I + 1] in [ltNone, ltTopRight] then - NewStyles[I] := NewStyles[I + 1] - else - NewStyles[I] := ltLeft; - ltTopDown: - // Have to check the image to the right of this one. A top down line can never appear as - // last entry so I don't need an end check here. - if LineImage[I + 1] in [ltNone, ltTopRight] then - NewStyles[I] := NewStyles[I + 1] - else - NewStyles[I] := ltLeft; - end; - end; - - PaintInfo.Canvas.Font.Color := FColors.GridLineColor; - for I := 0 to IndentSize - 1 do - begin - DoBeforeDrawLineImage(PaintInfo.Node, I + Ord(not (toShowRoot in TreeOptions.PaintOptions)), XPos); - DrawLineImage(PaintInfo, XPos, CellRect.Top, NodeHeight[Node] - 1, VAlign - 1, NewStyles[I], - BidiMode <> bdLeftToRight); - Inc(XPos, Offset); - end; - end; - else // lmNormal - PaintInfo.Canvas.Font.Color := FColors.TreeLineColor; - for I := 0 to IndentSize - 1 do - begin - DoBeforeDrawLineImage(PaintInfo.Node, I + Ord(not (toShowRoot in TreeOptions.PaintOptions)), XPos); - DrawLineImage(PaintInfo, XPos, CellRect.Top, NodeHeight[Node], VAlign - 1, LineImage[I], - BidiMode <> bdLeftToRight); - Inc(XPos, Offset); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.PaintSelectionRectangle(Target: TCanvas; WindowOrgX: Integer; const SelectionRect: TRect; - TargetRect: TRect); - -// Helper routine to draw a selection rectangle in the mode determined by DrawSelectionMode. - -var - BlendRect: TRect; - TextColorBackup, - BackColorBackup: COLORREF; // used to restore forground and background colors when drawing a selection rectangle - -begin - if ((FDrawSelectionMode = smDottedRectangle) and not (tsUseThemes in FStates)) then - begin - // Classical selection rectangle using dotted borderlines. - TextColorBackup := GetTextColor(Target.Handle); - SetTextColor(Target.Handle, $FFFFFF); - BackColorBackup := GetBkColor(Target.Handle); - SetBkColor(Target.Handle, 0); - Target.DrawFocusRect(SelectionRect); - SetTextColor(Target.Handle, TextColorBackup); - SetBkColor(Target.Handle, BackColorBackup); - end - else - begin - // Modern alpha blended style. - OffsetRect(TargetRect, WindowOrgX, 0); - if IntersectRect(BlendRect, OrderRect(SelectionRect), TargetRect) then - begin - OffsetRect(BlendRect, -WindowOrgX, 0); - AlphaBlend(0, Target.Handle, BlendRect, Point(0, 0), bmConstantAlphaAndColor, FSelectionBlendFactor, - ColorToRGB(FColors.SelectionRectangleBlendColor)); - - Target.Brush.Color := FColors.SelectionRectangleBorderColor; - Target.FrameRect(SelectionRect); - end; - end; -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: Integer); - -// This method is called immediately before a cell's content is drawn und is responsible to paint selection colors etc. - -var - TextColorBackup, - BackColorBackup: COLORREF; - FocusRect, - InnerRect: TRect; - RowRect: TRect; - Theme: HTHEME; -const - TREIS_HOTSELECTED = 6; - - //--------------- local functions ------------------------------------------- - - procedure AlphaBlendSelection(Color: TColor); - - var - R: TRect; - - begin - // Take into account any window offset and size limitations in the target bitmap, as this is only as large - // as necessary and might not cover the whole node. For normal painting this does not matter (because of - // clipping) but for the MMX code there is no such check and it will crash badly when bitmap boundaries are - // crossed. - R := InnerRect; - OffsetRect(R, -WindowOrgX, 0); - if R.Left < 0 then - R.Left := 0; - if R.Right > MaxWidth then - R.Right := MaxWidth; - AlphaBlend(0, PaintInfo.Canvas.Handle, R, Point(0, 0), bmConstantAlphaAndColor, - FSelectionBlendFactor, ColorToRGB(Color)); - end; - - //--------------------------------------------------------------------------- - - procedure DrawBackground(State: Integer); - begin - // if the full row selection is disabled or toGridExtensions is in the MiscOptions, draw the selection - // into the InnerRect, otherwise into the RowRect - if not (toFullRowSelect in FOptions.FSelectionOptions) or (toGridExtensions in FOptions.FMiscOptions) then - DrawThemeBackground(Theme, PaintInfo.Canvas.Handle, TVP_TREEITEM, State, InnerRect, nil) - else - DrawThemeBackground(Theme, PaintInfo.Canvas.Handle, TVP_TREEITEM, State, RowRect, nil); - end; - - procedure DrawThemedFocusRect(State: Integer); - var - Theme: HTHEME; - begin - Theme := OpenThemeData(Application.ActiveFormHandle, 'Explorer::ItemsView'); - if not (toFullRowSelect in FOptions.FSelectionOptions) or (toGridExtensions in FOptions.FMiscOptions) then - DrawThemeBackground(Theme, PaintInfo.Canvas.Handle, LVP_LISTDETAIL, State, InnerRect, nil) - else - DrawThemeBackground(Theme, PaintInfo.Canvas.Handle, LVP_LISTDETAIL, State, RowRect, nil); - CloseThemeData(Theme); - end; - - //--------------- end local functions --------------------------------------- - -begin - if tsUseExplorerTheme in FStates then - begin - Theme := OpenThemeData(Application.ActiveFormHandle, 'Explorer::TreeView'); - RowRect := Rect(0, PaintInfo.CellRect.Top, FRangeX, PaintInfo.CellRect.Bottom); - if (Header.Columns.Count = 0) and (toFullRowSelect in TreeOptions.SelectionOptions) then - RowRect.Right := Max(ClientWidth, RowRect.Right); - if toShowVertGridLines in FOptions.PaintOptions then - Dec(RowRect.Right); - end; - - with PaintInfo, Canvas do - begin - // Fill cell background if its color differs from tree background. - with FHeader.FColumns do - if poColumnColor in PaintOptions then - begin - Brush.Color := Items[Column].GetEffectiveColor; - FillRect(CellRect); - end; - - // Let the application customize the cell background and the content rectangle. - DoBeforeCellPaint(Canvas, Node, Column, cpmPaint, CellRect, ContentRect); - - InnerRect := ContentRect; - - // The selection rectangle depends on alignment. - if not (toGridExtensions in FOptions.FMiscOptions) then - begin - case Alignment of - taLeftJustify: - with TWithSafeRect(InnerRect) do - if Left + NodeWidth < Right then - Right := Left + NodeWidth; - taCenter: - with TWithSafeRect(InnerRect) do - if (Right - Left) > NodeWidth then - begin - Left := (Left + Right - NodeWidth) div 2; - Right := Left + NodeWidth; - end; - taRightJustify: - with TWithSafeRect(InnerRect) do - if (Right - Left) > NodeWidth then - Left := Right - NodeWidth; - end; - end; - - if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.FSelectionOptions) then - begin - // Fill the selection rectangle. - if poDrawSelection in PaintOptions then - begin - if Node = FDropTargetNode then - begin - if (FLastDropMode = dmOnNode) or (vsSelected in Node.States) then - begin - Brush.Color := FColors.DropTargetColor; - Pen.Color := FColors.DropTargetBorderColor; - - if (toGridExtensions in FOptions.FMiscOptions) or - (toFullRowSelect in FOptions.FSelectionOptions) then - InnerRect := CellRect; - if not IsRectEmpty(InnerRect) then - if tsUseExplorerTheme in FStates then - DrawBackground(TREIS_SELECTED) - else - if (toUseBlendedSelection in FOptions.PaintOptions) then - AlphaBlendSelection(Brush.Color) - else - with TWithSafeRect(InnerRect) do - RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); - end - else - begin - Brush.Style := bsClear; - end; - end - else - if vsSelected in Node.States then - begin - if Focused or (toPopupMode in FOptions.FPaintOptions) then - begin - Brush.Color := FColors.FocusedSelectionColor; - Pen.Color := FColors.FocusedSelectionBorderColor; - end - else - begin - Brush.Color := FColors.UnfocusedSelectionColor; - Pen.Color := FColors.UnfocusedSelectionBorderColor; - end; - if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then - InnerRect := CellRect; - if not IsRectEmpty(InnerRect) then - if tsUseExplorerTheme in FStates then - begin - // If the node is also hot, its background will be drawn later. - if not (toHotTrack in FOptions.FPaintOptions) or (Node <> FCurrentHotNode) or - ((Column <> FCurrentHotColumn) and not (toFullRowSelect in FOptions.FSelectionOptions)) then - DrawBackground(IfThen(Self.Focused, TREIS_SELECTED, TREIS_SELECTEDNOTFOCUS)); - end - else - if (toUseBlendedSelection in FOptions.PaintOptions) then - AlphaBlendSelection(Brush.Color) - else - with TWithSafeRect(InnerRect) do - RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); - end; - end; - end; - - if (tsUseExplorerTheme in FStates) and (toHotTrack in FOptions.FPaintOptions) and (Node = FCurrentHotNode) and - ((Column = FCurrentHotColumn) or (toFullRowSelect in FOptions.FSelectionOptions)) then - DrawBackground(IfThen((vsSelected in Node.States) and not (toAlwaysHideSelection in FOptions.FPaintOptions), - TREIS_HOTSELECTED, TREIS_HOT)); - - if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.FSelectionOptions) then - begin - // draw focus rect - if (poDrawFocusRect in PaintOptions) and - (Focused or (toPopupMode in FOptions.FPaintOptions)) and (FFocusedNode = Node) and - ( (Column = FFocusedColumn) or - ((not (toExtendedFocus in FOptions.FSelectionOptions) or IsWinVistaOrAbove) and - (toFullRowSelect in FOptions.FSelectionOptions) and - (tsUseExplorerTheme in FStates) ) ) then - begin - TextColorBackup := GetTextColor(Handle); - SetTextColor(Handle, $FFFFFF); - BackColorBackup := GetBkColor(Handle); - SetBkColor(Handle, 0); - - if not (toExtendedFocus in FOptions.FSelectionOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and - (tsUseExplorerTheme in FStates) then - FocusRect := RowRect - else - if toGridExtensions in FOptions.FMiscOptions then - FocusRect := CellRect - else - FocusRect := InnerRect; - - if tsUseExplorerTheme in FStates then - InflateRect(FocusRect, -1, -1); - - if (tsUseExplorerTheme in FStates) and IsWinVistaOrAbove then - begin - //Draw focused unselected style like Windows 7 Explorer - if not (vsSelected in Node.States) then - DrawThemedFocusRect(LIS_NORMAL) - else - DrawBackground(TREIS_HOTSELECTED); - end - else - Winapi.Windows.DrawFocusRect(Handle, FocusRect); - SetTextColor(Handle, TextColorBackup); - SetBkColor(Handle, BackColorBackup); - end; - end; - end; - - if tsUseExplorerTheme in FStates then - CloseThemeData(Theme); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, - ChunkSize: Integer): Boolean; - -// Called while loading a tree structure, Node is already valid (allocated) at this point. -// The function handles the base and user chunks, any other chunk is marked as being unknown (result becomes False) -// and skipped. descendants may handle them by overriding this method. -// Returns True if the chunk could be handled, otherwise False. -type - TAdvancedVersion2Identifier = packed record - ChildCount, - NodeHeight: Cardinal; - States: Word; - Align: Byte; - CheckState: TCheckState; - CheckType: TCheckType; - Reserved: Cardinal; - end; - -var - IdBody: TAdvancedVersion2Identifier; - ChunkBody: TBaseChunkBody; - Run: PVirtualNode; - LastPosition: Integer; - -begin - case ChunkType of - BaseChunk: - begin - // Load base chunk's body (chunk header has already been consumed). - case Version of - 1: - begin - with ChunkBody do - begin - // In version prior to 2 there was a smaller chunk body. Hence we have to read it entry by entry now. - Stream.Read(ChildCount, SizeOf(ChildCount)); - Stream.Read(NodeHeight, SizeOf(NodeHeight)); - // TVirtualNodeStates was a byte sized type in version 1. - States := []; - Stream.Read(States, SizeOf(Byte)); - // vsVisible is now in the place where vsSelected was before, but every node was visible in the old version - // so we need to fix this too. - if vsVisible in States then - //sync path note: prior version stream reading, ignored for syncing - Include(States, vsSelected) - else - Include(States, vsVisible); - Stream.Read(Align, SizeOf(Align)); - Stream.Read(CheckState, SizeOf(CheckState)); - Stream.Read(CheckType, SizeOf(CheckType)); - end; - end; - 2: - begin - ZeroMemory(@IdBody, SizeOf(IdBody)); - Stream.Read(IdBody, SizeOf(IdBody)); - // If Align is greater than zero, we have a stream prior to VT version 6.2 - if IdBody.Align > 0 then - with ChunkBody do - begin - ChildCount := IdBody.ChildCount; - NodeHeight := IdBody.NodeHeight; - States := []; - Move(IdBody.States, States, SizeOf(IdBody.States)); - CheckState := IdBody.CheckState; - CheckType := IdBody.CheckType; - Reserved := IdBody.Reserved; - end - else - begin - // Stream is compatible with current size of TBaseChunkBody - Stream.Position := Stream.Position - SizeOf(IdBody); - Stream.Read(ChunkBody, SizeOf(ChunkBody)); - end; - end; - 3: - Stream.Read(ChunkBody, SizeOf(ChunkBody)); - end; - - with Node^ do - begin - // Set states first, in case the node is invisible. - States := ChunkBody.States; - NodeHeight := ChunkBody.NodeHeight; - TotalHeight := NodeHeight; - Align := ChunkBody.Align; - CheckState := ChunkBody.CheckState; - CheckType := ChunkBody.CheckType; - ChildCount := ChunkBody.ChildCount; - - // Create and read child nodes. - while ChunkBody.ChildCount > 0 do - begin - Run := MakeNewNode; - - Run.PrevSibling := Node.LastChild; - if Assigned(Run.PrevSibling) then - Run.Index := Run.PrevSibling.Index + 1; - if Assigned(Node.LastChild) then - Node.LastChild.NextSibling := Run - else - Node.FirstChild := Run; - Node.LastChild := Run; - Run.Parent := Node; - - ReadNode(Stream, Version, Run); - Dec(ChunkBody.ChildCount); - end; - end; - Result := True; - end; - UserChunk: - if ChunkSize > 0 then - begin - // need to know whether the data was read - LastPosition := Stream.Position; - DoLoadUserData(Node, Stream); - // compare stream position to learn whether the data was read - Result := Stream.Position > LastPosition; - // Improve stability by advancing the stream to the chunk's real end if - // the application did not read what has been written. - if not Result or (Stream.Position <> (LastPosition + ChunkSize)) then - Stream.Position := LastPosition + ChunkSize; - end - else - Result := True; - else - // unknown chunk, skip it - Stream.Position := Stream.Position + ChunkSize; - Result := False; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ReadNode(Stream: TStream; Version: Integer; Node: PVirtualNode); - -// Reads the anchor chunk of each node and initiates reading the sub chunks for this node - -var - Header: TChunkHeader; - EndPosition: Integer; - -begin - with Stream do - begin - // Read anchor chunk of the node. - Stream.Read(Header, SizeOf(Header)); - if Header.ChunkType = NodeChunk then - begin - EndPosition := Stream.Position + Header.ChunkSize; - // Read all subchunks until the indicated chunk end position is reached in the stream. - while Position < EndPosition do - begin - // Read new chunk header. - Stream.Read(Header, SizeOf(Header)); - ReadChunk(Stream, Version, Node, Header.ChunkType, Header.ChunkSize); - end; - // If the last chunk does not end at the given end position then there is something wrong. - if Position <> EndPosition then - ShowError(SCorruptStream2, hcTFCorruptStream2); - end - else - ShowError(SCorruptStream1, hcTFCorruptStream1); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.RedirectFontChangeEvent(Canvas: TCanvas); - -begin - if @Canvas.Font.OnChange <> @FOldFontChange then - begin - FOldFontChange := Canvas.Font.OnChange; - Canvas.Font.OnChange := FontChanged; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.RemoveFromSelection(Node: PVirtualNode); - -var - Index: Integer; - -begin - if not FSelectionLocked then - begin - Assert(Assigned(Node), 'Node must not be nil!'); - Assert(GetCurrentThreadId = MainThreadId, Self.Classname + '.RemoveFromSelection() must only be called from UI thread.'); - if vsSelected in Node.States then - begin - Assert(FSelectionCount > 0, 'if one node has set the vsSelected flag, SelectionCount must be >0.'); - //sync path note: deselect when a ctrl click removes a selection - Exclude(Node.States, vsSelected); - if SyncCheckstateWithSelection[Node] then - checkstate[Node] := csUncheckedNormal; - - if FindNodeInSelection(Node, Index, -1, -1) and (Index < FSelectionCount - 1) then - Move(FSelection[Index + 1], FSelection[Index], (FSelectionCount - Index - 1) * SizeOf(Pointer)); - if FSelectionCount > 0 then - Dec(FSelectionCount); - SetLength(FSelection, FSelectionCount); - - if FSelectionCount = 0 then - ResetRangeAnchor; - - if FSelectionCount <= 1 then - UpdateNextNodeToSelect(Node); - - DoRemoveFromSelection(Node); - InvalidateNode(Node); - Change(Node); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateNextNodeToSelect(Node: PVirtualNode); - -// save a potential node to select after the currently selected node will be deleted. -// This will make the VT to behave more like the Win32 TreeView, which always selecta a new node if the currently -// selected one gets deleted. - -begin - if not (toAlwaysSelectNode in TreeOptions.SelectionOptions) then - Exit; - if GetNextSibling(Node) <> nil then - FNextNodeToSelect := GetNextSibling(Node) - else if GetPreviousSibling(Node) <> nil then - FNextNodeToSelect := GetPreviousSibling(Node) - else if Node.Parent <> FRoot then - FNextNodeToSelect := Node.Parent - else - FNextNodeToSelect := nil; -end;//if Assigned(Node); - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium; - ForClipboard: Boolean): HResult; - -// Returns a memory expression of all currently selected nodes in the Medium structure. -// Note: The memory requirement of this method might be very high. This depends however on the requested storage format. -// For HGlobal (a global memory block) we need to render first all nodes to local memory and copy this then to -// the global memory in Medium. This is necessary because we have first to determine how much -// memory is needed before we can allocate it. Hence for a short moment we need twice the space as used by the -// nodes alone (plus the amount the nodes need in the tree anyway)! -// With IStream this does not happen. We directly stream out the nodes and pass the constructed stream along. - - //--------------- local function -------------------------------------------- - - procedure WriteNodes(Stream: TStream); - - var - Selection: TNodeArray; - I: Integer; - - begin - if ForClipboard then - Selection := GetSortedCutCopySet(True) - else - Selection := GetSortedSelection(True); - for I := 0 to High(Selection) do - WriteNode(Stream, Selection[I]); - end; - - //--------------- end local function ---------------------------------------- - -var - Data: PCardinal; - ResPointer: Pointer; - ResSize: Integer; - OLEStream: IStream; - VCLStream: TStream; - -begin - ZeroMemory (@Medium, SizeOf(Medium)); - - // We can render the native clipboard format in two different storage media. - if (FormatEtcIn.cfFormat = CF_VIRTUALTREE) and (FormatEtcIn.tymed and (TYMED_HGLOBAL or TYMED_ISTREAM) <> 0) then - begin - VCLStream := nil; - try - Medium.unkForRelease := nil; - // Return data in one of the supported storage formats, prefer IStream. - if FormatEtcIn.tymed and TYMED_ISTREAM <> 0 then - begin - // Create an IStream on a memory handle (here it is 0 which indicates to implicitely allocated a handle). - // Do not use TStreamAdapter as it is not compatible with OLE (when flushing the clipboard OLE wants the HGlobal - // back which is not supported by TStreamAdapater). - CreateStreamOnHGlobal(0, True, OLEStream); - VCLStream := TOLEStream.Create(OLEStream); - WriteNodes(VCLStream); - // Rewind stream. - VCLStream.Position := 0; - Medium.tymed := TYMED_ISTREAM; - IUnknown(Medium.stm) := OLEStream; - Result := S_OK; - end - else - begin - VCLStream := TMemoryStream.Create; - WriteNodes(VCLStream); - ResPointer := TMemoryStream(VCLStream).Memory; - ResSize := VCLStream.Position; - - // Allocate memory to hold the string. - if ResSize > 0 then - begin - Medium.hGlobal := GlobalAlloc(GHND or GMEM_SHARE, ResSize + SizeOf(Cardinal)); - Data := GlobalLock(Medium.hGlobal); - // Store the size of the data too, for easy retrival. - Data^ := ResSize; - Inc(Data); - Move(ResPointer^, Data^, ResSize); - GlobalUnlock(Medium.hGlobal); - Medium.tymed := TYMED_HGLOBAL; - - Result := S_OK; - end - else - Result := E_FAIL; - end; - finally - // We can free the VCL stream here since it was either a pure memory stream or only a wrapper around - // the OLEStream which exists independently. - VCLStream.Free; - end; - end - else // Ask application descendants to render self defined formats. - Result := DoRenderOLEData(FormatEtcIn, Medium, ForClipboard); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ResetRangeAnchor; - -// Called when there is no selected node anymore and the selection range anchor needs a new value. - -begin - FRangeAnchor := FFocusedNode; - FLastSelectionLevel := -1; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.RestoreFontChangeEvent(Canvas: TCanvas); - -begin - Canvas.Font.OnChange := FOldFontChange; - FOldFontChange := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SelectNodes(StartNode, EndNode: PVirtualNode; AddOnly: Boolean); - -// Selects a range of nodes and unselects all other eventually selected nodes which are not in this range if -// AddOnly is False. -// EndNode must be visible while StartNode does not necessarily as in the case where the last focused node is the start -// node but it is a child of a node which has been collapsed previously. In this case the first visible parent node -// is used as start node. StartNode can be nil in which case the very first node in the tree is used. - -var - NodeFrom, - NodeTo, - LastAnchor: PVirtualNode; - Index: Integer; - -begin - Assert(Assigned(EndNode), 'EndNode must not be nil!'); - if not FSelectionLocked then - begin - ClearTempCache; - if StartNode = nil then - StartNode := GetFirstVisibleNoInit(nil, True) - else - if not FullyVisible[StartNode] then - begin - StartNode := GetPreviousVisible(StartNode, True); - if StartNode = nil then - StartNode := GetFirstVisibleNoInit(nil, True); - end; - - if CompareNodePositions(StartNode, EndNode, True) < 0 then - begin - NodeFrom := StartNode; - NodeTo := EndNode; - end - else - begin - NodeFrom := EndNode; - NodeTo := StartNode; - end; - - // The range anchor will be reset by the following call. - LastAnchor := FRangeAnchor; - if not AddOnly then - InternalClearSelection; - - while NodeFrom <> NodeTo do - begin - InternalCacheNode(NodeFrom); - NodeFrom := GetNextVisible(NodeFrom, True); - end; - // select last node too - InternalCacheNode(NodeFrom); - // now add them all in "one" step - AddToSelection(FTempNodeCache, FTempNodeCount); - ClearTempCache; - if Assigned(LastAnchor) and FindNodeInSelection(LastAnchor, Index, -1, -1) then - FRangeAnchor := LastAnchor; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SetFocusedNodeAndColumn(Node: PVirtualNode; Column: TColumnIndex); - -var - OldColumn: TColumnIndex; - WasDifferent: Boolean; - -begin - if not FHeader.AllowFocus(Column) then - Column := FFocusedColumn; - - WasDifferent := (Node <> FFocusedNode) or (Column <> FFocusedColumn); - - OldColumn := FFocusedColumn; - FFocusedColumn := Column; - - DoFocusNode(Node, True); - - // Check if the change was accepted. - if FFocusedNode = Node then - begin - CancelEditNode; - if WasDifferent then - DoFocusChange(FFocusedNode, FFocusedColumn); - end - else - // If the user did not accept the new cell to focus then set also the focused column back - // to its original state. - FFocusedColumn := OldColumn; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SkipNode(Stream: TStream); - -// Skips the data for the next node in the given stream (including the child nodes). - -var - Header: TChunkHeader; - -begin - with Stream do - begin - // read achor chunk of the node - Stream.Read(Header, SizeOf(Header)); - if Header.ChunkType = NodeChunk then - Stream.Position := Stream.Position + Header.ChunkSize - else - ShowError(SCorruptStream1, hcTFCorruptStream1); - end; -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. - - var - Start, X, Y: Integer; - Temp: HRGN; - - begin - Assert(not FPanningImage.Empty, 'Invalid wheel panning image.'); - - // 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; - end; - // The resulting region is used as window region so we must not delete it. - // Windows will own it after the assignment below. - end; - - //--------------- end local function ---------------------------------------- - -var - TempClass: TWndClass; - ClassRegistered: Boolean; - ImageName: string; - 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]); - - // 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; - if Integer(FRangeX) > ClientWidth then - begin - if Integer(FRangeY) > ClientHeight then - ImageName := 'VT_MOVEALL' - else - ImageName := 'VT_MOVEEW'; - end - else - ImageName := 'VT_MOVENS'; - FPanningImage.LoadFromResourceName(HInstance, ImageName); - SetWindowRgn(FPanningWindow, CreateClipRegion, False); - - {$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); - - // Setup the panscroll timer and capture all mouse input. - SetFocus; - SetCapture(Handle); - SetTimer(Handle, ScrollTimer, 20, nil); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.StopWheelPanning; - -// Stops panning if currently active and destroys the helper window. - -var - Instance: Pointer; - -begin - if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then - begin - // Release the mouse capture and stop the panscroll timer. - StopTimer(ScrollTimer); - ReleaseCapture; - DoStateChange([], [tsWheelPanning, tsWheelScrolling]); - - // 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; - DeleteObject(FPanningCursor); - FPanningCursor := 0; - Winapi.Windows.SetCursor(Screen.Cursors[Cursor]); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.StructureChange(Node: PVirtualNode; Reason: TChangeReason); - -begin - AdviseChangeEvent(True, Node, Reason); - - if FUpdateCount = 0 then - begin - if (FChangeDelay > 0) and HandleAllocated and not (tsSynchMode in FStates) then - SetTimer(Handle, StructureChangeTimer, FChangeDelay, nil) - else - DoStructureChange(Node, Reason); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.SuggestDropEffect(Source: TObject; Shift: TShiftState; Pt: TPoint; - AllowedEffects: Integer): Integer; - -// determines the drop action to take if the drag'n drop operation ends on this tree -// Note: Source can be any Delphi object not just a virtual tree - -begin - Result := AllowedEffects; - - // prefer MOVE if source and target are the same control, otherwise whatever is allowed as initial value - if Assigned(Source) and (Source = Self) then - if (AllowedEffects and DROPEFFECT_MOVE) <> 0 then - Result := DROPEFFECT_MOVE - else // no change - else - // drag between different applicatons - if (AllowedEffects and DROPEFFECT_COPY) <> 0 then - Result := DROPEFFECT_COPY; - - // consider modifier keys and what is allowed at the moment, if none of the following conditions apply then - // the initial value just set is used - if ssCtrl in Shift then - begin - // copy or link - if ssShift in Shift then - begin - // link - if (AllowedEffects and DROPEFFECT_LINK) <> 0 then - Result := DROPEFFECT_LINK; - end - else - begin - // copy - if (AllowedEffects and DROPEFFECT_COPY) <> 0 then - Result := DROPEFFECT_COPY; - end; - end - else - begin - // move, link or default - if ssShift in Shift then - begin - // move - if (AllowedEffects and DROPEFFECT_MOVE) <> 0 then - Result := DROPEFFECT_MOVE; - end - else - begin - // link or default - if ssAlt in Shift then - begin - // link - if (AllowedEffects and DROPEFFECT_LINK) <> 0 then - Result := DROPEFFECT_LINK; - end; - // else default - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ToggleSelection(StartNode, EndNode: PVirtualNode); - -// Switchs the selection state of a range of nodes. -// Note: This method is specifically designed to help selecting ranges with the keyboard and considers therefore -// the range anchor. - -var - NodeFrom, - NodeTo: PVirtualNode; - NewSize: Integer; - Position: Integer; - -begin - if not FSelectionLocked then - begin - Assert(Assigned(EndNode), 'EndNode must not be nil!'); - if StartNode = nil then - StartNode := FRoot.FirstChild - else - if not FullyVisible[StartNode] then - StartNode := GetPreviousVisible(StartNode, True); - - Position := CompareNodePositions(StartNode, EndNode); - // nothing to do if start and end node are the same - if Position <> 0 then - begin - if Position < 0 then - begin - NodeFrom := StartNode; - NodeTo := EndNode; - end - else - begin - NodeFrom := EndNode; - NodeTo := StartNode; - end; - - ClearTempCache; - - // 1) toggle the start node if it is before the range anchor - if CompareNodePositions(NodeFrom, FRangeAnchor) < 0 then - if not (vsSelected in NodeFrom.States) then - InternalCacheNode(NodeFrom) - else - InternalRemoveFromSelection(NodeFrom); - - // 2) toggle all nodes within the range - NodeFrom := GetNextVisible(NodeFrom, True); - while NodeFrom <> NodeTo do - begin - if not (vsSelected in NodeFrom.States) then - InternalCacheNode(NodeFrom) - else - InternalRemoveFromSelection(NodeFrom); - NodeFrom := GetNextVisible(NodeFrom, True); - end; - - // 3) toggle end node if it is after the range anchor - if CompareNodePositions(NodeFrom, FRangeAnchor) > 0 then - if not (vsSelected in NodeFrom.States) then - InternalCacheNode(NodeFrom) - else - InternalRemoveFromSelection(NodeFrom); - - // Do some housekeeping if there was a change. - NewSize := PackArray(FSelection, FSelectionCount); - if NewSize > -1 then - begin - FSelectionCount := NewSize; - SetLength(FSelection, FSelectionCount); - end; - // If the range went over the anchor then we need to reselect it. - if not (vsSelected in FRangeAnchor.States) then - InternalCacheNode(FRangeAnchor); - if FTempNodeCount > 0 then - AddToSelection(FTempNodeCache, FTempNodeCount); - ClearTempCache; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UnselectNodes(StartNode, EndNode: PVirtualNode); - -// Deselects a range of nodes. -// EndNode must be visible while StartNode must not as in the case where the last focused node is the start node -// but it is a child of a node which has been collapsed previously. In this case the first visible parent node -// is used as start node. StartNode can be nil in which case the very first node in the tree is used. - -var - NodeFrom, - NodeTo: PVirtualNode; - NewSize: Integer; - -begin - if not FSelectionLocked then - begin - Assert(Assigned(EndNode), 'EndNode must not be nil!'); - - if StartNode = nil then - StartNode := FRoot.FirstChild - else - if not FullyVisible[StartNode] then - begin - StartNode := GetPreviousVisible(StartNode, True); - if StartNode = nil then - StartNode := FRoot.FirstChild; - end; - - if CompareNodePositions(StartNode, EndNode) < 0 then - begin - NodeFrom := StartNode; - NodeTo := EndNode; - end - else - begin - NodeFrom := EndNode; - NodeTo := StartNode; - end; - - while NodeFrom <> NodeTo do - begin - InternalRemoveFromSelection(NodeFrom); - NodeFrom := GetNextVisible(NodeFrom, True); - end; - // Deselect last node too. - InternalRemoveFromSelection(NodeFrom); - - // Do some housekeeping. - NewSize := PackArray(FSelection, FSelectionCount); - if NewSize > -1 then - begin - FSelectionCount := NewSize; - SetLength(FSelection, FSelectionCount); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateColumnCheckState(Col: TVirtualTreeColumn); - -begin - Col.CheckState := DetermineNextCheckState(Col.CheckType, Col.CheckState); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateDesigner; - -var - ParentForm: TCustomForm; - -begin - if (csDesigning in ComponentState) and not (csUpdating in ComponentState) then - begin - ParentForm := GetParentForm(Self); - if Assigned(ParentForm) and Assigned(ParentForm.Designer) then - ParentForm.Designer.Modified; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateHeaderRect; - -// Calculates the rectangle the header occupies in non-client area. -// These coordinates are in window rectangle. - -var - OffsetX, - OffsetY: Integer; - EdgeSize: Integer; - Size: TSize; - -begin - FHeaderRect := Rect(0, 0, Width, Height); - - // Consider borders... - Size := GetBorderDimensions; - InflateRect(FHeaderRect, Size.cx, Size.cy); - - // ... and bevels. - OffsetX := BorderWidth; - OffsetY := BorderWidth; - if BevelKind <> bkNone then - begin - EdgeSize := 0; - if BevelInner <> bvNone then - Inc(EdgeSize, BevelWidth); - if BevelOuter <> bvNone then - Inc(EdgeSize, BevelWidth); - if beLeft in BevelEdges then - Inc(OffsetX, EdgeSize); - if beTop in BevelEdges then - Inc(OffsetY, EdgeSize); - end; - - InflateRect(FHeaderRect, -OffsetX, -OffsetY); - - if hoVisible in FHeader.FOptions then - begin - if FHeaderRect.Left <= FHeaderRect.Right then - FHeaderRect.Bottom := FHeaderRect.Top + Integer(FHeader.FHeight) - else - FHeaderRect := Rect(0, 0, 0, 0); - end - else - FHeaderRect.Bottom := FHeaderRect.Top; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateEditBounds; - -// Used to update the bounds of the current node editor if editing is currently active. - -var - R: TRect; - CurrentAlignment: TAlignment; - CurrentBidiMode: TBidiMode; - offsets : TVTOffsets; - offset : Integer; - -begin - if (tsEditing in FStates) and Assigned(FFocusedNode) and - (FEditColumn < FHeader.Columns.Count) then // prevent EArgumentOutOfRangeException - begin - if (GetCurrentThreadId <> MainThreadID) then - begin - // UpdateEditBounds() will be called at the end of the thread - Exit; - end; - if vsMultiline in FFocusedNode.States then - R := GetDisplayRect(FFocusedNode, FEditColumn, True, False) - else if not (toGridExtensions in FOptions.FMiscOptions) then - R := GetDisplayRect(FFocusedNode, FEditColumn, True, True); - - if (toGridExtensions in FOptions.FMiscOptions) then - begin - // Use the whole cell when grid extensions are on. - R := GetDisplayRect(FFocusedNode, FEditColumn, False, False); - if FEditColumn = FHeader.MainColumn then - begin - // Calculate an offset for the main column. - GetOffsets(FFocusedNode, offsets, ofsLabel, FEditColumn); - offset := offsets[ofsLabel]; -// if offsets[ofsToggleButton] < 0 then -// Inc(offset, offsets[ofsToggleButton]); - end - else - offset := 0; - - // Adjust edit bounds depending on alignment and bidi mode. - if FEditColumn <= NoColumn then - begin - CurrentAlignment := Alignment; - CurrentBidiMode := BiDiMode; - end - else - begin - CurrentAlignment := FHeader.Columns[FEditColumn].FAlignment; - CurrentBidiMode := FHeader.Columns[FEditColumn].FBiDiMode; - end; - // Consider bidi mode here. In RTL context does left alignment actually mean right alignment and vice versa. - if CurrentBidiMode <> bdLeftToRight then - ChangeBiDiModeAlignment(CurrentAlignment); - if CurrentAlignment = taLeftJustify then - begin - if CurrentBiDiMode = bdLeftToRight then - Inc(R.Left, offset) - else - Dec(R.Right, offset); - end - else - begin - if CurrentBiDiMode = bdLeftToRight then - Inc(R.Left, offset) - else - Dec(R.Right, offset); - end; - end; - if toShowHorzGridLines in TreeOptions.PaintOptions then - Dec(R.Bottom); - R.Bottom := R.Top + R.Bottom - R.Top; - FEditLink.SetBounds(R); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -const - ScrollMasks: array[Boolean] of Cardinal = (0, SIF_DISABLENOSCROLL); - -const // Region identifiers for GetRandomRgn - CLIPRGN = 1; - METARGN = 2; - APIRGN = 3; - SYSRGN = 4; - -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. - useDragImage := Tree.FDragImage; - if (not useDragImage.Visible) - and (Tree.FHeader.DragImage <> nil) and (Tree.FHeader.DragImage.Visible) - then - 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(Handle, 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(Handle, nil, UpdateRegion, RedrawFlags); - DeleteObject(UpdateRegion); - DeleteObject(DragRegion); - DeleteObject(VisibleTreeRegion); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ValidateCache(); - -// Starts cache validation if not already done by adding this instance to the worker thread's waiter list -// (if not already there) and signalling the thread it can start validating. - -begin - // Wait for thread to stop validation if it is currently validating this tree's cache. - InterruptValidation; - - FStartIndex := 0; - if (tsValidationNeeded in FStates) and (FVisibleCount > CacheThreshold) then - begin - // Tell the thread this tree needs actually something to do. - TWorkerThread.AddTree(Self); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ValidateNodeDataSize(var Size: Integer); - -begin - Size := SizeOf(Pointer); - if Assigned(FOnGetNodeDataSize) then - FOnGetNodeDataSize(Self, Size); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.VclStyleChanged; - - // Updates the member FVclStyleEnabled, should be called initially and when the VCL style changes - -begin - FVclStyleEnabled := StyleServices.Enabled and not StyleServices.IsSystemStyle; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -//PROFILE-NO -procedure TBaseVirtualTree.WndProc(var Message: TMessage); - -var - Handled: Boolean; - -begin - Handled := False; - - // Try the header whether it needs to take this message. - if Assigned(FHeader) and (FHeader.FStates <> []) then - Handled := FHeader.HandleMessage(Message); - if not Handled then - begin - // For auto drag mode, let tree handle itself, instead of TControl. - if not (csDesigning in ComponentState) and - ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) then - begin - if (DragMode = dmAutomatic) and (DragKind = dkDrag) then - begin - if IsControlMouseMsg(TWMMouse(Message)) then - Handled := True; - if not Handled then - begin - ControlState := ControlState + [csLButtonDown]; - Dispatch(Message); // overrides TControl's BeginDrag - Handled := True; - end; - end; - end; - - if not Handled and Assigned(FHeader) then - Handled := FHeader.HandleMessage(Message); - - if not Handled then - begin - if (Message.Msg in [WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN, WM_NCMBUTTONDOWN]) and not Focused and CanFocus then - SetFocus; - inherited; - end; - end; -end; -//PROFILE-YES - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WriteChunks(Stream: TStream; Node: PVirtualNode); - -// Writes the core chunks for Node into the stream. -// Note: descendants can optionally override this method to add other node specific chunks. -// Keep in mind that this method is also called for the root node. Using this fact in descendants you can -// create a kind of "global" chunks not directly bound to a specific node. - -var - Header: TChunkHeader; - LastPosition, - ChunkSize: Integer; - Chunk: TBaseChunk; - Run: PVirtualNode; - -begin - with Stream do - begin - // 1. The base chunk... - LastPosition := Position; - Chunk.Header.ChunkType := BaseChunk; - with Node^, Chunk do - begin - Body.ChildCount := ChildCount; - Body.NodeHeight := NodeHeight; - // Some states are only temporary so take them out as they make no sense at the new location. - Body.States := States - [vsChecking, vsCutOrCopy, vsDeleting, vsOnFreeNodeCallRequired, vsHeightMeasured]; - Body.Align := Align; - Body.CheckState := GetCheckState(Node); - Body.CheckType := CheckType; - Body.Reserved := 0; - end; - // write the base chunk - Write(Chunk, SizeOf(Chunk)); - - // 2. ... directly followed by the child node chunks (actually they are child chunks of - // the base chunk) - if vsInitialized in Node.States then - begin - Run := Node.FirstChild; - while Assigned(Run) do - begin - WriteNode(Stream, Run); - Run := Run.NextSibling; - end; - end; - - FinishChunkHeader(Stream, LastPosition, Position); - - // 3. write user data - LastPosition := Position; - Header.ChunkType := UserChunk; - Write(Header, SizeOf(Header)); - DoSaveUserData(Node, Stream); - // check if the application actually wrote data - ChunkSize := Position - LastPosition - SizeOf(TChunkHeader); - // seek back to start of chunk if nothing has been written - if ChunkSize = 0 then - begin - Position := LastPosition; - Size := Size - SizeOf(Header); - end - else - FinishChunkHeader(Stream, LastPosition, Position); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.WriteNode(Stream: TStream; Node: PVirtualNode); - -// Writes the "cover" chunk for Node to Stream and initiates writing child nodes and chunks. - -var - LastPosition: Integer; - Header: TChunkHeader; - -begin - // Initialize the node first if necessary and wanted. - if toInitOnSave in FOptions.FMiscOptions then - begin - if not (vsInitialized in Node.States) then - InitNode(Node); - if (vsHasChildren in Node.States) and (Node.ChildCount = 0) then - InitChildren(Node); - end; - - with Stream do - begin - LastPosition := Position; - // Emit the anchor chunk. - Header.ChunkType := NodeChunk; - Write(Header, SizeOf(Header)); - // Write other chunks to stream taking their size into this chunk's size. - WriteChunks(Stream, Node); - - // Update chunk size. - FinishChunkHeader(Stream, LastPosition, Position); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.AbsoluteIndex(Node: PVirtualNode): Cardinal; - -begin - Result := 0; - while Assigned(Node) and (Node <> FRoot) do - begin - if not (vsInitialized in Node.States) then - InitNode(Node); - if Assigned(Node.PrevSibling) then - begin - // if there's a previous sibling then add its total count to the result - Node := Node.PrevSibling; - Inc(Result, Node.TotalCount); - end - else - begin - Node := Node.Parent; - if Node <> FRoot then - Inc(Result); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; - -// Adds a new node to the given parent node. This is simply done by increasing the child count of the -// parent node. If Parent is nil then the new node is added as (last) top level node. -// UserData can be used to set the first SizeOf(Pointer) bytes of the user data area to an initial value which can be used -// in OnInitNode and will also cause to trigger the OnFreeNode event (if <> nil) even if the node is not yet -// "officially" initialized. -// AddChild is a compatibility method and will implicitly validate the parent node. This is however -// against the virtual paradigm and hence I dissuade from its usage. - -begin - if not (toReadOnly in FOptions.FMiscOptions) then - Result := InsertNode(Parent, TVTNodeAttachMode.amAddChildLast, UserData) - else - Result := nil; -end; - -function TBaseVirtualTree.AddChild(Parent: PVirtualNode; const UserData: IInterface): PVirtualNode; -begin - UserData._AddRef(); - Result := AddChild(Parent, Pointer(UserData)); - Include(Result.States, vsReleaseCallOnUserDataRequired); -end; - -function TBaseVirtualTree.AddChild(Parent: PVirtualNode; const UserData: TObject): PVirtualNode; -begin - Result := AddChild(Parent, Pointer(UserData)); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.AddFromStream(Stream: TStream; TargetNode: PVirtualNode); - -// loads nodes from the given stream and adds them to TargetNode -// the current content is not cleared before the load process starts (see also LoadFromStream) - -var - ThisID: TMagicID; - Version, - Count: Cardinal; - Node: PVirtualNode; - -begin - if not (toReadOnly in FOptions.FMiscOptions) then - begin - // check first whether this is a stream we can read - Stream.ReadBuffer(ThisID, SizeOf(TMagicID)); - if (ThisID[0] = MagicID[0]) and - (ThisID[1] = MagicID[1]) and - (ThisID[2] = MagicID[2]) and - (ThisID[5] = MagicID[5]) then - begin - Version := Word(ThisID[3]); - if Version <= VTTreeStreamVersion then - begin - BeginUpdate; - try - if Version < 2 then - Count := MaxInt - else - Stream.ReadBuffer(Count, SizeOf(Count)); - - while (Stream.Position < Stream.Size) and (Count > 0) do - begin - Dec(Count); - Node := MakeNewNode; - InternalConnectNode(Node, TargetNode, Self, amAddChildLast); - InternalAddFromStream(Stream, Version, Node); - end; - if TargetNode = FRoot then - DoNodeCopied(nil) - else - DoNodeCopied(TargetNode); - finally - EndUpdate; - end; - end - else - ShowError(SWrongStreamVersion, hcTFWrongStreamVersion); - end - else - ShowError(SWrongStreamVersion, hcTFWrongStreamVersion); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.AfterConstruction; - -begin - inherited; - - if FRoot = nil then - InitRootNode; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.Assign(Source: TPersistent); - -begin - if (Source is TBaseVirtualTree) and not (toReadOnly in FOptions.FMiscOptions) then - with Source as TBaseVirtualTree do - begin - Self.Align := Align; - Self.Anchors := Anchors; - Self.AutoScrollDelay := AutoScrollDelay; - Self.AutoScrollInterval := AutoScrollInterval; - Self.AutoSize := AutoSize; - Self.Background := Background; - Self.BevelEdges := BevelEdges; - Self.BevelInner := BevelInner; - Self.BevelKind := BevelKind; - Self.BevelOuter := BevelOuter; - Self.BevelWidth := BevelWidth; - Self.BiDiMode := BiDiMode; - Self.BorderStyle := BorderStyle; - Self.BorderWidth := BorderWidth; - Self.ChangeDelay := ChangeDelay; - Self.CheckImageKind := CheckImageKind; - Self.Color := Color; - Self.Colors.Assign(Colors); - Self.Constraints.Assign(Constraints); - Self.Ctl3D := Ctl3D; - Self.DefaultNodeHeight := DefaultNodeHeight; - Self.DefaultPasteMode := DefaultPasteMode; - Self.DragCursor := DragCursor; - Self.DragImageKind := DragImageKind; - Self.DragKind := DragKind; - Self.DragMode := DragMode; - Self.Enabled := Enabled; - Self.Font := Font; - Self.Header := Header; - Self.HintMode := HintMode; - Self.HotCursor := HotCursor; - Self.Images := Images; - Self.ImeMode := ImeMode; - Self.ImeName := ImeName; - Self.Indent := Indent; - Self.Margin := Margin; - Self.NodeAlignment := NodeAlignment; - Self.NodeDataSize := NodeDataSize; - Self.TreeOptions := TreeOptions; - Self.ParentBiDiMode := ParentBiDiMode; - Self.ParentColor := ParentColor; - Self.ParentCtl3D := ParentCtl3D; - Self.ParentFont := ParentFont; - Self.ParentShowHint := ParentShowHint; - Self.PopupMenu := PopupMenu; - Self.RootNodeCount := RootNodeCount; - Self.ScrollBarOptions := ScrollBarOptions; - Self.ShowHint := ShowHint; - Self.StateImages := StateImages; - Self.StyleElements := StyleElements; - Self.TabOrder := TabOrder; - Self.TabStop := TabStop; - Self.Visible := Visible; - Self.SelectionCurveRadius := SelectionCurveRadius; - Self.SelectionBlendFactor := SelectionBlendFactor; - Self.EmptyListMessage := EmptyListMessage; - end - else - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.AutoScale(isDpiChange: Boolean); - -// If toAutoChangeScale is set, this method ensures that the defaulz node height is set correctly. -// isDPIChnage is True, if the DPI of the form has changed. In this case the font may not yet be adapted to this, so do not adjust DefualtNodeHeight. - -var - lTextHeight: Cardinal; -begin - if HandleAllocated and (toAutoChangeScale in TreeOptions.AutoOptions) and not isDpiChange then - begin - Canvas.Font.Assign(Self.Font); - lTextHeight := Canvas.TextHeight('Tg') + 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 - Self.DefaultNodeHeight := lTextHeight; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.BeginDrag(Immediate: Boolean; Threshold: Integer); - -// Reintroduced method to allow to start OLE drag'n drop as well as VCL drag'n drop. - -begin - if FDragType = dtVCL then - begin - DoStateChange([tsVCLDragPending]); - inherited; - end - else - if (FStates * [tsOLEDragPending, tsOLEDragging]) = [] then - begin - // Drag start position has already been recorded in WMMouseDown. - if Threshold < 0 then - FDragThreshold := Mouse.DragThreshold - else - FDragThreshold := Threshold; - if Immediate then - DoDragging(FLastClickPos) - else - DoStateChange([tsOLEDragPending]); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.BeginSynch; - -// Starts the synchronous update mode (if not already active). - -begin - if not (csDestroying in ComponentState) then - begin - if FSynchUpdateCount = 0 then - begin - DoUpdating(usBeginSynch); - - // Stop all timers... - StopTimer(ChangeTimer); - StopTimer(StructureChangeTimer); - StopTimer(ExpandTimer); - StopTimer(EditTimer); - StopTimer(HeaderTimer); - StopTimer(ScrollTimer); - StopTimer(SearchTimer); - FSearchBuffer := ''; - FLastSearchNode := nil; - DoStateChange([], [tsEditPending, tsScrollPending, tsScrolling, tsIncrementalSearching]); - - // ...and trigger pending update states. - if tsStructureChangePending in FStates then - DoStructureChange(FLastStructureChangeNode, FLastStructureChangeReason); - if tsChangePending in FStates then - DoChange(FLastChangedNode); - end - else - DoUpdating(usSynch); - end; - Inc(FSynchUpdateCount); - DoStateChange([tsSynchMode]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.BeginUpdate; - -begin - Assert(GetCurrentThreadId = MainThreadId, 'UI controls like ' + Classname + ' should only be manipulated through the main thread.'); - if not (csDestroying in ComponentState) then - begin - if FUpdateCount = 0 then - begin - DoUpdating(usBegin); - SetUpdateState(True); - end - else - DoUpdating(usUpdate); - end; - Inc(FUpdateCount); - DoStateChange([tsUpdating]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CancelCutOrCopy; - -// Resets nodes which are marked as being cut. - -var - Run: PVirtualNode; - -begin - if ([tsCutPending, tsCopyPending] * FStates) <> [] then - begin - Run := FRoot.FirstChild; - while Assigned(Run) do - begin - if vsCutOrCopy in Run.States then - Exclude(Run.States, vsCutOrCopy); - Run := GetNextNoInit(Run); - end; - end; - DoStateChange([], [tsCutPending, tsCopyPending]); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CancelEditNode: Boolean; - -// Called by the application or the current edit link to cancel the edit action. - -begin - if HandleAllocated and ([tsEditing, tsEditPending] * FStates <> []) then - Result := DoCancelEdit - else - Result := True; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CancelOperation; - -// Called by the application to cancel a long-running operation. - -begin - if FOperationCount > 0 then - FOperationCanceled := True; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CanEdit(Node: PVirtualNode; Column: TColumnIndex): Boolean; - -// Returns True if the given node can be edited. - -begin - Result := (toEditable in FOptions.FMiscOptions) and Enabled and not (toReadOnly in FOptions.FMiscOptions) - and ((Column < 0) or (coEditable in FHeader.Columns[Column].Options)); - DoCanEdit(Node, Column, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CanFocus: Boolean; - -var - Form: TCustomForm; - -begin - Result := inherited CanFocus; - - if Result and not (csDesigning in ComponentState) then - begin - Form := GetParentForm(Self); - Result := (Form = nil) or (Form.Enabled and Form.Visible); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.Clear; - -begin - if (not IsEmpty and not (toReadOnly in FOptions.FMiscOptions)) or (csDestroying in ComponentState) then - begin - BeginUpdate; - try - InterruptValidation; - if IsEditing then - CancelEditNode; - - if ClipboardStates * FStates <> [] then - begin - OleSetClipboard(nil); - DoStateChange([], ClipboardStates); - end; - ClearSelection; - FFocusedNode := nil; - FLastSelected := nil; - FCurrentHotNode := nil; - FDropTargetNode := nil; - FLastChangedNode := nil; - FRangeAnchor := nil; - FLastVCLDragTarget := nil; - FLastSearchNode := nil; - DeleteChildren(FRoot, True); - FOffsetX := 0; - FOffsetY := 0; - - finally - EndUpdate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ClearChecked; - -var - Node: PVirtualNode; - -begin - Node := RootNode.FirstChild; - while Assigned(Node) do - begin - if Node.CheckState <> csUncheckedNormal then - CheckState[Node] := csUncheckedNormal; - Node := GetNextNoInit(Node); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ClearSelection(); -begin - ClearSelection(True); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ClearSelection(pFireChangeEvent: Boolean); - -var - Node: PVirtualNode; - Dummy: Integer; - R: TRect; - Counter: Integer; - -begin - Assert(GetCurrentThreadId = MainThreadId, Self.Classname + '.ClearSelection() must only be called from UI thread.'); - if not FSelectionLocked and (FSelectionCount > 0) and not (csDestroying in ComponentState) then - begin - if (FUpdateCount = 0) and HandleAllocated and (FVisibleCount > 0) then - begin - // Iterate through nodes currently visible in the client area and invalidate them. - Node := GetNodeAt(0, 0, True, Dummy); - if Assigned(Node) then - R := GetDisplayRect(Node, NoColumn, False); - Counter := FSelectionCount; - - while Assigned(Node) do - begin - R.Bottom := R.Top + Integer(NodeHeight[Node]); - if vsSelected in Node.States then - begin - InvalidateRect(Handle, @R, False); - Dec(Counter); - // Only try as many nodes as are selected. - if Counter = 0 then - Break; - end; - R.Top := R.Bottom; - if R.Top > ClientHeight then - Break; - Node := GetNextVisibleNoInit(Node, True); - end; - end; - - InternalClearSelection; - if pFireChangeEvent then - Change(nil); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CopyTo(Source: PVirtualNode; Tree: TBaseVirtualTree; Mode: TVTNodeAttachMode; - ChildrenOnly: Boolean): PVirtualNode; - -// A simplified CopyTo method to allow to copy nodes to the root of another tree. - -begin - Result := CopyTo(Source, Tree.FRoot, Mode, ChildrenOnly); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CopyTo(Source, Target: PVirtualNode; Mode: TVTNodeAttachMode; - ChildrenOnly: Boolean): PVirtualNode; - -// Copies Source and all its child nodes to Target. -// Mode is used to specify further where to add the new node actually (as sibling of Target or as child of Target). -// Result is the newly created node to which source has been copied if ChildrenOnly is False or just contains Target -// in the other case. -// ChildrenOnly determines whether to copy also the source node or only its child nodes. - -var - TargetTree: TBaseVirtualTree; - Stream: TMemoryStream; - -begin - Assert(TreeFromNode(Source) = Self, 'The source tree must contain the source node.'); - - Result := nil; - if (Mode <> amNoWhere) and Assigned(Source) and (Source <> FRoot) then - begin - // Assume that an empty destination means the root in this (the source) tree. - if Target = nil then - begin - TargetTree := Self; - Target := FRoot; - Mode := amAddChildFirst; - end - else - TargetTree := TreeFromNode(Target); - - if not (toReadOnly in TargetTree.FOptions.FMiscOptions) then - begin - if Target = TargetTree.FRoot then - begin - case Mode of - amInsertBefore: - Mode := amAddChildFirst; - amInsertAfter: - Mode := amAddChildLast; - end; - end; - - Stream := TMemoryStream.Create; - try - // Write all nodes into a temprary stream depending on the ChildrenOnly flag. - if not ChildrenOnly then - WriteNode(Stream, Source) - else - begin - Source := Source.FirstChild; - while Assigned(Source) do - begin - WriteNode(Stream, Source); - Source := Source.NextSibling; - end; - end; - // Now load the serialized nodes into the target node (tree). - TargetTree.BeginUpdate; - try - Stream.Position := 0; - while Stream.Position < Stream.Size do - begin - Result := TargetTree.MakeNewNode; - InternalConnectNode(Result, Target, TargetTree, Mode); - TargetTree.InternalAddFromStream(Stream, VTTreeStreamVersion, Result); - if not DoNodeCopying(Result, Target) then - begin - TargetTree.DeleteNode(Result); - Result := nil; - end - else - DoNodeCopied(Result); - end; - if ChildrenOnly then - Result := Target; - finally - TargetTree.EndUpdate; - end; - finally - Stream.Free; - end; - - with TargetTree do - begin - InvalidateCache; - if FUpdateCount = 0 then - begin - ValidateCache; - UpdateScrollBars(True); - Invalidate; - end; - StructureChange(Source, crNodeCopied); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CopyToClipboard; - -var - DataObject: IDataObject; - -begin - if FSelectionCount > 0 then - begin - DataObject := TVTDataObject.Create(Self, True) as IDataObject; - if OleSetClipboard(DataObject) = S_OK then - begin - MarkCutCopyNodes; - DoStateChange([tsCopyPending]); - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.CutToClipboard; -begin - if (FSelectionCount > 0) and not (toReadOnly in FOptions.FMiscOptions) then - begin - if OleSetClipboard(TVTDataObject.Create(Self, True)) = S_OK then - begin - MarkCutCopyNodes; - DoStateChange([tsCutPending], [tsCopyPending]); - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DeleteChildren(Node: PVirtualNode; ResetHasChildren: Boolean = False); - -// Removes all children and their children from memory without changing the vsHasChildren style by default. - -var - Run, - Mark: PVirtualNode; - LastTop, - LastLeft, - NewSize: Integer; - ParentVisible: Boolean; - -begin - if Assigned(Node) and (Node.ChildCount > 0) and not (toReadOnly in FOptions.FMiscOptions) then - begin - Assert(not (tsIterating in FStates), 'Deleting nodes during tree iteration leads to invalid pointers.'); - - // The code below uses some flags for speed improvements which may cause invalid pointers if updates of - // the tree happen. Hence switch updates off until we have finished the operation. - Inc(FUpdateCount); - try - InterruptValidation; - LastLeft := -FEffectiveOffsetX; - LastTop := FOffsetY; - - // Make a local copy of the visibility state of this node to speed up - // adjusting the visible nodes count. - ParentVisible := Node = FRoot; - if not ParentVisible then - ParentVisible := FullyVisible[Node] and (vsExpanded in Node.States); - - // Show that we are clearing the child list, to avoid registering structure change events. - Run := Node.LastChild; - while Assigned(Run) do - begin - if ParentVisible and IsEffectivelyVisible[Run] then - Dec(FVisibleCount); - - Include(Run.States, vsDeleting); - Mark := Run; - Run := Run.PrevSibling; - // Important, to avoid exchange of invalid pointers while disconnecting the node. - if Assigned(Run) then - Run.NextSibling := nil; - DeleteNode(Mark, False, True); - end; - if ResetHasChildren then - Exclude(Node.States, vsHasChildren); - if Node <> FRoot then - Exclude(Node.States, vsExpanded); - Node.ChildCount := 0; - if (Node = FRoot) or (vsDeleting in Node.States) then - begin - Node.TotalHeight := FDefaultNodeHeight + NodeHeight[Node]; - Node.TotalCount := 1; - end - else - begin - AdjustTotalHeight(Node, NodeHeight[Node]); - AdjustTotalCount(Node, 1); - end; - Node.FirstChild := nil; - Node.LastChild := nil; - finally - Dec(FUpdateCount); - end; - - InvalidateCache; - if FUpdateCount = 0 then - begin - NewSize := PackArray(FSelection, FSelectionCount); - if NewSize > -1 then - begin - FSelectionCount := NewSize; - SetLength(FSelection, FSelectionCount); - end; - - ValidateCache; - UpdateScrollBars(True); - // Invalidate entire tree if it scrolled e.g. to make the last node also the - // bottom node in the treeview. - if (LastLeft <> FOffsetX) or (LastTop <> FOffsetY) then - Invalidate - else - InvalidateToBottom(Node); - if tsChangePending in FStates then begin - DoChange(FLastChangedNode); - EnsureNodeSelected(); - end; - end; - StructureChange(Node, crChildDeleted); - end - else if ResetHasChildren then - Exclude(Node.States, vsHasChildren); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DeleteNode(Node: PVirtualNode; Reindex: Boolean; ParentClearing: Boolean); - -var - LastTop, - LastLeft: Integer; - LastParent: PVirtualNode; - WasInSynchMode: Boolean; - -begin - if Assigned(Node) and (Node <> FRoot) and not (toReadOnly in FOptions.FMiscOptions) then - begin - Assert(not (tsIterating in FStates), 'Deleting nodes during tree iteration leads to invalid pointers.'); - - // Determine parent node for structure change notification. - LastParent := Node.Parent; - - if not ParentClearing then - begin - if LastParent = FRoot then - StructureChange(nil, crChildDeleted) - else - StructureChange(LastParent, crChildDeleted); - if Node = FNextNodeToSelect then - FNextNodeToSelect := nil; - end; - - LastLeft := -FEffectiveOffsetX; - LastTop := FOffsetY; - - if tsHint in FStates then - begin - Application.CancelHint; - DoStateChange([], [tsHint]); - end; - - if not ParentClearing then - InterruptValidation; - - DeleteChildren(Node); - - if vsSelected in Node.States then - begin - if FUpdateCount = 0 then - begin - // Go temporarily into sync mode to avoid a delayed change event for the node - // when unselecting. - WasInSynchMode := tsSynchMode in FStates; - Include(FStates, tsSynchMode); - RemoveFromSelection(Node); - //EnsureNodeSelected(); // also done in DoFreeNode() - if not WasInSynchMode then - Exclude(FStates, tsSynchMode); - InvalidateToBottom(LastParent); - end - else - InternalRemoveFromSelection(Node); - end - else - InvalidateToBottom(LastParent); - - InternalDisconnectNode(Node, False, Reindex); - DoFreeNode(Node); - - if not ParentClearing then - begin - DetermineHiddenChildrenFlag(LastParent); - InvalidateCache; - if FUpdateCount = 0 then - begin - ValidateCache; - UpdateScrollBars(True); - // Invalidate entire tree if it scrolled e.g. to make the last node also the - // bottom node in the treeview. - if (LastLeft <> FOffsetX) or (LastTop <> FOffsetY) then - Invalidate; - end; - end; - end; -end; - -procedure TBaseVirtualTree.DeleteNode(Node: PVirtualNode); -begin - DeleteNode(Node, True, False); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DeleteNodes(const pNodes: TNodeArray); - - // Deletes all given nodes. - // Best performance is achieved if nodes are sorted by parent - -var - I: Integer; - LevelChange: Boolean; -begin - BeginUpdate; - try - for I := High(pNodes) downto 1 do - begin - LevelChange := pNodes[I].Parent <> pNodes[I - 1].Parent; - DeleteNode(pNodes[I], LevelChange, False); - end; - DeleteNode(pNodes[0]); - finally - EndUpdate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DeleteSelectedNodes; - -// Deletes all currently selected nodes (including their child nodes). - -var - lNodes: TNodeArray; -begin - lNodes := nil; - if (FSelectionCount > 0) and not (toReadOnly in FOptions.FMiscOptions) then - begin - lNodes := GetSortedSelection(True); - DeleteNodes(lNodes); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.Dragging: Boolean; - -begin - // Check for both OLE drag'n drop as well as VCL drag'n drop. - Result := ([tsOLEDragPending, tsOLEDragging] * FStates <> []) or inherited Dragging; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.EditNode(Node: PVirtualNode; Column: TColumnIndex): Boolean; - -// Application triggered edit event for the given node. -// Returns True if the tree started editing otherwise False. - -begin - Assert(Assigned(Node), 'Node must not be nil.'); - Assert((Column > InvalidColumn) and (Column < FHeader.Columns.Count), - 'Column must be a valid column index (-1 if no header is shown).'); - - Result := tsEditing in FStates; - // If the tree is already editing then we don't disrupt this. - if not Result and not (toReadOnly in FOptions.FMiscOptions) then - begin - FocusedNode := Node; - if Assigned(FFocusedNode) and (Node = FFocusedNode) and CanEdit(FFocusedNode, Column) then - begin - FEditColumn := Column; - if not (vsInitialized in Node.States) then - InitNode(Node); - DoEdit; - Result := tsEditing in FStates; - end - else - Result := False; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.EndEditNode: Boolean; - -// Called to finish a current edit action or stop the edit timer if an edit operation is pending. -// Returns True if editing was successfully ended or the control was not in edit mode -// Returns False if the control could not leave the edit mode e.g. due to an invalid value that was entered. - -begin - if [tsEditing, tsEditPending] * FStates <> [] then - Result := DoEndEdit - else - Result := True; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.EndSynch; - -begin - if FSynchUpdateCount > 0 then - Dec(FSynchUpdateCount); - - if not (csDestroying in ComponentState) then - begin - if FSynchUpdateCount = 0 then - begin - DoStateChange([], [tsSynchMode]); - DoUpdating(usEndSynch); - end - else - DoUpdating(usSynch); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.EndUpdate; - -var - NewSize: Integer; - -begin - if FUpdateCount > 0 then - Dec(FUpdateCount); - - if not (csDestroying in ComponentState) then - begin - if (FUpdateCount = 0) and (tsUpdating in FStates) then - begin - if tsUpdateHiddenChildrenNeeded in FStates then - begin - DetermineHiddenChildrenFlagAllNodes; - Exclude(FStates, tsUpdateHiddenChildrenNeeded); - end; - - DoStateChange([], [tsUpdating]); - - NewSize := PackArray(FSelection, FSelectionCount); - if NewSize > -1 then - begin - FSelectionCount := NewSize; - SetLength(FSelection, FSelectionCount); - end; - - InvalidateCache; - ValidateCache; - if HandleAllocated then - UpdateScrollBars(False); - - if tsStructureChangePending in FStates then - DoStructureChange(FLastStructureChangeNode, FLastStructureChangeReason); - try - if tsChangePending in FStates then - DoChange(FLastChangedNode); - finally - if toAutoSort in FOptions.FAutoOptions then - SortTree(FHeader.FSortColumn, FHeader.FSortDirection, True); - - SetUpdateState(False); - if HandleAllocated then - Invalidate; - UpdateDesigner; - end; - end; - - if FUpdateCount = 0 then begin - DoUpdating(usEnd); - EnsureNodeSelected(); - end - else - DoUpdating(usUpdate); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ExecuteAction(Action: TBasicAction): Boolean; - -// Some support for standard actions. - -begin - Result := inherited ExecuteAction(Action); - - if not Result then - begin - Result := Action is TEditSelectAll; - if Result then - SelectAll(False) - else - begin - Result := Action is TEditCopy; - if Result then - CopyToClipboard - else - if not (toReadOnly in FOptions.FMiscOptions) then - begin - Result := Action is TEditCut; - if Result then - CutToClipboard - else - begin - Result := Action is TEditPaste; - if Result then - PasteFromClipboard - else - begin - Result := Action is TEditDelete; - if Result then - DeleteSelectedNodes; - end; - end; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.FinishCutOrCopy; - -// Deletes nodes which are marked as being cutted. - -var - Run: PVirtualNode; - -begin - if tsCutPending in FStates then - begin - Run := FRoot.FirstChild; - while Assigned(Run) do - begin - if vsCutOrCopy in Run.States then - DeleteNode(Run); - Run := GetNextNoInit(Run); - end; - DoStateChange([], [tsCutPending]); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.FlushClipboard; - -// Used to render the data which is currently on the clipboard (finishes delayed rendering). - -begin - if ClipboardStates * FStates <> [] then - begin - DoStateChange([tsClipboardFlushing]); - OleFlushClipboard; - CancelCutOrCopy; - DoStateChange([], [tsClipboardFlushing]); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.FullCollapse(Node: PVirtualNode = nil); - -// This routine collapses all expanded nodes in the subtree given by Node or the whole tree if Node is FRoot or nil. -// Only nodes which are expanded will be collapsed. This excludes uninitialized nodes but nodes marked as visible -// will still be collapsed if they are expanded. - -var - Stop: PVirtualNode; - -begin - if FRoot.TotalCount > 1 then - begin - if Node = FRoot then - Node := nil; - - DoStateChange([tsCollapsing]); - BeginUpdate; - try - Stop := Node; - Node := GetLastVisibleNoInit(Node, True); - - if Assigned(Node) then - begin - repeat - if [vsHasChildren, vsExpanded] * Node.States = [vsHasChildren, vsExpanded] then - ToggleNode(Node); - Node := GetPreviousNoInit(Node, True); - until (Node = Stop) or not Assigned(Node); - - // Collapse the start node too. - if Assigned(Stop) and ([vsHasChildren, vsExpanded] * Stop.States = [vsHasChildren, vsExpanded]) then - ToggleNode(Stop); - end; - finally - EndUpdate; - DoStateChange([], [tsCollapsing]); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.FullExpand(Node: PVirtualNode = nil); - -// This routine expands all collapsed nodes in the subtree given by Node or the whole tree if Node is FRoot or nil. -// All nodes on the way down are initialized so this procedure might take a long time. -// Since all nodes are validated, the tree cannot make use of optimatizations. Hence it is counter productive and you -// should consider avoiding its use. - -var - Stop: PVirtualNode; - -begin - if FRoot.TotalCount > 1 then - begin - DoStateChange([tsExpanding]); - StartOperation(TVTOperationKind.okExpand); - BeginUpdate; - try - if Node = nil then - begin - Node := FRoot.FirstChild; - Stop := nil; - end - else - begin - Stop := Node.NextSibling; - if Stop = nil then - begin - Stop := Node; - repeat - Stop := Stop.Parent; - until (Stop = FRoot) or Assigned(Stop.NextSibling); - if Stop = FRoot then - Stop := nil - else - Stop := Stop.NextSibling; - end; - end; - - // Initialize the start node. Others will be initialized in GetNext. - if not (vsInitialized in Node.States) then - InitNode(Node); - - repeat - if not (vsExpanded in Node.States) then - ToggleNode(Node); - Node := GetNext(Node); - until (Node = Stop) or OperationCanceled; - finally - EndOperation(TVTOperationKind.okExpand); - EndUpdate; - DoStateChange([], [tsExpanding]); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetControlsAlignment: TAlignment; - -begin - Result := FAlignment; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetDisplayRect(Node: PVirtualNode; Column: TColumnIndex; TextOnly: Boolean; - Unclipped: Boolean = False; ApplyCellContentMargin: Boolean = False): TRect; - -// Determines the client coordinates the given node covers, depending on scrolling, expand state etc. -// If the given node cannot be found (because one of its parents is collapsed or it is invisible) then an empty -// rectangle is returned. -// If TextOnly is True then only the text bounds are returned, that is, the resulting rectangle's left and right border -// are updated according to bidi mode, alignment and text width of the node. -// If Unclipped is True (which only makes sense if also TextOnly is True) then the calculated text rectangle is -// not clipped if the text does not entirely fit into the text space. This is special handling needed for hints. -// If ApplyCellContentMargin is True (which only makes sense if also TextOnly is True) then the calculated text -// rectangle respects the cell content margin. -// If Column is -1 then the entire client width is used before determining the node's width otherwise the bounds of the -// particular column are used. -// Note: Column must be a valid column and is used independent of whether the header is visible or not. - -var - Temp: PVirtualNode; - LeftOffset: Cardinal; - TopOffset: Cardinal; - CacheIsAvailable: Boolean; - TextWidth: Integer; - CurrentBidiMode: TBidiMode; - CurrentAlignment: TAlignment; - MaxUnclippedHeight: Integer; - TM: TTextMetric; - ExtraVerticalMargin: Integer; - lOffsets: TVTOffsets; -begin - Assert(Assigned(Node), 'Node must not be nil.'); - Assert(Node <> FRoot, 'Node must not be the hidden root node.'); - - if not (vsInitialized in Node.States) then - InitNode(Node); - - Result := Rect(0, 0, 0, 0); - - // Check whether the node is visible (determine indentation level btw.). - if not IsEffectivelyVisible[Node] then - Exit; - - // Here we know the node is visible. - TopOffset := 0; - CacheIsAvailable := False; - if tsUseCache in FStates then - begin - // If we can use the position cache then do a binary search to find a cached node which is as close as possible - // to the current node. Iterate then through all following and visible nodes and sum up their heights. - Temp := FindInPositionCache(Node, TopOffset); - CacheIsAvailable := Assigned(Temp); - while Assigned(Temp) and (Temp <> Node) do - begin - Inc(TopOffset, NodeHeight[Temp]); - Temp := GetNextVisibleNoInit(Temp, True); - end; - end; - if not CacheIsAvailable then - begin - // If the cache is not available then go straight through all nodes up to the root and sum up their heights. - Temp := Node; - repeat - Temp := GetPreviousVisibleNoInit(Temp, True); - if Temp = nil then - Break; - Inc(TopOffset, NodeHeight[Temp]); - until False; - end; - - Result := Rect(0, TopOffset, Max(FRangeX, ClientWidth), TopOffset + NodeHeight[Node]); - - // Limit left and right bounds to the given column (if any) and move bounds according to current scroll state. - if Column > NoColumn then - begin - FHeader.FColumns.GetColumnBounds(Column, Result.Left, Result.Right); - // The right column border is not part of this cell. - Dec(Result.Right); - OffsetRect(Result, 0, FOffsetY); - end - else - OffsetRect(Result, -FEffectiveOffsetX, FOffsetY); - - // Limit left and right bounds further if only the text area is required. - if TextOnly then - begin - // If the text of a node is involved then we have to consider directionality and alignment too. - if Column <= NoColumn then - begin - CurrentBidiMode := BidiMode; - CurrentAlignment := Alignment; - end - else - begin - CurrentBidiMode := FHeader.FColumns[Column].BidiMode; - CurrentAlignment := FHeader.FColumns[Column].Alignment; - end; - - GetOffsets(Node, lOffsets, TVTElement.ofsLabel, Column); - LeftOffset := lOffSets[TVTElement.ofsLabel]; - // Offset contains now the distance from the left or right border of the rectangle (depending on bidi mode). - // Now consider the alignment too and calculate the final result. - if CurrentBidiMode = bdLeftToRight then - begin - Inc(Result.Left, LeftOffset); - // Left-to-right reading does not need any special adjustment of the alignment. - end - else - begin - Dec(Result.Right, LeftOffset); - - // Consider bidi mode here. In RTL context does left alignment actually mean right alignment and vice versa. - ChangeBiDiModeAlignment(CurrentAlignment); - end; - - TextWidth := DoGetNodeWidth(Node, Column); - - // Keep cell height before applying cell content margin in order to increase cell height if text does not fit - // and Unclipped it true (see below). - MaxUnclippedHeight := Result.Bottom - Result.Top; - - if ApplyCellContentMargin then - DoBeforeCellPaint(Self.Canvas, Node, Column, cpmGetContentMargin, Result, Result); - - if Unclipped then - begin - // The caller requested the text coordinates unclipped. This means they must be calculated so as would - // there be enough space, regardless of column bounds etc. - // The layout still depends on the available space too, because this determines the position - // of the unclipped text rectangle. - if Result.Right - Result.Left < TextWidth - 1 then - if CurrentBidiMode = bdLeftToRight then - CurrentAlignment := taLeftJustify - else - CurrentAlignment := taRightJustify; - - // Increase cell height (up to MaxUnclippedHeight determined above) if text does not fit. - GetTextMetrics(Self.Canvas.Handle, TM); - ExtraVerticalMargin := System.Math.Min(TM.tmHeight, MaxUnclippedHeight) - (Result.Bottom - Result.Top); - if ExtraVerticalMargin > 0 then - InflateRect(Result, 0, (ExtraVerticalMargin + 1) div 2); - - case CurrentAlignment of - taCenter: - begin - Result.Left := (Result.Left + Result.Right - TextWidth) div 2; - Result.Right := Result.Left + TextWidth; - end; - taRightJustify: - Result.Left := Result.Right - TextWidth; - else // taLeftJustify - Result.Right := Result.Left + TextWidth - 1; - end; - end - else - // Modify rectangle only if the text fits entirely into the given room. - if Result.Right - Result.Left > TextWidth then - case CurrentAlignment of - taCenter: - begin - Result.Left := (Result.Left + Result.Right - TextWidth) div 2; - Result.Right := Result.Left + TextWidth; - end; - taRightJustify: - Result.Left := Result.Right - TextWidth; - else // taLeftJustify - Result.Right := Result.Left + TextWidth; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetEffectivelyFiltered(Node: PVirtualNode): Boolean; - -// Checks if a node is effectively filtered out. This depends on the nodes state and the paint options. - -begin - if Assigned(Node) then - Result := (vsFiltered in Node.States) and not (toShowFilteredNodes in FOptions.FPaintOptions) - else - Result := False; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetEffectivelyVisible(Node: PVirtualNode): Boolean; - -begin - Result := (vsVisible in Node.States) and not IsEffectivelyFiltered[Node]; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirst(ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the first node in the tree while optionally considering toChildrenAbove. - -begin - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then - begin - if vsHasChildren in FRoot.States then - begin - Result := FRoot; - - // Child nodes are the first choice if possible. - if Assigned(Result.FirstChild) then - begin - while Assigned(Result.FirstChild) do - begin - Result := Result.FirstChild; - if not (vsInitialized in Result.States) then - InitNode(Result); - - if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then - InitChildren(Result); - end; - end - else - Result := nil; - end - else - Result := nil; - end - else - Result := FRoot.FirstChild; - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstChecked(State: TCheckState = csCheckedNormal; - ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the first node in the tree with the given check state. - -begin - Result := GetNextChecked(nil, State, ConsiderChildrenAbove); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstChild(Node: PVirtualNode): PVirtualNode; - -// Returns the first child of the given node. The result node is initialized before exit. - -begin - if (Node = nil) or (Node = FRoot) then - Result := FRoot.FirstChild - else - begin - if not (vsInitialized in Node.States) then - InitNode(Node); - if vsHasChildren in Node.States then - begin - if Node.ChildCount = 0 then - InitChildren(Node); - Result := Node.FirstChild; - end - else - Result := nil; - end; - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstChildNoInit(Node: PVirtualNode): PVirtualNode; -// Determines the first child of the given node but does not initialize it. - -begin - if (Node = nil) or (Node = FRoot) then - Result := FRoot.FirstChild - else - begin - if vsHasChildren in Node.States then - Result := Node.FirstChild - else - Result := nil; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstCutCopy(ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the first node in the tree which is currently marked for a clipboard operation. -// See also GetNextCutCopy for comments on initialization. - -begin - Result := GetNextCutCopy(nil, ConsiderChildrenAbove); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstInitialized(ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the first node which is already initialized. - -begin - Result := GetFirstNoInit(ConsiderChildrenAbove); - if Assigned(Result) and not (vsInitialized in Result.States) then - Result := GetNextInitialized(Result, ConsiderChildrenAbove); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstLeaf: PVirtualNode; - -// Returns the first node in the tree which has currently no children. -// The result is initialized if necessary. - -begin - Result := GetNextLeaf(nil); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstLevel(NodeLevel: Cardinal): PVirtualNode; - -// Returns the first node in the tree on a specific level. -// The result is initialized if necessary. - -begin - Result := GetFirstNoInit(True); - while Assigned(Result) and (GetNodeLevel(Result) <> NodeLevel) do - Result := GetNextNoInit(Result, True); - - if Assigned(Result) and (GetNodeLevel(Result) <> NodeLevel) then // i.e. there is no node with the desired level in the tree - Result := nil; - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstNoInit(ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the first node in the tree while optionally considering toChildrenAbove. -// No initialization is performed. - -begin - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then - begin - if vsHasChildren in FRoot.States then - begin - Result := FRoot; - - // Child nodes are the first choice if possible. - if Assigned(Result.FirstChild) then - begin - while Assigned(Result.FirstChild) do - Result := Result.FirstChild; - end - else - Result := nil; - end - else - Result := nil; - end - else - Result := FRoot.FirstChild; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstSelected(ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the first node in the current selection while optionally considering toChildrenAbove. - -begin - Result := GetNextSelected(nil, ConsiderChildrenAbove); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; - IncludeFiltered: Boolean = False): PVirtualNode; - -// Returns the first visible node in the tree while optionally considering toChildrenAbove. -// If necessary nodes are initialized on demand. - -begin - Result := Node; - if not Assigned(Result) then - Result := FRoot; - - if vsHasChildren in Result.States then - begin - if Result.ChildCount = 0 then - InitChildren(Result); - - // Child nodes are the first choice if possible. - if Assigned(Result.FirstChild) then - begin - Result := GetFirstChild(Result); - - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then - begin - repeat - // Search the first visible sibling. - while Assigned(Result.NextSibling) and not (vsVisible in Result.States) do - begin - Result := Result.NextSibling; - // Init node on demand as this might change the visibility. - if not (vsInitialized in Result.States) then - InitNode(Result); - end; - - // If there are no visible siblings take the parent. - if not (vsVisible in Result.States) then - begin - Result := Result.Parent; - if Result = FRoot then - Result := nil; - Break; - end - else - begin - if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then - InitChildren(Result); - if (not Assigned(Result.FirstChild)) or (not (vsExpanded in Result.States)) then - Break; - end; - - Result := Result.FirstChild; - if not (vsInitialized in Result.States) then - InitNode(Result); - until False; - end - else - begin - // If there are no children or the first child is not visible then search the sibling nodes or traverse parents. - if not (vsVisible in Result.States) then - begin - repeat - // Is there a next sibling? - if Assigned(Result.NextSibling) then - begin - Result := Result.NextSibling; - // The visible state can be removed during initialization so init the node first. - 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; - end - else - Result := nil; - end - else - Result := nil; - - if Assigned(Result) and not IncludeFiltered and IsEffectivelyFiltered[Result] then - Result := GetNextVisible(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstVisibleChild(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - -// Returns the first visible child node of Node. If necessary nodes are initialized on demand. - -begin - if Node = nil then - Node := FRoot; - Result := GetFirstChild(Node); - - if Assigned(Result) and (not (vsVisible in Result.States) or - (not IncludeFiltered and IsEffectivelyFiltered[Result])) then - Result := GetNextVisibleSibling(Result, IncludeFiltered); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - -// Returns the first visible child node of Node. - -begin - if Node = nil then - Node := FRoot; - Result := Node.FirstChild; - if Assigned(Result) and (not (vsVisible in Result.States) or - (not IncludeFiltered and IsEffectivelyFiltered[Result])) then - Result := GetNextVisibleSiblingNoInit(Result, IncludeFiltered); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstVisibleNoInit(Node: PVirtualNode = nil; - ConsiderChildrenAbove: Boolean = True; IncludeFiltered: Boolean = False): PVirtualNode; - -// Returns the first visible node in the tree or given subtree while optionally considering toChildrenAbove. -// No initialization is performed. - -begin - Result := Node; - if not Assigned(Result) then - Result := FRoot; - - if vsHasChildren in Result.States then - begin - // Child nodes are the first choice if possible. - if Assigned(Result.FirstChild) then - begin - Result := Result.FirstChild; - - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then - begin - repeat - // Search the first visible sibling. - while Assigned(Result.NextSibling) and not (vsVisible in Result.States) do - Result := Result.NextSibling; - - // If there a no visible siblings take the parent. - if not (vsVisible in Result.States) then - begin - Result := Result.Parent; - if Result = FRoot then - Result := nil; - Break; - end - else - if (not Assigned(Result.FirstChild)) or (not (vsExpanded in Result.States))then - Break; - - Result := Result.FirstChild; - until False; - end - else - begin - // If there are no children or the first child is not visible then search the sibling nodes or traverse parents. - if 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; - end - else - Result := nil; - end - else - Result := nil; - - if Assigned(Result) and not IncludeFiltered and IsEffectivelyFiltered[Result] then - Result := GetNextVisibleNoInit(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.GetHitTestInfoAt(X, Y: Integer; Relative: Boolean; var HitInfo: THitInfo); - -// Determines the node that occupies the specified point or nil if there's none. The parameter Relative determines -// whether to consider X and Y as being client coordinates (if True) or as being absolute tree coordinates. -// HitInfo is filled with flags describing the hit further. - -var - ColLeft, - ColRight: Integer; - NodeTop: Integer; - InitialColumn, - NextColumn: TColumnIndex; - CurrentBidiMode: TBidiMode; - CurrentAlignment: TAlignment; - NodeRect: TRect; - -begin - HitInfo.HitNode := nil; - HitInfo.HitPositions := []; - HitInfo.HitColumn := NoColumn; - - // Determine if point lies in the tree's client area. - if X < 0 then - Include(HitInfo.HitPositions, hiToLeft) - else - if X > Max(FRangeX, ClientWidth) then - Include(HitInfo.HitPositions, hiToRight); - - if Y < 0 then - Include(HitInfo.HitPositions, hiAbove) - else - if Y > Max(FRangeY, ClientHeight) then - Include(HitInfo.HitPositions, hiBelow); - - // Convert position into absolute coordinate if necessary. - if Relative then - begin - if X >= Header.Columns.GetVisibleFixedWidth then - Inc(X, FEffectiveOffsetX); - Inc(Y, -FOffsetY); - end; - HitInfo.HitPoint.X := X; - HitInfo.HitPoint.Y := Y; - - // If the point is in the tree area then check the nodes. - if HitInfo.HitPositions = [] then - begin - HitInfo.HitNode := GetNodeAt(X, Y, False, NodeTop); - if HitInfo.HitNode = nil then - Include(HitInfo.HitPositions, hiNowhere) - else - begin - // At this point we need some info about the node, so it must be initialized. - if not (vsInitialized in HitInfo.HitNode.States) then - InitNode(HitInfo.HitNode); - - if FHeader.UseColumns then - begin - HitInfo.HitColumn := FHeader.Columns.GetColumnAndBounds(Point(X, Y), ColLeft, ColRight, False); - // If auto column spanning is enabled then look for the last non empty column. - if toAutoSpanColumns in FOptions.FAutoOptions then - begin - InitialColumn := HitInfo.HitColumn; - // Search to the left of the hit column for empty columns. - while (HitInfo.HitColumn > NoColumn) and ColumnIsEmpty(HitInfo.HitNode, HitInfo.HitColumn) do - begin - NextColumn := FHeader.FColumns.GetPreviousVisibleColumn(HitInfo.HitColumn); - if NextColumn = InvalidColumn then - Break; - HitInfo.HitColumn := NextColumn; - Dec(ColLeft, FHeader.FColumns[NextColumn].Width); - end; - // Search to the right of the hit column for empty columns. - repeat - InitialColumn := FHeader.FColumns.GetNextVisibleColumn(InitialColumn); - if (InitialColumn = InvalidColumn) or not ColumnIsEmpty(HitInfo.HitNode, InitialColumn) then - Break; - Inc(ColRight, FHeader.FColumns[InitialColumn].Width); - until False; - end; - // Make the X position and the right border relative to the start of the column. - Dec(X, ColLeft); - Dec(ColRight, ColLeft); - end - else - begin - HitInfo.HitColumn := NoColumn; - ColRight := Max(FRangeX, ClientWidth); - end; - ColLeft := 0; - - if HitInfo.HitColumn = InvalidColumn then - Include(HitInfo.HitPositions, hiNowhere) - else - begin - // From now on X is in "column" coordinates (relative to the left column border). - HitInfo.HitPositions := [hiOnItem]; - - // Avoid getting the display rect if this is not necessary. - if toNodeHeightResize in FOptions.FMiscOptions then - begin - NodeRect := GetDisplayRect(HitInfo.HitNode, HitInfo.HitColumn, False); - if Y <= (NodeRect.Top - FOffsetY + 1) then - Include(HitInfo.HitPositions, hiUpperSplitter) - else - if Y >= (NodeRect.Bottom - FOffsetY - 3) then - Include(HitInfo.HitPositions, hiLowerSplitter); - end; - - if HitInfo.HitColumn <= NoColumn then - begin - CurrentBidiMode := BidiMode; - CurrentAlignment := Alignment; - end - else - begin - CurrentBidiMode := FHeader.FColumns[HitInfo.HitColumn].BidiMode; - CurrentAlignment := FHeader.FColumns[HitInfo.HitColumn].Alignment; - end; - - if CurrentBidiMode = bdLeftToRight then - DetermineHitPositionLTR(HitInfo, X, ColRight, CurrentAlignment) - else - DetermineHitPositionRTL(HitInfo, X, ColRight, CurrentAlignment); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetLast(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the very last node in the tree branch given by Node and initializes the nodes all the way down including the -// result. toChildrenAbove is optionally considered. By using Node = nil the very last node in the tree is returned. - -var - Next: PVirtualNode; - -begin - Result := GetLastChild(Node); - if not ConsiderChildrenAbove or not (toChildrenAbove in FOptions.FPaintOptions) then - while Assigned(Result) 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 := GetLastChild(Result); - if Next = nil then - Break; - Result := Next; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetLastInitialized(Node: PVirtualNode = nil; - ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the very last initialized child node in the tree branch given by Node. - -begin - Result := GetLastNoInit(Node, ConsiderChildrenAbove); - if Assigned(Result) and not (vsInitialized in Result.States) then - Result := GetPreviousInitialized(Result, ConsiderChildrenAbove); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetLastNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the very last node in the tree branch given by Node without initialization. - -var - Next: PVirtualNode; - -begin - Result := GetLastChildNoInit(Node); - if not ConsiderChildrenAbove or not (toChildrenAbove in FOptions.FPaintOptions) then - while Assigned(Result) 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 Next = nil then - Break; - Result := Next; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetLastChild(Node: PVirtualNode): PVirtualNode; - -// Determines the last child of the given node and initializes it if there is one. - -begin - if (Node = nil) or (Node = FRoot) then - Result := FRoot.LastChild - else - begin - if not (vsInitialized in Node.States) then - InitNode(Node); - if vsHasChildren in Node.States then - begin - if Node.ChildCount = 0 then - InitChildren(Node); - Result := Node.LastChild; - end - else - Result := nil; - end; - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetLastChildNoInit(Node: PVirtualNode): PVirtualNode; - -// Determines the last child of the given node but does not initialize it. - -begin - if (Node = nil) or (Node = FRoot) then - Result := FRoot.LastChild - else - begin - if vsHasChildren in Node.States then - Result := Node.LastChild - else - Result := nil; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetLastVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; - IncludeFiltered: Boolean = False): PVirtualNode; - -// Returns the very last visible node in the tree while optionally considering toChildrenAbove. -// The nodes are intialized all the way up including the result node. - -var - Run: PVirtualNode; - -begin - Result := GetLastVisibleNoInit(Node, ConsiderChildrenAbove); - - Run := Result; - while Assigned(Run) and (Run <> Node) and (Run <> RootNode) do - begin - if not (vsInitialized in Run.States) then - InitNode(Run); - Run := Run.Parent; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetLastVisibleChild(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - -// Determines the last visible child of the given node and initializes it if necessary. - -begin - if (Node = nil) or (Node = FRoot) then - Result := GetLastChild(FRoot) - else - if FullyVisible[Node] and (vsExpanded in Node.States) then - Result := GetLastChild(Node) - else - Result := nil; - - if Assigned(Result) and (not (vsVisible in Result.States) or - (not IncludeFiltered and IsEffectivelyFiltered[Result])) then - Result := GetPreviousVisibleSibling(Result, IncludeFiltered); - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetLastVisibleChildNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - -// Determines the last visible child of the given node without initialization. - -begin - if (Node = nil) or (Node = FRoot) then - Result := GetLastChildNoInit(FRoot) - else - if FullyVisible[Node] and (vsExpanded in Node.States) then - Result := GetLastChildNoInit(Node) - else - Result := nil; - - if Assigned(Result) and (not (vsVisible in Result.States) or - (not IncludeFiltered and IsEffectivelyFiltered[Result])) then - Result := GetPreviousVisibleSiblingNoInit(Result, IncludeFiltered); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -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. -// No initialization is performed. -var - Next: PVirtualNode; - -begin - Result := GetLastVisibleChildNoInit(Node, IncludeFiltered); - if not ConsiderChildrenAbove or not (toChildrenAbove in FOptions.FPaintOptions) 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; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): Integer; - -// This method determines the width of the largest node in the given column. -// If UseSmartColumnWidth is True then only the visible nodes which are in view will be considered -// Note: If UseSmartColumnWidth is False then every visible node in the tree will be initialized contradicting so -// the virtual paradigm. - -var - Run, - LastNode, - NextNode: PVirtualNode; - TextLeft, - CurrentWidth: Integer; - lOffsets: TVTOffsets; -begin - if OperationCanceled then - begin - // Behave non-destructive. - Result := FHeader.FColumns[Column].Width; - Exit; - end - else - Result := 0; - - StartOperation(okGetMaxColumnWidth); - try - if Assigned(FOnBeforeGetMaxColumnWidth) then - FOnBeforeGetMaxColumnWidth(FHeader, Column, UseSmartColumnWidth); - - if UseSmartColumnWidth then // Get first visible node which is in view. - Run := GetTopNode - else - Run := GetFirstVisible(nil, True); - - // Decide where to stop. - if UseSmartColumnWidth then - LastNode := GetNextVisible(BottomNode) - else - LastNode := nil; - - while Assigned(Run) and not OperationCanceled do - begin - GetOffsets(Run, lOffsets, TVTElement.ofsLabel, Column); - TextLeft := lOffsets[TVTElement.ofsLabel]; - CurrentWidth := DoGetNodeWidth(Run, Column); - Inc(CurrentWidth, DoGetNodeExtraWidth(Run, Column)); - Inc(CurrentWidth, DoGetCellContentMargin(Run, Column).X); - - // Background for fix: - // DoGetNodeWidth works correctly to return just the - // headerwidth in vsMultiline state of the node. But the - // following code was adding TextLeft unnecessarily. This - // caused a width increase each time a column splitter - // was double-clicked for the option hoDblClickResize that - // really does not apply for vsMultiline case. - // Fix: If the node is multiline, leave the current width as - // it is as returned by DoGetNodeWidth logic above. - if (Column > NoColumn) and (vsMultiline in Run.States) then - Result := CurrentWidth - else - if Result < (TextLeft + CurrentWidth) then - Result := TextLeft + CurrentWidth; - - // Get next visible node and update left node position if needed. - NextNode := GetNextVisible(Run, True); - if NextNode = LastNode then - Break; - Run := NextNode; - end; - if toShowVertGridLines in FOptions.FPaintOptions then - Inc(Result); - - if Assigned(FOnAfterGetMaxColumnWidth) then - FOnAfterGetMaxColumnWidth(FHeader, Column, Result); - - finally - EndOperation(okGetMaxColumnWidth); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNext(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns next node in tree while optionally considering toChildrenAbove. The Result will be initialized if needed. - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then - begin - // If this node has no siblings use the parent. - if not Assigned(Result.NextSibling) then - begin - Result := Result.Parent; - if Result = FRoot then - begin - Result := nil; - end; - end - else - begin - // There is at least one sibling so take it. - Result := Result.NextSibling; - - // Has this node got children? Initialize them if necessary. - if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then - InitChildren(Result); - - // Now take a look at the children. - while Assigned(Result.FirstChild) do - begin - Result := Result.FirstChild; - if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then - InitChildren(Result); - end; - end; - end - else - begin - // Has this node got children? - if vsHasChildren in Result.States then - begin - // Yes, there are child nodes. Initialize them if necessary. - if Result.ChildCount = 0 then - InitChildren(Result); - end; - - // if there is no child node try siblings - if Assigned(Result.FirstChild) then - Result := Result.FirstChild - else - begin - repeat - // Is there a next sibling? - if Assigned(Result.NextSibling) then - begin - Result := Result.NextSibling; - 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; - end; - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; - ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -begin - if (Node = nil) or (Node = FRoot) then - Result := GetFirstNoInit(ConsiderChildrenAbove) - else - Result := GetNextNoInit(Node, ConsiderChildrenAbove); - - while Assigned(Result) and (GetCheckState(Result) <> State) do - Result := GetNextNoInit(Result, ConsiderChildrenAbove); - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextChecked(Node: PVirtualNode; ConsiderChildrenAbove: Boolean): PVirtualNode; -begin - Result := Self.GetNextChecked(Node, csCheckedNormal, ConsiderChildrenAbove); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextCutCopy(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the next node in the tree which is currently marked for a clipboard operation. Since only visible nodes can -// be marked (or they are hidden after they have been marked) it is not necessary to initialize nodes to check for -// child nodes. The result, however, is initialized if necessary. - -begin - if ClipboardStates * FStates <> [] then - begin - if (Node = nil) or (Node = FRoot) then - Result := GetFirstNoInit(ConsiderChildrenAbove) - else - Result := GetNextNoInit(Node, ConsiderChildrenAbove); - while Assigned(Result) and not (vsCutOrCopy in Result.States) do - Result := GetNextNoInit(Result, ConsiderChildrenAbove); - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); - end - else - Result := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextInitialized(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the next node in tree which is initialized. - -begin - Result := Node; - repeat - Result := GetNextNoInit(Result, ConsiderChildrenAbove); - until (Result = nil) or (vsInitialized in Result.States); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextLeaf(Node: PVirtualNode): PVirtualNode; - -// Returns the next node in the tree which has currently no children. -// The result is initialized if necessary. - -begin - if (Node = nil) or (Node = FRoot) then - Result := FRoot.FirstChild - else - Result := GetNext(Node); - while Assigned(Result) and (vsHasChildren in Result.States) do - Result := GetNext(Result); - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextLevel(Node: PVirtualNode; NodeLevel: Cardinal): PVirtualNode; - -// Returns the next node in the tree on a specific level. -// The result is initialized if necessary. - -var - StartNodeLevel: Cardinal; - -begin - Result := nil; - - if Assigned(Node) and (Node <> FRoot) then - begin - StartNodeLevel := GetNodeLevel(Node); - - if StartNodeLevel < NodeLevel then - begin - Result := GetNext(Node); - if Assigned(Result) and (GetNodeLevel(Result) <> NodeLevel) then - Result := GetNextLevel(Result, NodeLevel); - end - else - if StartNodeLevel = NodeLevel then - begin - Result := Node.NextSibling; - if not Assigned(Result) then // i.e. start node was a last sibling - begin - Result := Node.Parent; - if Assigned(Result) then - begin - // go to next anchestor of the start node which has a next sibling (if exists) - while Assigned(Result) and not Assigned(Result.NextSibling) do - Result := Result.Parent; - if Assigned(Result) then - Result := GetNextLevel(Result.NextSibling, NodeLevel); - end; - end; - end - else - // i.e. StartNodeLevel > NodeLevel - Result := GetNextLevel(Node.Parent, NodeLevel); - end; - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean): PVirtualNode; - -// Optimized version of GetNext performing no initialization, but optionally considering toChildrenAbove. - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then - begin - // If this node has no siblings use the parent. - if not Assigned(Result.NextSibling) then - begin - Result := Result.Parent; - if Result = FRoot then - begin - Result := nil; - end; - end - else - begin - // There is at least one sibling so take it. - Result := Result.NextSibling; - - // Now take a look at the children. - while Assigned(Result.FirstChild) do - begin - Result := Result.FirstChild; - end; - end; - end - else - begin - // If there is no child node try siblings. - if Assigned(Result.FirstChild) then - Result := Result.FirstChild - else - begin - repeat - // Is there a next sibling? - if Assigned(Result.NextSibling) then - begin - Result := Result.NextSibling; - 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; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextSelected(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the next node in the tree which is currently selected. Since children of unitialized nodes cannot be -// in the current selection (because they simply do not exist yet) it is not necessary to initialize nodes here. -// The result however is initialized if necessary. - -begin - if FSelectionCount > 0 then - begin - if (Node = nil) or (Node = FRoot) then - Result := GetFirstNoInit(ConsiderChildrenAbove) - else - Result := GetNextNoInit(Node, ConsiderChildrenAbove); - while Assigned(Result) and not (vsSelected in Result.States) do - Result := GetNextNoInit(Result, ConsiderChildrenAbove); - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); - end - else - Result := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextSibling(Node: PVirtualNode): PVirtualNode; - -// Returns the next sibling of Node and initializes it if necessary. - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - Result := Result.NextSibling; - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); - end; -end; - -function TBaseVirtualTree.GetNextSiblingNoInit(Node: PVirtualNode): PVirtualNode; - -// Returns the next sibling of Node. - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - Result := Result.NextSibling; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; - -// Returns next node in tree, with regard to Node, which is visible. -// Nodes which need an initialization (including the result) are initialized. -// toChildrenAbove is optionally considered which is the default here. - -var - ForceSearch: Boolean; - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - 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); - - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) 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); - if vsVisible in Result.States then - Break; - 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 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; - 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; - -//---------------------------------------------------------------------------------------------------------------------- - -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. - -var - ForceSearch: Boolean; - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - repeat - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) 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 vsVisible in Result.States then - Break; - 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; - - // If we found a visible node we don't need to search any longer. - if vsVisible in Result.States then - 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; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - -// Returns the next visible sibling after Node. Initialization is done implicitly. - -begin - Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); - - Result := Node; - repeat - Result := GetNextSibling(Result); - until not Assigned(Result) or ((vsVisible in Result.States) and - (IncludeFiltered or not IsEffectivelyFiltered[Result])); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNextVisibleSiblingNoInit(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - -// Returns the next visible sibling after Node. - -begin - Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); - - Result := Node; - repeat - Result := Result.NextSibling; - until not Assigned(Result) or ((vsVisible in Result.States) and - (IncludeFiltered or not IsEffectivelyFiltered[Result])); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNodeAt(X, Y: Integer): PVirtualNode; - -// Overloaded variant of GetNodeAt to easy life of application developers which do not need to have the exact -// top position returned and always use client coordinates. - -var - Dummy: Integer; - -begin - Result := GetNodeAt(X, Y, True, Dummy); -end; - -function TBaseVirtualTree.GetNodeAt(const P: TPoint): PVirtualNode; -begin - Result := GetNodeAt(P.X, P.Y); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNodeAt(X, Y: Integer; Relative: Boolean; var NodeTop: Integer): PVirtualNode; - -// This method returns the node that occupies the specified point, or nil if there's none. -// If Releative is True then X and Y are given in client coordinates otherwise they are considered as being -// absolute values into the virtual tree image (regardless of the current offsets in the tree window). -// NodeTop gets the absolute or relative top position of the node returned or is untouched if no node -// could be found. - -var - AbsolutePos, - CurrentPos: Cardinal; - -begin - if Y < 0 then - Y := 0; - - AbsolutePos := Y; - if Relative then - Inc(AbsolutePos, -FOffsetY); - - // CurrentPos tracks a running term of the current position to test for. - // It corresponds always to the top position of the currently considered node. - CurrentPos := 0; - - // If the cache is available then use it. - if tsUseCache in FStates then - Result := FindInPositionCache(AbsolutePos, CurrentPos) - else - Result := GetFirstVisibleNoInit(nil, True); - - // Determine node, of which position and height corresponds to the scroll position most closely. - while Assigned(Result) and (Result <> FRoot) do - begin - if AbsolutePos < (CurrentPos + NodeHeight[Result]) then - Break; - Inc(CurrentPos, NodeHeight[Result]); - Result := GetNextVisibleNoInit(Result, True); - end; - - if Result = FRoot then - Result := nil; - - // Since the given vertical position is likely not the same as the top position - // of the found node this top position is returned. - if Assigned(Result) then - begin - NodeTop := CurrentPos; - if Relative then - Inc(NodeTop, FOffsetY); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - - -function TBaseVirtualTree.GetNodeData(Node: PVirtualNode): Pointer; - -// Returns the address of the user defined data area in the node. - -begin - Assert(FNodeDataSize > 0, 'NodeDataSize not initialized.'); - if (FNodeDataSize <= 0) or (Node = nil) or (Node = FRoot) then - Result := nil - else - begin - Result := @Node.Data; - Include(Node.States, vsOnFreeNodeCallRequired); // We now need to call OnFreeNode, see bug #323 - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNodeData(pNode: PVirtualNode): T; - -// Returns the associated data converted to the class given in the generic part of the function. - -begin - if Assigned(pNode) then - Result := T(Self.GetNodeData(pNode)^) - else - Result := Default(T); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetInterfaceFromNodeData(pNode: PVirtualNode): T; -begin - if Assigned(pNode) then - Result := T(Self.GetNodeData(pNode)^) - else - Result := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNodeDataAt(pXCoord, pYCoord: Integer): T; - -// Returns the associated data at the specified coordinates converted to the type given in the generic part of the function. - -var - lNode: PVirtualNode; -begin - lNode := GetNodeAt(pXCoord, pYCoord); - Result := Self.GetNodeData(lNode); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetFirstSelectedNodeData(): T; - -// Returns of the first selected node associated data converted to the type given in the generic part of the function. - -begin - Result := Self.GetNodeData(GetFirstSelected()); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetNodeLevel(Node: PVirtualNode): Cardinal; - -// returns the level of the given node - -var - Run: PVirtualNode; - -begin - Result := 0; - if Assigned(Node) and (Node <> FRoot) then - begin - Run := Node.Parent; - while Run <> FRoot do - begin - Run := Run.Parent; - Inc(Result); - end; - end; -end; - - -//---------------------------------------------------------------------------------------------------------------------- -// Function introduced to avoid spaghetti code to fix setting of FLastSelectionLevel -// at various places that now needs to avoid setting it for a disabled node -function TBaseVirtualTree.GetNodeLevelForSelectConstraint(Node: PVirtualNode): integer; -begin - if Assigned(Node) and not (vsDisabled in Node.States) then - result := GetNodeLevel(Node) - else - result := -1; -end; - - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPrevious(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns previous node in tree. If ConsiderChildrenAbove is True the function considers -// whether toChildrenAbove is currently set, otherwise the result will always be the previous -// node in top-down order regardless of the current PaintOptions. -// The Result will be initialized if needed. - -var - Run: PVirtualNode; - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then - begin - // Has this node got children? Initialize them if necessary. - if (vsHasChildren in Result.States) and (Result.ChildCount = 0) then - InitChildren(Result); - - // If there is a last child, take it; if not try the previous sibling. - if Assigned(Result.LastChild) then - Result := Result.LastChild - else - if Assigned(Result.PrevSibling) then - Result := Result.PrevSibling - else - begin - // If neither a last child nor a previous sibling exist, go the tree upwards and - // look, wether one of the parent nodes have a previous sibling. If not the result - // will ne nil. - repeat - Result := Result.Parent; - Run := nil; - if Result <> FRoot then - Run := Result.PrevSibling - else - Result := nil; - until Assigned(Run) or (Result = nil); - - if Assigned(Run) then - Result := Run; - end; - end - else - begin - // Is there a previous sibling? - if Assigned(Node.PrevSibling) then - begin - // Go down and find the last child node. - Result := GetLast(Node.PrevSibling); - if Result = nil then - Result := Node.PrevSibling; - end - else - // no previous sibling so the parent of the node is the previous visible node - if Node.Parent <> FRoot then - Result := Node.Parent - else - Result := nil; - end; - end; - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; - ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -begin - if (Node = nil) or (Node = FRoot) then - Result := GetLastNoInit(nil, ConsiderChildrenAbove) - else - Result := GetPreviousNoInit(Node, ConsiderChildrenAbove); - - while Assigned(Result) and (GetCheckState(Result) <> State) do - Result := GetPreviousNoInit(Result, ConsiderChildrenAbove); - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousCutCopy(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the previous node in the tree which is currently marked for a clipboard operation. Since only visible nodes can -// be marked (or they are hidden after they have been marked) it is not necessary to initialize nodes to check for -// child nodes. The result, however, is initialized if necessary. - -begin - if ClipboardStates * FStates <> [] then - begin - if (Node = nil) or (Node = FRoot) then - Result := GetLastNoInit(nil, ConsiderChildrenAbove) - else - Result := GetPreviousNoInit(Node, ConsiderChildrenAbove); - while Assigned(Result) and not (vsCutOrCopy in Result.States) do - Result := GetPreviousNoInit(Result, ConsiderChildrenAbove); - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); - end - else - Result := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousInitialized(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the previous node in tree which is initialized. - -begin - Result := Node; - repeat - Result := GetPreviousNoInit(Result, ConsiderChildrenAbove); - until (Result = nil) or (vsInitialized in Result.States); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousLeaf(Node: PVirtualNode): PVirtualNode; - -// Returns the previous node in the tree which has currently no children. -// The result is initialized if necessary. - -begin - if (Node = nil) or (Node = FRoot) then - Result := FRoot.LastChild - else - Result := GetPrevious(Node); - while Assigned(Result) and (vsHasChildren in Result.States) do - Result := GetPrevious(Result); - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousLevel(Node: PVirtualNode; NodeLevel: Cardinal): PVirtualNode; - -// Returns the previous node in the tree on a specific level. -// The result is initialized if necessary. - -var - StartNodeLevel: Cardinal; - Run: PVirtualNode; - -begin - Result := nil; - - if Assigned(Node) and (Node <> FRoot) then - begin - StartNodeLevel := GetNodeLevel(Node); - - if StartNodeLevel < NodeLevel then - begin - Result := Node.PrevSibling; - if Assigned(Result) then - begin - // go to last descendant of previous sibling with desired node level (if exists) - Run := Result; - while Assigned(Run) and (GetNodeLevel(Run) < NodeLevel) do - begin - Result := Run; - Run := GetLastChild(Run); - end; - if Assigned(Run) and (GetNodeLevel(Run) = NodeLevel) then - Result := Run - else - begin - if Assigned(Result.PrevSibling) then - Result := GetPreviousLevel(Result, NodeLevel) - else - if Assigned(Result) and (Result.Parent <> FRoot) then - Result := GetPreviousLevel(Result.Parent, NodeLevel) - else - Result := nil; - end; - end - else - Result := GetPreviousLevel(Node.Parent, NodeLevel); - end - else - if StartNodeLevel = NodeLevel then - begin - Result := Node.PrevSibling; - if not Assigned(Result) then // i.e. start node was a first sibling - begin - Result := Node.Parent; - if Assigned(Result) then - Result := GetPreviousLevel(Result, NodeLevel); - end; - end - else // i.e. StartNodeLevel > NodeLevel - Result := GetPreviousLevel(Node.Parent, NodeLevel); - end; - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns previous node in tree, optionally considering toChildrenAbove. No initialization is performed. - -var - Run: PVirtualNode; - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then - begin - // If there is a last child, take it; if not try the previous sibling. - if Assigned(Result.LastChild) then - Result := Result.LastChild - else - if Assigned(Result.PrevSibling) then - Result := Result.PrevSibling - else - begin - // If neither a last child nor a previous sibling exist, go the tree upwards and - // look, wether one of the parent nodes have a previous sibling. If not the result - // will ne nil. - repeat - Result := Result.Parent; - Run := nil; - if Result <> FRoot then - Run := Result.PrevSibling - else - Result := nil; - until Assigned(Run) or (Result = nil); - - if Assigned(Run) then - Result := Run; - end; - end - else - begin - // Is there a previous sibling? - if Assigned(Node.PrevSibling) then - begin - // Go down and find the last child node. - Result := GetLastNoInit(Node.PrevSibling); - if Result = nil then - Result := Node.PrevSibling; - end - else - // No previous sibling so the parent of the node is the previous node. - if Node.Parent <> FRoot then - Result := Node.Parent - else - Result := nil; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousSelected(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; - -// Returns the previous node in the tree which is currently selected. Since children of unitialized nodes cannot be -// in the current selection (because they simply do not exist yet) it is not necessary to initialize nodes here. -// The result however is initialized if necessary. - -begin - if FSelectionCount > 0 then - begin - if (Node = nil) or (Node = FRoot) then - Result := FRoot.LastChild - else - Result := GetPreviousNoInit(Node, ConsiderChildrenAbove); - while Assigned(Result) and not (vsSelected in Result.States) do - Result := GetPreviousNoInit(Result, ConsiderChildrenAbove); - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); - end - else - Result := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousSibling(Node: PVirtualNode): PVirtualNode; - -// Returns the previous sibling of Node and initializes it if necessary. - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - Result := Result.PrevSibling; - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); - end; -end; - -function TBaseVirtualTree.GetPreviousSiblingNoInit(Node: PVirtualNode): PVirtualNode; - -// Returns the previous sibling of Node - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - Result := Result.PrevSibling; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; - -// Returns the previous node in tree, with regard to Node, which is visible. -// Nodes which need an initialization (including the result) are initialized. -// toChildrenAbove is optionally considered which is the default here. - -var - Marker: PVirtualNode; - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - 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 - begin - Result := GetVisibleParent(Result, True); - if Result = FRoot then - Result := nil; - Marker := GetLastVisible(Result, True); - if Assigned(Marker) then - Result := Marker; - end - else - begin - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) 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; - Break; - end; - until False; - end; - - if Assigned(Result) and not (vsInitialized in Result.States) then - InitNode(Result); - end; - until not Assigned(Result) or IsEffectivelyVisible[Result]; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousVisibleNoInit(Node: PVirtualNode; - ConsiderChildrenAbove: Boolean = True): PVirtualNode; - -// Returns the previous node in tree, with regard to Node, which is visible. -// toChildrenAbove is optionally considered which is the default here. - -var - Marker: PVirtualNode; - -begin - Result := Node; - if Assigned(Result) then - begin - Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - - 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 - begin - Result := GetVisibleParent(Result, True); - if Result = FRoot then - Result := nil; - Marker := GetLastVisibleNoInit(Result, True); - if Assigned(Marker) then - Result := Marker; - end - else - begin - if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) 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; - 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; - Break; - end; - until False; - end; - end; - until not Assigned(Result) or IsEffectivelyVisible[Result]; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousVisibleSibling(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - -// Returns the previous visible sibling before Node. Initialization is done implicitly. - -begin - Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); - - Result := Node; - repeat - Result := GetPreviousSibling(Result); - until not Assigned(Result) or ((vsVisible in Result.States) and - (IncludeFiltered or not IsEffectivelyFiltered[Result])); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetPreviousVisibleSiblingNoInit(Node: PVirtualNode; - IncludeFiltered: Boolean = False): PVirtualNode; - -// Returns the previous visible sibling before Node. - -begin - Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); - - Result := Node; - repeat - Result := Result.PrevSibling; - until not Assigned(Result) or ((vsVisible in Result.States) and - (IncludeFiltered or not IsEffectivelyFiltered[Result])); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.Nodes(ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; - -// Enumeration for all nodes - -begin - Result.FMode := vneAll; - Result.FTree := Self; - Result.FConsiderChildrenAbove := ConsiderChildrenAbove; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CheckedNodes(State: TCheckState; ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; - -// Enumeration for all checked nodes - -begin - Result.FMode := vneChecked; - Result.FTree := Self; - Result.FState := State; - Result.FConsiderChildrenAbove := ConsiderChildrenAbove; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ChildNodes(Node: PVirtualNode): TVTVirtualNodeEnumeration; - -// Enumeration for child nodes - -begin - Result.FMode := vneChild; - Result.FTree := Self; - Result.FNode := Node; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.CutCopyNodes(ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; - -// Enumeration for cut copy node - -begin - Result.FMode := vneCutCopy; - Result.FTree := Self; - Result.FConsiderChildrenAbove := ConsiderChildrenAbove; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.InitializedNodes(ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; - -// Enumeration for initialized nodes - -begin - Result.FMode := vneInitialized; - Result.FTree := Self; - Result.FConsiderChildrenAbove := ConsiderChildrenAbove; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.LeafNodes: TVTVirtualNodeEnumeration; - -// Enumeration for leaf nodes - -begin - Result.FMode := vneLeaf; - Result.FTree := Self; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.LevelNodes(NodeLevel: Cardinal): TVTVirtualNodeEnumeration; - -// Enumeration for level nodes - -begin - Result.FMode := vneLevel; - Result.FTree := Self; - Result.FNodeLevel := NodeLevel; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.NoInitNodes(ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; - -// Enumeration for no init nodes -begin - Result.FMode := vneNoInit; - Result.FTree := Self; - Result.FConsiderChildrenAbove := ConsiderChildrenAbove; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.SelectedNodes(ConsiderChildrenAbove: Boolean): TVTVirtualNodeEnumeration; - -// Enumeration for selected nodes - -begin - Result.FMode := vneSelected; - Result.FTree := Self; - Result.FConsiderChildrenAbove := ConsiderChildrenAbove; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.VisibleNodes(Node: PVirtualNode; ConsiderChildrenAbove: Boolean; - IncludeFiltered: Boolean): TVTVirtualNodeEnumeration; - -// Enumeration for visible nodes - -begin - Result.FMode := vneVisible; - Result.FTree := Self; - Result.FNode := Node; - Result.FConsiderChildrenAbove := ConsiderChildrenAbove; - Result.FIncludeFiltered := IncludeFiltered; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.VisibleChildNodes(Node: PVirtualNode; IncludeFiltered: Boolean): TVTVirtualNodeEnumeration; - -// Enumeration for visible child nodes - -begin - Result.FMode := vneVisibleChild; - Result.FTree := Self; - Result.FNode := Node; - Result.FIncludeFiltered := IncludeFiltered; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.VisibleChildNoInitNodes(Node: PVirtualNode; IncludeFiltered: Boolean): TVTVirtualNodeEnumeration; - -// Enumeration for visible child no init nodes - -begin - Result.FMode := vneVisibleNoInitChild; - Result.FTree := Self; - Result.FNode := Node; - Result.FIncludeFiltered := IncludeFiltered; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.VisibleNoInitNodes(Node: PVirtualNode; ConsiderChildrenAbove: Boolean; - IncludeFiltered: Boolean): TVTVirtualNodeEnumeration; - -// Enumeration for visible no init nodes - -begin - Result.FMode := vneVisibleNoInit; - Result.FTree := Self; - Result.FNode := Node; - Result.FConsiderChildrenAbove := ConsiderChildrenAbove; - Result.FIncludeFiltered := IncludeFiltered; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetSortedCutCopySet(Resolve: Boolean): TNodeArray; - -// Same as GetSortedSelection but with nodes marked as being part in the current cut/copy set (e.g. for clipboard). - -var - Run: PVirtualNode; - Counter: Cardinal; - - //--------------- local function -------------------------------------------- - - procedure IncludeThisNode(Node: PVirtualNode); - - // adds the given node to the result - - var - Len: Cardinal; - - begin - Len := Length(Result); - if Counter = Len then - begin - if Len < 100 then - Len := 100 - else - Len := Len + Len div 10; - SetLength(Result, Len); - end; - Result[Counter] := Node; - Inc(Counter); - end; - - //--------------- end local function ---------------------------------------- - -begin - Run := FRoot.FirstChild; - Counter := 0; - if Resolve then - begin - // Resolving is actually easy: just find the first cutted node in logical order - // and then never go deeper in level than this node as long as there's a sibling node. - // Restart the search for a cutted node (at any level) if there are no further siblings. - while Assigned(Run) do - begin - if vsCutOrCopy in Run.States then - begin - IncludeThisNode(Run); - if Assigned(Run.NextSibling) then - Run := Run.NextSibling - else - begin - // If there are no further siblings then go up one or more levels until a node is - // found or all nodes have been processed. Although we consider here only initialized - // nodes we don't need to make any special checks as only initialized nodes can also be selected. - repeat - Run := Run.Parent; - until (Run = FRoot) or Assigned(Run.NextSibling); - if Run = FRoot then - Break - else - Run := Run.NextSibling; - end; - end - else - Run := GetNextNoInit(Run); - end; - end - else - while Assigned(Run) do - begin - if vsCutOrCopy in Run.States then - IncludeThisNode(Run); - Run := GetNextNoInit(Run); - end; - - // set the resulting array to its real length - SetLength(Result, Counter); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetSortedSelection(Resolve: Boolean): TNodeArray; - -// Returns a list of selected nodes sorted in logical order, that is, as they appear in the tree. -// If Resolve is True then nodes which are children of other selected nodes are not put into the new array. -// This feature is in particuar important when doing drag'n drop as in this case all selected node plus their children -// need to be considered. A selected node which is child (grand child etc.) of another selected node is then -// automatically included and doesn't need to be explicitely mentioned in the returned selection array. -// -// Note: The caller is responsible for freeing the array. Allocation is done here. Usually, though, freeing the array -// doesn't need additional attention as it is automatically freed by Delphi when it gets out of scope. - -var - Run: PVirtualNode; - Counter: Cardinal; - -begin - SetLength(Result, FSelectionCount); - if FSelectionCount > 0 then - begin - Run := FRoot.FirstChild; - Counter := 0; - if Resolve then - begin - // Resolving is actually easy: just find the first selected node in logical order - // and then never go deeper in level than this node as long as there's a sibling node. - // Restart the search for a selected node (at any level) if there are no further siblings. - while Assigned(Run) do - begin - if vsSelected in Run.States then - begin - Result[Counter] := Run; - Inc(Counter); - if Assigned(Run.NextSibling) then - Run := Run.NextSibling - else - begin - // If there are no further siblings then go up one or more levels until a node is - // found or all nodes have been processed. Although we consider here only initialized - // nodes we don't need to make any special checks as only initialized nodes can also be selected. - repeat - Run := Run.Parent; - until (Run = FRoot) or Assigned(Run.NextSibling); - if Run = FRoot then - Break - else - Run := Run.NextSibling; - end; - end - else - Run := GetNextNoInit(Run); - end; - end - else - while Assigned(Run) do - begin - if vsSelected in Run.States then - begin - Result[Counter] := Run; - Inc(Counter); - end; - Run := GetNextNoInit(Run); - end; - - // Since we may have skipped some nodes the result array is likely to be smaller than the - // selection array, hence shorten the result to true length. - if Integer(Counter) < Length(Result) then - SetLength(Result, Counter); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.GetTextInfo(Node: PVirtualNode; Column: TColumnIndex; const AFont: TFont; var R: TRect; - var Text: string); - -// Generic base method for editors, hint windows etc. to get some info about a node. - -begin - R := Rect(0, 0, 0, 0); - Text := ''; - if Assigned(Font) then // 1 EConvertError due to Font being nil seen here in 01/2019, See issue #878 - AFont.Assign(Font); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetTreeRect: TRect; - -// Returns the true size of the tree in pixels. This size is at least ClientHeight x ClientWidth and depends on -// the expand state, header size etc. -// Note: if no columns are used then the width of the tree is determined by the largest node which is currently in the -// client area. This might however not be the largest node in the entire tree. - -begin - Result := Rect(0, 0, Max(FRangeX, ClientWidth), Max(FRangeY, ClientHeight)); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.GetVisibleParent(Node: PVirtualNode; IncludeFiltered: Boolean = False): PVirtualNode; - -// Returns the first (nearest) parent node of Node which is visible. -// This method is one of the seldom cases where the hidden root node could be returned. - -begin - Assert(Assigned(Node), 'Node must not be nil.'); - Assert(Node <> FRoot, 'Node must not be the hidden root node.'); - - Result := Node.Parent; - while (Result <> FRoot) and (not FullyVisible[Result] or (not IncludeFiltered and IsEffectivelyFiltered[Result])) do - Result := Result.Parent; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.HasAsParent(Node, PotentialParent: PVirtualNode): Boolean; - -// Determines whether Node has got PotentialParent as one of its parents. - -var - Run: PVirtualNode; - -begin - Result := Assigned(Node) and Assigned(PotentialParent) and (Node <> PotentialParent); - if Result then - begin - Run := Node; - while (Run <> FRoot) and (Run <> PotentialParent) do - Run := Run.Parent; - Result := Run = PotentialParent; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.InsertNode(Node: PVirtualNode; Mode: TVTNodeAttachMode; UserData: Pointer = nil): PVirtualNode; - -// Adds a new node relative to Node. The final position is determined by Mode. -// UserData can be used to set the first SizeOf(Pointer) bytes of the user data area to an initial value which can be used -// in OnInitNode and will also cause to trigger the OnFreeNode event (if <> nil) even if the node is not yet -// "officially" initialized. -// InsertNode is a compatibility method and will implicitly validate the given node if the new node -// is to be added as child node. This is however against the virtual paradigm and hence I dissuade from its usage. - -begin - if Mode <> amNoWhere then - begin - CancelEditNode; - - if Node = nil then - Node := FRoot; - // we need a new node... - Result := MakeNewNode; - // avoid erronous attach modes - if Node = FRoot then - begin - case Mode of - amInsertBefore: - Mode := amAddChildFirst; - amInsertAfter: - Mode := amAddChildLast; - end; - end; - - // Validate given node in case the new node becomes its child. - if (Mode in [amAddChildFirst, amAddChildLast]) and not (vsInitialized in Node.States) then - InitNode(Node); - InternalConnectNode(Result, Node, Self, Mode); - - // Check if there is initial user data and there is also enough user data space allocated. - if Assigned(UserData) then - SetNodeData(Result, UserData); - - if FUpdateCount = 0 then - begin - case Mode of - amInsertBefore, - amInsertAfter: - begin - // Here no initialization is necessary because *if* a node has already got children then it - // must also be initialized. - // Note: Node can never be FRoot at this point. - StructureChange(Result, crNodeAdded); - // If auto sort is enabled then sort the node or its parent (depending on the insert mode). - if (toAutoSort in FOptions.FAutoOptions) and (FHeader.FSortColumn > InvalidColumn) then - Sort(Node.Parent, FHeader.FSortColumn, FHeader.FSortDirection, True); - InvalidateToBottom(Result) - end; - amAddChildFirst, - amAddChildLast: - begin - StructureChange(Node, crChildAdded); - // If auto sort is enabled then sort the node or its parent (depending on the insert mode). - if (toAutoSort in FOptions.FAutoOptions) and (FHeader.FSortColumn > InvalidColumn) then - Sort(Node, FHeader.FSortColumn, FHeader.FSortDirection, True); - InvalidateToBottom(Node); - end; - end; - InvalidateCache(); - UpdateScrollBars(True); - end; - end - else - Result := nil; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InvalidateChildren(Node: PVirtualNode; Recursive: Boolean); - -// Invalidates Node and its immediate children. -// If Recursive is True then all grandchildren are invalidated as well. -// The node itself is initialized if necessary and its child nodes are created (and initialized too if -// Recursive is True). - -var - Run: PVirtualNode; - -begin - if Assigned(Node) then - begin - if not (vsInitialized in Node.States) then - InitNode(Node); - InvalidateNode(Node); - if (vsHasChildren in Node.States) and (Node.ChildCount = 0) then - InitChildren(Node); - Run := Node.FirstChild; - end - else - Run := FRoot.FirstChild; - - while Assigned(Run) do - begin - InvalidateNode(Run); - if Recursive then - InvalidateChildren(Run, True); - Run := Run.NextSibling; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InvalidateColumn(Column: TColumnIndex); - -// Invalidates the client area part of a column. - -var - R: TRect; - -begin - if (FUpdateCount = 0) and HandleAllocated and FHeader.FColumns.IsValidColumn(Column) then - begin - R := ClientRect; - FHeader.Columns.GetColumnBounds(Column, R.Left, R.Right); - InvalidateRect(Handle, @R, False); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.InvalidateNode(Node: PVirtualNode): TRect; - -// Initiates repaint of the given node and returns the just invalidated rectangle. - -begin - Assert(Assigned(Node), 'Node must not be nil.'); - Assert(GetCurrentThreadId = MainThreadId, 'UI controls may only be chnaged in UI thread.'); - // Reset height measured flag too to cause a re-issue of the OnMeasureItem event. - Exclude(Node.States, vsHeightMeasured); - if (FUpdateCount = 0) and HandleAllocated then - begin - Result := GetDisplayRect(Node, NoColumn, False); - InvalidateRect(Handle, @Result, False); - end - else - result := Rect(-1,-1,-1,-1); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InvalidateToBottom(Node: PVirtualNode); - -// Initiates repaint of client area starting at given node. If this node is not visible or not yet initialized -// then nothing happens. - -var - R: TRect; - -begin - if (FUpdateCount = 0) and HandleAllocated then - begin - if (Node = nil) or (Node = FRoot) then - Invalidate - else - if (vsInitialized in Node.States) and IsEffectivelyVisible[Node] then - begin - R := GetDisplayRect(Node, NoColumn, False); - if R.Top < ClientHeight then - begin - if (toChildrenAbove in FOptions.FPaintOptions) and (vsExpanded in Node.States) then - Dec(R.Top, Node.TotalHeight + NodeHeight[Node]); - R.Bottom := ClientHeight; - InvalidateRect(Handle, @R, False); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.InvertSelection(VisibleOnly: Boolean); - -// Inverts the current selection (so nodes which are selected become unselected and vice versa). -// If VisibleOnly is True then only visible nodes are considered. - -var - Run: PVirtualNode; - NewSize: Integer; - NextFunction: TGetNextNodeProc; - TriggerChange: Boolean; - -begin - if not FSelectionLocked and (toMultiSelect in FOptions.FSelectionOptions) then - begin - Run := FRoot.FirstChild; - ClearTempCache; - if VisibleOnly then - NextFunction := GetNextVisibleNoInit - else - NextFunction := GetNextNoInit; - while Assigned(Run) do - begin - if vsSelected in Run.States then - InternalRemoveFromSelection(Run) - else - InternalCacheNode(Run); - Run := NextFunction(Run); - end; - - // do some housekeeping - // Need to trigger the OnChange event from here if nodes were only deleted but not added. - TriggerChange := False; - NewSize := PackArray(FSelection, FSelectionCount); - if NewSize > -1 then - begin - FSelectionCount := NewSize; - SetLength(FSelection, FSelectionCount); - TriggerChange := True; - end; - if FTempNodeCount > 0 then - begin - AddToSelection(FTempNodeCache, FTempNodeCount); - ClearTempCache; - TriggerChange := False; - end; - Invalidate; - if TriggerChange then - Change(nil); - if Self.SelectedCount = 0 then - FNextNodeToSelect := nil;//Ensure that no other node is selected now - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.IsEditing: Boolean; - -begin - Result := tsEditing in FStates; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.IsMouseSelecting: Boolean; - -begin - Result := (tsDrawSelPending in FStates) or (tsDrawSelecting in FStates); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.IterateSubtree(Node: 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) -// and calls for each node the provided callback method (which must not be empty). -// Filter determines which nodes to consider (an empty set denotes all nodes). -// If DoInit is True then nodes which aren't initialized yet will be initialized. -// Note: During execution of the callback the application can set Abort to True. In this case the iteration is stopped -// and the last accessed node (the one on which the callback set Abort to True) is returned to the caller. -// Otherwise (no abort) nil is returned. - -var - Stop: PVirtualNode; - Abort: Boolean; - GetNextNode: TGetNextNodeProc; - WasIterating: Boolean; - -begin - Assert(Node <> FRoot, 'Node must not be the hidden root node.'); - - WasIterating := tsIterating in FStates; - DoStateChange([tsIterating]); - try - // prepare function to be used when advancing - if DoInit then - GetNextNode := GetNext - else - GetNextNode := GetNextNoInit; - - Abort := False; - if Node = nil then - Stop := nil - else - begin - if not (vsInitialized in Node.States) and DoInit then - InitNode(Node); - - // The stopper does not need to be initialized since it is not taken into the enumeration. - Stop := Node.NextSibling; - if Stop = nil then - begin - Stop := Node; - repeat - Stop := Stop.Parent; - until (Stop = FRoot) or Assigned(Stop.NextSibling); - if Stop = FRoot then - Stop := nil - else - Stop := Stop.NextSibling; - end; - end; - - // Use first node if we start with the root. - if Node = nil then - Node := GetFirstNoInit; - - if Assigned(Node) then - begin - if not (vsInitialized in Node.States) and DoInit then - InitNode(Node); - - // 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); - end; - - if Filter = [] then - begin - // unfiltered loop - while Assigned(Node) and (Node <> Stop) do - begin - Callback(Self, Node, Data, Abort); - if Abort then - Break; - Node := GetNextNode(Node); - end; - end - else - begin - // filtered loop - while Assigned(Node) and (Node <> Stop) do - begin - if Node.States * Filter = Filter then - Callback(Self, Node, Data, Abort); - if Abort then - Break; - Node := GetNextNode(Node); - end; - end; - end; - - if Abort then - Result := Node - else - Result := nil; - finally - if not WasIterating then - DoStateChange([], [tsIterating]); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.LoadFromFile(const FileName: TFileName); - -var - FileStream: TFileStream; - -begin - FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(FileStream); - finally - FileStream.Free; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.LoadFromStream(Stream: TStream); - -// Clears the current content of the tree and loads a new structure from the given stream. - -var - ThisID: TMagicID; - Version, - Count: Cardinal; - Node: PVirtualNode; - -begin - if not (toReadOnly in FOptions.FMiscOptions) then - begin - Clear; - // Check first whether this is a stream we can read. - if Stream.Read(ThisID, SizeOf(TMagicID)) < SizeOf(TMagicID) then - ShowError(SStreamTooSmall, hcTFStreamTooSmall); - - if (ThisID[0] = MagicID[0]) and - (ThisID[1] = MagicID[1]) and - (ThisID[2] = MagicID[2]) and - (ThisID[5] = MagicID[5]) then - begin - Version := Word(ThisID[3]); - if Version <= VTTreeStreamVersion then - begin - BeginUpdate; - try - if Version < 2 then - Count := MaxInt - else - Stream.ReadBuffer(Count, SizeOf(Count)); - - while (Stream.Position < Stream.Size) and (Count > 0) do - begin - Dec(Count); - Node := MakeNewNode; - InternalConnectNode(Node, FRoot, Self, amAddChildLast); - InternalAddFromStream(Stream, Version, Node); - end; - DoNodeCopied(nil); - if Assigned(FOnLoadTree) then - FOnLoadTree(Self, Stream); - finally - EndUpdate; - end; - end - else - ShowError(SWrongStreamVersion, hcTFWrongStreamVersion); - end - else - ShowError(SWrongStreamFormat, hcTFWrongStreamFormat); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.MeasureItemHeight(const Canvas: TCanvas; Node: PVirtualNode); - -// If the height of the given node has not yet been measured then do it now. - -var - NewNodeHeight: Integer; - -begin - if not (vsHeightMeasured in Node.States) then - begin - Include(Node.States, vsHeightMeasured); - if (toVariableNodeHeight in FOptions.FMiscOptions) then - begin - NewNodeHeight := Node.NodeHeight; - // Anonymous methods help to make this thread safe easily. - if (MainThreadId <> GetCurrentThreadId) then - TThread.Synchronize(nil, - procedure - begin - DoMeasureItem(Canvas, Node, NewNodeHeight); - SetNodeHeight(Node, NewNodeHeight); - end - ) - else - begin - DoMeasureItem(Canvas, Node, NewNodeHeight); - SetNodeHeight(Node, NewNodeHeight); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.MoveTo(Node: PVirtualNode; Tree: TBaseVirtualTree; Mode: TVTNodeAttachMode; - ChildrenOnly: Boolean); - -// A simplified method to allow to move nodes to the root of another tree. - -begin - MoveTo(Node, Tree.FRoot, Mode, ChildrenOnly); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.MoveTo(Source, Target: PVirtualNode; Mode: TVTNodeAttachMode; ChildrenOnly: Boolean); - -// Moves the given node (and all its children) to Target. Source must belong to the tree instance which calls this -// MoveTo method. Mode determines how to connect Source to Target. -// This method might involve a change of the tree if Target belongs to a different tree than Source. - -var - TargetTree: TBaseVirtualTree; - Allowed: Boolean; - NewNode: PVirtualNode; - Stream: TMemoryStream; - -begin - Assert(TreeFromNode(Source) = Self, 'The source tree must contain the source node.'); - - // When moving nodes then source and target must not be the same node unless only the source's children are - // moved and they are inserted before or after the node itself. - Allowed := (Source <> Target) or ((Mode in [amInsertBefore, amInsertAfter]) and ChildrenOnly); - - if Allowed and (Mode <> amNoWhere) and Assigned(Source) and (Source <> FRoot) and - not (toReadOnly in FOptions.FMiscOptions) then - begin - // Assume that an empty destination means the root in this (the source) tree. - if Target = nil then - begin - TargetTree := Self; - Target := FRoot; - Mode := amAddChildFirst; - end - else - TargetTree := TreeFromNode(Target); - - if Target = TargetTree.FRoot then - begin - case Mode of - amInsertBefore: - Mode := amAddChildFirst; - amInsertAfter: - Mode := amAddChildLast; - end; - end; - - // Make sure the target node is initialized. - if not (vsInitialized in Target.States) then - TargetTree.InitNode(Target) - else - if (vsHasChildren in Target.States) and (Target.ChildCount = 0) then - TargetTree.InitChildren(Target); - - if TargetTree = Self then - begin - // Simple case: move node(s) within the same tree. - if Target = FRoot then - Allowed := DoNodeMoving(Source, nil) - else - Allowed := DoNodeMoving(Source, Target); - if Allowed then - begin - // Check first that Source is not added as new child to a target node which - // is already a child of Source. - // Consider the case Source and Target are the same node, but only child nodes are moved. - if (Source <> Target) and HasAsParent(Target, Source) then - ShowError(SWrongMoveError, hcTFWrongMoveError); - - if not ChildrenOnly then - begin - // Disconnect from old location. - InternalDisconnectNode(Source, True); - // Connect to new location. - InternalConnectNode(Source, Target, Self, Mode); - DoNodeMoved(Source); - end - else - begin - // Only child nodes should be moved. Insertion order depends on move mode. - if Mode = amAddChildFirst then - begin - Source := Source.LastChild; - while Assigned(Source) do - begin - NewNode := Source.PrevSibling; - // Disconnect from old location. - InternalDisconnectNode(Source, True, False); - // Connect to new location. - InternalConnectNode(Source, Target, Self, Mode); - DoNodeMoved(Source); - Source := NewNode; - end; - end - else - begin - Source := Source.FirstChild; - while Assigned(Source) do - begin - NewNode := Source.NextSibling; - // Disconnect from old location. - InternalDisconnectNode(Source, True, False); - // Connect to new location. - InternalConnectNode(Source, Target, Self, Mode); - DoNodeMoved(Source); - Source := NewNode; - end; - end; - end; - end; - end - else - begin - // Difficult case: move node(s) to another tree. - // In opposition to node copying we ask only once if moving is allowed because - // we cannot take back a move once done. - if Target = TargetTree.FRoot then - Allowed := DoNodeMoving(Source, nil) - else - Allowed := DoNodeMoving(Source, Target); - - if Allowed then - begin - Stream := TMemoryStream.Create; - try - // Write all nodes into a temporary stream depending on the ChildrenOnly flag. - if not ChildrenOnly then - WriteNode(Stream, Source) - else - begin - Source := Source.FirstChild; - while Assigned(Source) do - begin - WriteNode(Stream, Source); - Source := Source.NextSibling; - end; - end; - // Now load the serialized nodes into the target node (tree). - TargetTree.BeginUpdate; - try - Stream.Position := 0; - while Stream.Position < Stream.Size do - begin - NewNode := TargetTree.MakeNewNode; - InternalConnectNode(NewNode, Target, TargetTree, Mode); - TargetTree.InternalAddFromStream(Stream, VTTreeStreamVersion, NewNode); - DoNodeMoved(NewNode); - end; - finally - TargetTree.EndUpdate; - end; - finally - Stream.Free; - end; - // finally delete original nodes - BeginUpdate; - try - if ChildrenOnly then - DeleteChildren(Source) - else - DeleteNode(Source); - finally - EndUpdate; - end; - end; - end; - - InvalidateCache; - if (FUpdateCount = 0) and Allowed then - begin - ValidateCache; - UpdateScrollBars(True); - Invalidate; - if TargetTree <> Self then - TargetTree.Invalidate; - end; - StructureChange(Source, crNodeMoved); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.PaintTree(TargetCanvas: TCanvas; Window: TRect; Target: TPoint; - PaintOptions: TVTInternalPaintOptions; PixelFormat: TPixelFormat); - -// This is the core paint routine of the tree. It is responsible for maintaining the paint cycles per node as well -// as coordinating drawing of the various parts of the tree image. -// TargetCanvas is the canvas to which to draw the tree image. This is usually the tree window itself but could well -// be a bitmap or printer canvas. -// Window determines which part of the entire tree image to draw. The full size of the virtual image is determined -// by GetTreeRect. -// Target is the position in TargetCanvas where to draw the tree part specified by Window. -// PaintOptions determines what of the tree to draw. For different tasks usually different parts need to be drawn, with -// a full image in the window, selected only nodes for a drag image etc. - -const - ImageKind: array[Boolean] of TVTImageKind = (ikNormal, ikSelected); - -var - DrawSelectionRect, - UseBackground, - ShowCheckImages, - UseColumns, - IsMainColumn: Boolean; - - IndentSize, - ButtonY: Integer; // Y position of toggle button within the node's rect - LineImage: TLineImage; - PaintInfo: TVTPaintInfo; // all necessary information about a node to pass to the paint routines - - R, // the area of an entire node in its local coordinate - TargetRect, // the area of a node (part) in the target canvas - SelectionRect, // ordered rectangle used for drawing the selection focus rect - ClipRect: TRect; // area to which the canvas will be clipped when painting a node's content - NextColumn: TColumnIndex; - BaseOffset: Integer; // top position of the top node to draw given in absolute tree coordinates - NodeBitmap: TBitmap; // small buffer to draw flicker free - MaximumRight, // maximum horizontal target position - MaximumBottom: Integer; // maximum vertical target position - SelectLevel: Integer; // > 0 if current node is selected or child/grandchild etc. of a selected node - FirstColumn: TColumnIndex; // index of first column which is at least partially visible in the given window - - MaxRight, - ColLeft, - ColRight: Integer; - - SavedTargetDC: Integer; - PaintWidth: Integer; - CurrentNodeHeight: Integer; - lUseSelectedBkColor: Boolean; // determines if the dotted grid lines need to be painted in selection color of background color - - CellIsTouchingClientRight: Boolean; - CellIsInLastColumn: Boolean; - ColumnIsFixed: Boolean; - -begin - if not (tsPainting in FStates) then - begin - DoStateChange([tsPainting]); - try - DoBeforePaint(TargetCanvas); - - if poUnbuffered in PaintOptions then - SavedTargetDC := SaveDC(TargetCanvas.Handle) - else - SavedTargetDC := 0; - - // Prepare paint info structure. - ZeroMemory(@PaintInfo, SizeOf(PaintInfo)); - - PaintWidth := Window.Right - Window.Left; - - if not (poUnbuffered in PaintOptions) then - begin - // Create small bitmaps and initialize default values. - // The bitmaps are used to paint one node at a time and to draw the result to the target (e.g. screen) in one step, - // to prevent flickering. - NodeBitmap := TBitmap.Create; - // For alpha blending we need the 32 bit pixel format. For other targets there might be a need for a certain - // pixel format (e.g. printing). - if ((FDrawSelectionMode = smBlendedRectangle) or (tsUseThemes in FStates) or - (toUseBlendedSelection in FOptions.PaintOptions)) then - NodeBitmap.PixelFormat := pf32Bit - else - NodeBitmap.PixelFormat := PixelFormat; - - NodeBitmap.Width := PaintWidth; - - // Make sure the buffer bitmap and target bitmap use the same transformation mode. - SetMapMode(NodeBitmap.Canvas.Handle, GetMapMode(TargetCanvas.Handle)); - PaintInfo.Canvas := NodeBitmap.Canvas; - end - else - begin - PaintInfo.Canvas := TargetCanvas; - NodeBitmap := nil; - end; - - // Lock the canvas to avoid that it gets freed on the way. - PaintInfo.Canvas.Lock; - try - // Prepare the current selection rectangle once. The corner points are absolute tree coordinates. - SelectionRect := OrderRect(FNewSelRect); - DrawSelectionRect := IsMouseSelecting and not IsRectEmpty(SelectionRect) and (GetKeyState(VK_LBUTTON) < 0); - - // R represents an entire node (all columns), but is a bit unprecise when it comes to - // trees without any column defined, because FRangeX only represents the maximum width of all - // nodes in the client area (not all defined nodes). There might be, however, wider nodes somewhere. Without full - // validation I cannot better determine the width, though. By using at least the control's width it is ensured - // that the tree is fully displayed on screen. - R := Rect(0, 0, Max(FRangeX, ClientWidth), 0); - - // For quick checks some intermediate variables are used. - UseBackground := (toShowBackground in FOptions.FPaintOptions) and Assigned(FBackground.Graphic) and - (poBackground in PaintOptions); - ShowCheckImages := Assigned(FCheckImages) and (toCheckSupport in FOptions.FMiscOptions); - UseColumns := FHeader.UseColumns; - - // Adjust paint options to tree settings. Hide selection if told so or the tree is unfocused. - if (toAlwaysHideSelection in FOptions.FPaintOptions) or - (not Focused and (toHideSelection in FOptions.FPaintOptions)) then - Exclude(PaintOptions, poDrawSelection); - if toHideFocusRect in FOptions.FPaintOptions then - Exclude(PaintOptions, poDrawFocusRect); - - // Determine node to start drawing with. - BaseOffset := 0; - PaintInfo.Node := GetNodeAt(0, Window.Top, False, BaseOffset); - if PaintInfo.Node = nil then - BaseOffset := Window.Top; - - // Transform selection rectangle into node bitmap coordinates. - if DrawSelectionRect then - OffsetRect(SelectionRect, 0, -BaseOffset); - - // The target rectangle holds the coordinates of the exact area to blit in target canvas coordinates. - // It is usually smaller than an entire node and wanders while the paint loop advances. - MaximumRight := Target.X + (Window.Right - Window.Left); - MaximumBottom := Target.Y + (Window.Bottom - Window.Top); - - TargetRect := Rect(Target.X, Target.Y - (Window.Top - BaseOffset), MaximumRight, 0); - TargetRect.Bottom := TargetRect.Top; - TargetCanvas.Font := Self.Font; - - // This marker gets the index of the first column which is visible in the given window. - // This is needed for column based background colors. - FirstColumn := InvalidColumn; - - if Assigned(PaintInfo.Node) then - begin - - // ----- main node paint loop - while Assigned(PaintInfo.Node) do - begin - // Determine LineImage, SelectionLevel and IndentSize - SelectLevel := DetermineLineImageAndSelectLevel(PaintInfo.Node, LineImage); - IndentSize := Length(LineImage); - - // Initialize node if not already done. - if not (vsInitialized in PaintInfo.Node.States) then - InitNode(PaintInfo.Node); - if (vsSelected in PaintInfo.Node.States) and not (toChildrenAbove in FOptions.FPaintOptions) then - Inc(SelectLevel); - - // Ensure the node's height is determined. - MeasureItemHeight(PaintInfo.Canvas, PaintInfo.Node); - - // Adjust the brush origin for dotted lines depending on the current source position. - // It is applied some lines later, as the canvas might get reallocated, when changing the node bitmap. - PaintInfo.BrushOrigin := Point(Window.Left and 1, BaseOffset and 1); - Inc(BaseOffset, PaintInfo.Node.NodeHeight); - - TargetRect.Bottom := TargetRect.Top + PaintInfo.Node.NodeHeight; - - // If poSelectedOnly is active then do the following stuff only for selected nodes or nodes - // which are children of selected nodes. - if (SelectLevel > 0) or not (poSelectedOnly in PaintOptions) then - begin - if not (poUnbuffered in PaintOptions) then - begin - // Adjust height of temporary node bitmap. - with NodeBitmap do - begin - if Height <> PaintInfo.Node.NodeHeight then - begin - // Avoid that the VCL copies the bitmap while changing its height. - Height := 0; - Height := PaintInfo.Node.NodeHeight; - SetCanvasOrigin(Canvas, Window.Left, 0); - end; - end; - end - else - begin - SetCanvasOrigin(PaintInfo.Canvas, -TargetRect.Left + Window.Left, -TargetRect.Top); - ClipCanvas(PaintInfo.Canvas, Rect(0, 0, TargetRect.Right - TargetRect.Left, - Min(TargetRect.Bottom - TargetRect.Top, MaximumBottom - TargetRect.Top))); // See issue #579 - end; - - // Set the origin of the canvas' brush. This depends on the node heights. - with PaintInfo do - SetBrushOrigin(Canvas, BrushOrigin.X, BrushOrigin.Y); - - CurrentNodeHeight := PaintInfo.Node.NodeHeight; - R.Bottom := CurrentNodeHeight; - - // Let application decide whether the node should normally be drawn or by the application itself. - if not DoBeforeItemPaint(PaintInfo.Canvas, PaintInfo.Node, R) then - begin - // Init paint options for the background painting. - PaintInfo.PaintOptions := PaintOptions; - - // The node background can contain a single color, a bitmap or can be drawn by the application. - ClearNodeBackground(PaintInfo, UseBackground, True, Rect(Window.Left, TargetRect.Top, Window.Right, - TargetRect.Bottom)); - - // Prepare column, position and node clipping rectangle. - PaintInfo.CellRect := R; - if UseColumns then - InitializeFirstColumnValues(PaintInfo); - - // Now go through all visible columns (there's still one run if columns aren't used). - with FHeader.FColumns do - begin - while ((PaintInfo.Column > InvalidColumn) or not UseColumns) - and (PaintInfo.CellRect.Left < Window.Right) do - begin - if UseColumns then - begin - PaintInfo.Column := FPositionToIndex[PaintInfo.Position]; - if FirstColumn = InvalidColumn then - FirstColumn := PaintInfo.Column; - PaintInfo.BidiMode := Items[PaintInfo.Column].FBiDiMode; - PaintInfo.Alignment := Items[PaintInfo.Column].FAlignment; - end - else - begin - PaintInfo.Column := NoColumn; - PaintInfo.BidiMode := BidiMode; - PaintInfo.Alignment := FAlignment; - end; - GetOffSets(PaintInfo.Node, PaintInfo.Offsets, TVTElement.ofsText, PaintInfo.Column); - - PaintInfo.PaintOptions := PaintOptions; - with PaintInfo do - begin - if (tsEditing in FStates) and (Node = FFocusedNode) and - ((Column = FEditColumn) or not UseColumns) then - Exclude(PaintOptions, poDrawSelection); - if not UseColumns or - ((vsSelected in Node.States) and (toFullRowSelect in FOptions.FSelectionOptions) and - (poDrawSelection in PaintOptions)) or - (coParentColor in Items[PaintInfo.Column].Options) or - ((coStyleColor in Items[PaintInfo.Column].Options) and VclStyleEnabled) - then - Exclude(PaintOptions, poColumnColor); - end; - IsMainColumn := PaintInfo.Column = FHeader.MainColumn; - - // Consider bidi mode here. In RTL context means left alignment actually right alignment and vice versa. - if PaintInfo.BidiMode <> bdLeftToRight then - ChangeBiDiModeAlignment(PaintInfo.Alignment); - - // Paint the current cell if it is marked as being visible or columns aren't used and - // if this cell belongs to the main column if only the main column should be drawn. - if (not UseColumns or (coVisible in Items[PaintInfo.Column].FOptions)) and - (not (poMainOnly in PaintOptions) or IsMainColumn) then - begin - AdjustPaintCellRect(PaintInfo, NextColumn); - - // Paint the cell only if it is in the current window. - if PaintInfo.CellRect.Right > Window.Left then - begin - with PaintInfo do - begin - // Fill in remaining values in the paint info structure. - NodeWidth := DoGetNodeWidth(Node, Column, Canvas); - - if ShowCheckImages and IsMainColumn then - begin - ImageInfo[iiCheck].Index := GetCheckImage(Node); - ImageInfo[iiCheck].Images := FCheckImages; - ImageInfo[iiCheck].Ghosted := False; - end - else - ImageInfo[iiCheck].Index := -1; - GetImageIndex(PaintInfo, ikState, iiState); - GetImageIndex(PaintInfo, ImageKind[vsSelected in Node.States], iiNormal); - - CalculateVerticalAlignments(PaintInfo, ButtonY); - // Take the space for the tree lines into account. - PaintInfo.AdjustImageCoordinates(); - if UseColumns then - begin - ClipRect := CellRect; - if poUnbuffered in PaintOptions then - begin - ClipRect.Left := Max(ClipRect.Left, Window.Left); - ClipRect.Right := Min(ClipRect.Right, Window.Right); - ClipRect.Top := Max(ClipRect.Top, Window.Top - (BaseOffset - CurrentNodeHeight)); - ClipRect.Bottom := ClipRect.Bottom - Max(TargetRect.Bottom - MaximumBottom, 0); - end; - ClipCanvas(Canvas, ClipRect); - end; - - // Paint the horizontal grid line. - if (poGridLines in PaintOptions) and (toShowHorzGridLines in FOptions.FPaintOptions) then - begin - Canvas.Font.Color := FColors.GridLineColor; - if IsMainColumn and (FLineMode = lmBands) then - begin - if BidiMode = bdLeftToRight then - begin - DrawDottedHLine(PaintInfo, CellRect.Left + IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * Integer(FIndent), CellRect.Right - 1, - CellRect.Bottom - 1); - end - else - begin - DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right - IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * Integer(FIndent) - 1, - CellRect.Bottom - 1); - end; - end - else - DrawDottedHLine(PaintInfo, CellRect.Left, CellRect.Right, CellRect.Bottom - 1); - - Dec(CellRect.Bottom); - Dec(ContentRect.Bottom); - end; - - if UseColumns then - begin - // Paint vertical grid line. - if (poGridLines in PaintOptions) and (toShowVertGridLines in FOptions.FPaintOptions) then - begin - // These variables and the nested if conditions shall make the logic - // easier to understand. - CellIsTouchingClientRight := PaintInfo.CellRect.Right = ClientRect.Right; - CellIsInLastColumn := Position = TColumnPosition(Count - 1); - ColumnIsFixed := coFixed in FHeader.FColumns[Column].Options; - - // Don't draw if this is the last column and the header is in autosize mode. - if not ((hoAutoResize in FHeader.FOptions) and CellIsInLastColumn) then - begin - // We have to take spanned cells into account which we determine - // by checking if CellRect.Right equals the Window.Right. - // But since the PaintTree procedure is called twice in - // TBaseVirtualTree.Paint (i.e. for fixed columns and other columns. - // CellIsTouchingClientRight does not work for fixed columns.) - // we have to paint fixed column grid line anyway. - if not CellIsTouchingClientRight or ColumnIsFixed then - begin - if (BidiMode = bdLeftToRight) or not ColumnIsEmpty(Node, Column) then - begin - Canvas.Font.Color := FColors.GridLineColor; - lUseSelectedBkColor := (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and - (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) and not - (tsUseExplorerTheme in FStates); - DrawDottedVLine(PaintInfo, CellRect.Top, CellRect.Bottom, CellRect.Right - 1, lUseSelectedBkColor); - end; - - Dec(CellRect.Right); - Dec(ContentRect.Right); - end; - end; - end; - end; - - // Prepare background and focus rect for the current cell. - PrepareCell(PaintInfo, Window.Left, PaintWidth); - - // Some parts are only drawn for the main column. - if IsMainColumn then - begin - if (toShowTreeLines in FOptions.FPaintOptions) and - (not (toHideTreeLinesIfThemed in FOptions.FPaintOptions) or - not (tsUseThemes in FStates)) then - PaintTreeLines(PaintInfo, IfThen(toFixedIndent in FOptions.FPaintOptions, 1, - IndentSize), LineImage); - // Show node button if allowed, if there child nodes and at least one of the child - // nodes is visible or auto button hiding is disabled. - if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in Node.States) and - not ((vsAllChildrenHidden in Node.States) and - (toAutoHideButtons in TreeOptions.FAutoOptions)) and - ((toShowRoot in TreeOptions.PaintOptions) or (GetNodeLevel(Node) > 0)) - then - PaintNodeButton(Canvas, Node, Column, CellRect, Offsets[ofsToggleButton], ButtonY, BidiMode); // Relative X position of toggle button is needed for proper BiDi calculation - - if ImageInfo[iiCheck].Index > -1 then - PaintCheckImage(Canvas, PaintInfo.ImageInfo[iiCheck], vsSelected in PaintInfo.Node.States); - end; - - if ImageInfo[iiState].Index > -1 then - PaintImage(PaintInfo, iiState, False); - if ImageInfo[iiNormal].Index > -1 then - PaintImage(PaintInfo, iiNormal, True); - - // Now let descendants or applications draw whatever they want, - // but don't draw the node if it is currently being edited. - if not ((tsEditing in FStates) and (Node = FFocusedNode) and - ((Column = FEditColumn) or not UseColumns)) then - DoPaintNode(PaintInfo); - - DoAfterCellPaint(Canvas, Node, Column, CellRect); - end; - end; - - // leave after first run if columns aren't used - if not UseColumns then - Break; - end - else - NextColumn := GetNextVisibleColumn(PaintInfo.Column); - - SelectClipRgn(PaintInfo.Canvas.Handle, 0); - // Stop column loop if there are no further columns in the given window. - if (PaintInfo.CellRect.Left >= Window.Right) or (NextColumn = InvalidColumn) then - Break; - - // Move on to next column which might not be the one immediately following the current one - // because of auto span feature. - PaintInfo.Position := Items[NextColumn].Position; - - // Move clip rectangle and continue. - if coVisible in Items[NextColumn].FOptions then - with PaintInfo do - begin - Items[NextColumn].GetAbsoluteBounds(CellRect.Left, CellRect.Right); - CellRect.Bottom := Node.NodeHeight; - ContentRect.Bottom := Node.NodeHeight; - end; - end; - end; - - // This node is finished, notify descendants/application. - with PaintInfo do - begin - DoAfterItemPaint(Canvas, Node, R); - - // Final touch for this node: mark it if it is the current drop target node. - if (Node = FDropTargetNode) and (toShowDropmark in FOptions.FPaintOptions) and - (poDrawDropMark in PaintOptions) then - DoPaintDropMark(Canvas, Node, R); - end; - end; // if not DoBeforeItemPaint() (no custom drawing) - - - with PaintInfo.Canvas do - begin - if DrawSelectionRect then - begin - PaintSelectionRectangle(PaintInfo.Canvas, Window.Left, SelectionRect, Rect(0, 0, PaintWidth, - CurrentNodeHeight)); - end; - - // Put the constructed node image onto the target canvas. - if not (poUnbuffered in PaintOptions) then - with TWithSafeRect(TargetRect), NodeBitmap do - BitBlt(TargetCanvas.Handle, Left, Top, Width, Height, Canvas.Handle, Window.Left, 0, SRCCOPY); - end; - end; - - Inc(TargetRect.Top, PaintInfo.Node.NodeHeight); - if TargetRect.Top >= MaximumBottom then - Break; - - // Keep selection rectangle coordinates in sync. - if DrawSelectionRect then - OffsetRect(SelectionRect, 0, -PaintInfo.Node.NodeHeight); - - // Advance to next visible node. - PaintInfo.Node := GetNextVisible(PaintInfo.Node, True); - end; - end; - - // Erase rest of window not covered by a node. - if TargetRect.Top < MaximumBottom then - begin - // Keep the horizontal target position to determine the selection rectangle offset later (if necessary). - BaseOffset := Target.X; - Target := TargetRect.TopLeft; - R := Rect(TargetRect.Left, 0, TargetRect.Left, MaximumBottom - Target.Y); - TargetRect := Rect(0, 0, MaximumRight - Target.X, MaximumBottom - Target.Y); - - if not (poUnbuffered in PaintOptions) then - begin - // Avoid unnecessary copying of bitmap content. This will destroy the DC handle too. - NodeBitmap.Height := 0; - NodeBitmap.PixelFormat := pf32Bit; - NodeBitmap.SetSize(TargetRect.Right - TargetRect.Left, TargetRect.Bottom - TargetRect.Top); - end; - - // Call back application/descendants whether they want to erase this area. - if not DoPaintBackground(PaintInfo.Canvas, TargetRect) then - begin - if UseBackground then - begin - SetCanvasOrigin(PaintInfo.Canvas, 0, 0); - if toStaticBackground in TreeOptions.PaintOptions then - StaticBackground(FBackground, PaintInfo.Canvas, Target, TargetRect, FColors.BackGroundColor) - else - TileBackground(FBackground, PaintInfo.Canvas, Target, TargetRect, FColors.BackGroundColor); - end - else - begin - // Consider here also colors of the columns. - SetCanvasOrigin(PaintInfo.Canvas, Target.X, 0); // This line caused issue #313 when it was placed above the if-statement - if UseColumns then - begin - with FHeader.FColumns do - begin - // If there is no content in the tree then the first column has not yet been determined. - if FirstColumn = InvalidColumn then - begin - FirstColumn := GetFirstVisibleColumn; - repeat - if FirstColumn <> InvalidColumn then - begin - R.Left := Items[FirstColumn].Left; - R.Right := R.Left + Items[FirstColumn].FWidth; - if R.Right > TargetRect.Left then - Break; - FirstColumn := GetNextVisibleColumn(FirstColumn); - end; - until FirstColumn = InvalidColumn; - end - else - begin - R.Left := Items[FirstColumn].Left; - R.Right := R.Left + Items[FirstColumn].FWidth; - end; - - // Initialize MaxRight. - MaxRight := Target.X - 1; - - PaintInfo.Canvas.Font.Color := FColors.GridLineColor; - while (FirstColumn <> InvalidColumn) and (MaxRight < TargetRect.Right + Target.X) do - begin - // Determine left and right coordinate of the current column - ColLeft := Items[FirstColumn].Left; - ColRight := (ColLeft + Items[FirstColumn].FWidth); - - // Check wether this column needs to be painted at all. - if (ColRight >= MaxRight) then - begin - R.Left := MaxRight; // Continue where we left off - R.Right := ColRight; // Paint to the right of the column - MaxRight := ColRight; // And record were to start the next column. - - if (poGridLines in PaintOptions) and - (toFullVertGridLines in FOptions.FPaintOptions) and - (toShowVertGridLines in FOptions.FPaintOptions) and - (not (hoAutoResize in FHeader.FOptions) or (Cardinal(FirstColumn) < TColumnPosition(Count - 1))) then - begin - DrawDottedVLine(PaintInfo, R.Top, R.Bottom, R.Right - 1); - Dec(R.Right); - end; - - if not (coParentColor in Items[FirstColumn].FOptions) then - PaintInfo.Canvas.Brush.Color := Items[FirstColumn].FColor - else - PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; - PaintInfo.Canvas.FillRect(R); - end; - FirstColumn := GetNextVisibleColumn(FirstColumn); - end; - - // Erase also the part of the tree not covert by a column. - if R.Right < TargetRect.Right + Target.X then - begin - R.Left := R.Right; - R.Right := TargetRect.Right + Target.X; - // Prevent erasing the last vertical grid line. - if (poGridLines in PaintOptions) and - (toFullVertGridLines in FOptions.FPaintOptions) and (toShowVertGridLines in FOptions.FPaintOptions) and - (not (hoAutoResize in FHeader.FOptions)) then - Inc(R.Left); - PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; - PaintInfo.Canvas.FillRect(R); - end; - end; - SetCanvasOrigin(PaintInfo.Canvas, 0, 0); - end - else - begin - // No columns nor bitmap background. Simply erase it with the tree color. - SetCanvasOrigin(PaintInfo.Canvas, 0, 0); - PaintInfo.Canvas.Brush.Color := FColors.BackGroundColor; - PaintInfo.Canvas.FillRect(TargetRect); - end; - end; - end; - SetCanvasOrigin(PaintInfo.Canvas, 0, 0); - - if DrawSelectionRect then - begin - R := OrderRect(FNewSelRect); - // Remap the selection rectangle to the current window of the tree. - // Since Target has been used for other tasks BaseOffset got the left extent of the target position here. - OffsetRect(R, -Target.X + BaseOffset - Window.Left, -Target.Y + FOffsetY); - SetBrushOrigin(PaintInfo.Canvas, 0, Target.X and 1); - PaintSelectionRectangle(PaintInfo.Canvas, 0, R, TargetRect); - end; - - if not (poUnBuffered in PaintOptions) then - with Target, NodeBitmap do - BitBlt(TargetCanvas.Handle, X, Y, Width, Height, Canvas.Handle, 0, 0, SRCCOPY); - end; - finally - PaintInfo.Canvas.Unlock; - if poUnbuffered in PaintOptions then - RestoreDC(TargetCanvas.Handle, SavedTargetDC) - else - NodeBitmap.Free; - end;//try..finally - - if (ChildCount[nil] = 0) and (FEmptyListMessage <> '') then - begin - // output a message if no items are to display - Canvas.Font := Self.Font; - SetBkMode(TargetCanvas.Handle, TRANSPARENT); - R.Left := OffSetX + 2; - R.Top := 2; - R.Right := R.Left + Width - 2; - R.Bottom := Height -2; - TargetCanvas.Font.Color := clGrayText; - TargetCanvas.TextRect(R, FEmptyListMessage, [tfNoClip, tfLeft, tfWordBreak]); - end; - - DoAfterPaint(TargetCanvas); - finally - DoStateChange([], [tsPainting]); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.PasteFromClipboard: Boolean; - -// Reads what is currently on the clipboard into the tree (if the format is supported). -// Note: If the application wants to have text or special formats to be inserted then it must implement -// its own code (OLE). Here only the native tree format is accepted. - -var - Data: IDataObject; - Source: TBaseVirtualTree; - -begin - Result := False; - if not (toReadOnly in FOptions.FMiscOptions) then - begin - if OleGetClipboard(Data) <> S_OK then - ShowError(SClipboardFailed, hcTFClipboardFailed) - else - begin - // Try to get the source tree of the operation to optimize the operation. - Source := GetTreeFromDataObject(Data); - Result := ProcessOLEData(Source, Data, FFocusedNode, FDefaultPasteMode, Assigned(Source) and - (tsCutPending in Source.FStates)); - if Assigned(Source) then - begin - if Source <> Self then - Source.FinishCutOrCopy - else - DoStateChange([], [tsCutPending]); - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.PrepareDragImage(HotSpot: TPoint; const DataObject: IDataObject); - -// Initiates an image drag operation. HotSpot is the position of the mouse in client coordinates. - -var - PaintOptions: TVTInternalPaintOptions; - TreeRect, - PaintRect: TRect; - LocalSpot, - ImagePos, - PaintTarget: TPoint; - Image: TBitmap; - -begin - if CanShowDragImage then - begin - // Determine the drag rectangle which is a square around the hot spot. Operate in virtual tree space. - LocalSpot := HotSpot; - Dec(LocalSpot.X, -FEffectiveOffsetX); - Dec(LocalSpot.Y, FOffsetY); - TreeRect := Rect(LocalSpot.X - FDragWidth div 2, LocalSpot.Y - FDragHeight div 2, LocalSpot.X + FDragWidth div 2, - LocalSpot.Y + FDragHeight div 2); - - // Check that we have a valid rectangle. - PaintRect := TreeRect; - with TWithSafeRect(TreeRect) do - begin - if Left < 0 then - begin - PaintTarget.X := -Left; - PaintRect.Left := 0; - end - else - PaintTarget.X := 0; - if Top < 0 then - begin - PaintTarget.Y := -Top; - PaintRect.Top := 0; - end - else - PaintTarget.Y := 0; - end; - - Image := TBitmap.Create; - with Image do - try - PixelFormat := pf32Bit; - SetSize(TreeRect.Right - TreeRect.Left, TreeRect.Bottom - TreeRect.Top); - // Erase the entire image with the color key value, for the case not everything - // in the image is covered by the tree image. - Canvas.Brush.Color := FColors.BackGroundColor; - Canvas.FillRect(Rect(0, 0, Width, Height)); - - PaintOptions := [poDrawSelection, poSelectedOnly]; - if FDragImageKind = diMainColumnOnly then - Include(PaintOptions, poMainOnly); - PaintTree(Image.Canvas, PaintRect, PaintTarget, PaintOptions); - - // 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); - - FDragImage.ColorKey := FColors.BackGroundColor; - FDragImage.PrepareDrag(Image, ImagePos, HotSpot, DataObject); - finally - Image.Free; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.Print(Printer: TPrinter; PrintHeader: Boolean); - -var - SaveTreeFont: TFont; // Remembers the tree's current font. - SaveHeaderFont: TFont; // Remembers the header's current font. - ImgRect, // Describes the dimensions of Image. - TreeRect, // The total VTree dimensions. - DestRect, // Dimensions of PrinterImage. - SrcRect: TRect; // Clip dimensions from Image -> PrinterImage - P: TPoint; // Used by PaintTree. - Options: TVTInternalPaintOptions; // Used by PaintTree. - Image, // Complete Tree is drawn to this image. - PrinterImage: TBitmap; // This is the image that gets printed. - SaveColor: TColor; // Remembers the VTree Color. - pTxtHeight, // Height of font in the TPrinter.Canvas - vTxtHeight, // Height of font in the VTree Canvas - vPageWidth, - vPageHeight, // Printer height in VTree resolution - xPageNum, yPageNum, // # of pages (except the occasional last one) - xPage, yPage: Integer; // Loop counter - Scale: Extended; // Scale factor between Printer Canvas and VTree Canvas - LogFont: TLogFont; - -begin - if Assigned(Printer) then - begin - BeginUpdate; - - // Grid lines are the only parts which are desirable when printing. - Options := [poGridLines]; - - // Remember the tree font. - SaveTreeFont := TFont.Create; - SaveTreeFont.Assign(Font); - // Create a new font for printing which does not use clear type output (but is antialiased, if possible) - // and which has the highest possible quality. - GetObject(Font.Handle, SizeOf(TLogFont), @LogFont); - LogFont.lfQuality := ANTIALIASED_QUALITY; - Font.Handle := CreateFontIndirect(LogFont); - - // Create an image that will hold the complete VTree - Image := TBitmap.Create; - Image.PixelFormat := pf32Bit; - PrinterImage := nil; - try - TreeRect := GetTreeRect; - - Image.Width := TreeRect.Right - TreeRect.Left; - P := Point(0, 0); - if (hoVisible in FHeader.Options) and PrintHeader then - begin - Inc(TreeRect.Bottom, FHeader.Height); - Inc(P.Y, FHeader.Height); - end; - Image.Height := TreeRect.Bottom - TreeRect.Top; - - ImgRect.Left := 0; - ImgRect.Top := 0; - ImgRect.Right := Image.Width; - - // Force the background to white color during the rendering. - SaveColor := FColors.BackGroundColor; - Color := clWhite; - // Print header if it is visible. - if (hoVisible in FHeader.Options) and PrintHeader then - begin - SaveHeaderFont := TFont.Create; - try - SaveHeaderFont.Assign(FHeader.Font); - // Create a new font for printing which does not use clear type output (but is antialiased, if possible) - // and which has the highest possible quality. - GetObject(FHeader.Font.Handle, SizeOf(TLogFont), @LogFont); - LogFont.lfQuality := ANTIALIASED_QUALITY; - FHeader.Font.Handle := CreateFontIndirect(LogFont); - ImgRect.Bottom := FHeader.Height; - FHeader.FColumns.PaintHeader(Image.Canvas.Handle, ImgRect, 0); - FHeader.Font := SaveHeaderFont; - finally - SaveHeaderFont.Free; - end; - end; - // The image's height is already adjusted for the header if it is visible. - ImgRect.Bottom := Image.Height; - - PaintTree(Image.Canvas, ImgRect, P, Options, pf32Bit); - Color := SaveColor; - - // Activate the printer - Printer.BeginDoc; - Printer.Canvas.Font := Font; - - // Now we can calculate the scaling : - pTxtHeight := Printer.Canvas.TextHeight('Tj'); - vTxtHeight := Canvas.TextHeight('Tj'); - - Scale := pTxtHeight / vTxtHeight; - - // Create an Image that has the same dimensions as the printer canvas but - // scaled to the VTree resolution: - PrinterImage := TBitmap.Create; - - vPageHeight := Round(Printer.PageHeight / Scale); - vPageWidth := Round(Printer.PageWidth / Scale); - - // We do a minumum of one page. - xPageNum := Trunc(Image.Width / vPageWidth); - yPageNum := Trunc(Image.Height / vPageHeight); - - PrinterImage.SetSize(vPageWidth, vPageHeight); - - // Split vertically: - for yPage := 0 to yPageNum do - begin - DestRect.Left := 0; - DestRect.Top := 0; - DestRect.Right := PrinterImage.Width; - DestRect.Bottom := PrinterImage.Height; - - // Split horizontally: - for xPage := 0 to xPageNum do - begin - SrcRect.Left := vPageWidth * xPage; - SrcRect.Top := vPageHeight * yPage; - SrcRect.Right := vPageWidth * xPage + PrinterImage.Width; - SrcRect.Bottom := SrcRect.Top + vPageHeight; - - // Clear the image - PrinterImage.Canvas.Brush.Color := clWhite; - PrinterImage.Canvas.FillRect(Rect(0, 0, PrinterImage.Width, PrinterImage.Height)); - PrinterImage.Canvas.CopyRect(DestRect, Image.Canvas, SrcRect); - PrtStretchDrawDIB(Printer.Canvas, Rect(0, 0, Printer.PageWidth, Printer.PageHeight - 1), PrinterImage); - if xPage <> xPageNum then - Printer.NewPage; - end; - if yPage <> yPageNum then - Printer.NewPage; - end; - - // Restore tree font. - Font := SaveTreeFont; - SaveTreeFont.Free; - Printer.EndDoc; - finally - PrinterImage.Free; - Image.Free; - EndUpdate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ProcessDrop(const DataObject: IDataObject; TargetNode: PVirtualNode; var Effect: Integer; - Mode: TVTNodeAttachMode): Boolean; - -// Recreates the (sub) tree structure serialized into memory and provided by DataObject. The new nodes are attached to -// the passed node or FRoot if TargetNode is nil. -// Returns True on success, i.e. the CF_VIRTUALTREE format is supported by the data object and the structure could be -// recreated, otherwise False. - -var - Source: TBaseVirtualTree; - -begin - Result := False; - if Mode = amNoWhere then - Effect := DROPEFFECT_NONE - else - begin - BeginUpdate; - // try to get the source tree of the operation - Source := GetTreeFromDataObject(DataObject); - if Assigned(Source) then - Source.BeginUpdate; - try - try - // Before adding the new nodes try to optimize the operation if source and target tree reside in - // the same application and operation is a move. - if ((Effect and DROPEFFECT_MOVE) <> 0) and Assigned(Source) then - begin - // If both copy and move are specified then prefer a copy because this is not destructing. - Result := ProcessOLEData(Source, DataObject, TargetNode, Mode, (Effect and DROPEFFECT_COPY) = 0); - // Since we made an optimized move or a copy there's no reason to act further after DoDragging returns. - Effect := DROPEFFECT_NONE; - end - else - // Act only if move or copy operation is requested. - if (Effect and (DROPEFFECT_MOVE or DROPEFFECT_COPY)) <> 0 then - Result := ProcessOLEData(Source, DataObject, TargetNode, Mode, False) - else - Result := False; - except - Effect := DROPEFFECT_NONE; - end; - finally - if Assigned(Source) then - Source.EndUpdate; - EndUpdate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -type - // needed to handle OLE global memory objects - TOLEMemoryStream = class(TCustomMemoryStream) - public - function Write(const Buffer; Count: Integer): Integer; override; - end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TOLEMemoryStream.Write(const Buffer; Count: Integer): Integer; - -begin - raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError)); -end; - -//----------------- TBaseVirtualTree ----------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoDrawHint(Canvas: TCanvas; Node: PVirtualNode; R: - TRect; Column: TColumnIndex); - -begin - if Assigned(FOnDrawHint) then - FOnDrawHint(Self, Canvas, Node, R, Column); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoGetHintSize(Node: PVirtualNode; Column: - TColumnIndex; var R: TRect); - -begin - if Assigned(FOnGetHintSize) then - FOnGetHintSize(Self, Node, Column, R); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoGetHintKind(Node: PVirtualNode; Column: - TColumnIndex; var Kind: TVTHintKind); - -begin - if Assigned(FOnGetHintKind) then - FOnGetHintKind(Self, Node, Column, Kind) - else - Kind := DefaultHintKind; -end; - -function TBaseVirtualTree.GetDefaultHintKind: TVTHintKind; - -begin - Result := vhkText; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ProcessOLEData(Source: TBaseVirtualTree; const DataObject: IDataObject; TargetNode: PVirtualNode; - Mode: TVTNodeAttachMode; Optimized: Boolean): Boolean; - -// Recreates the (sub) tree structure serialized into memory and provided by DataObject. The new nodes are attached to -// the passed node or FRoot if TargetNode is nil according to Mode. Optimized can be set to True if the entire operation -// happens within the same process (i.e. sender and receiver of the OLE operation are located in the same process). -// Optimize = True makes only sense if the operation to carry out is a move hence it is also the indication of the -// operation to be done here. Source is the source of the OLE data and only of use (and usually assigned) when -// an OLE operation takes place in the same application. -// Returns True on success, i.e. the CF_VIRTUALTREE format is supported by the data object and the structure could be -// recreated, otherwise False. - -var - Medium: TStgMedium; - Stream: TStream; - Data: Pointer; - Node: PVirtualNode; - Nodes: TNodeArray; - I: Integer; - Res: HRESULT; - ChangeReason: TChangeReason; - -begin - Nodes := nil; - // Check the data format available by the data object. - with StandardOLEFormat do - begin - // Read best format. - cfFormat := CF_VIRTUALTREE; - end; - Result := DataObject.QueryGetData(StandardOLEFormat) = S_OK; - if Result and not (toReadOnly in FOptions.FMiscOptions) then - begin - BeginUpdate; - Result := False; - try - if TargetNode = nil then - TargetNode := FRoot; - if TargetNode = FRoot then - begin - case Mode of - amInsertBefore: - Mode := amAddChildFirst; - amInsertAfter: - Mode := amAddChildLast; - end; - end; - - // Optimized means source is known and in the same process so we can access its pointers, which avoids duplicating - // the data while doing a serialization. Can only be used with cut'n paste and drag'n drop with move effect. - if Optimized then - begin - if tsOLEDragging in Source.FStates then - Nodes := Source.FDragSelection - else - Nodes := Source.GetSortedCutCopySet(True); - - if Mode in [amInsertBefore,amAddChildLast] then - begin - for I := 0 to High(Nodes) do - if not HasAsParent(TargetNode, Nodes[I]) then - Source.MoveTo(Nodes[I], TargetNode, Mode, False); - end - else - begin - for I := High(Nodes) downto 0 do - if not HasAsParent(TargetNode, Nodes[I]) then - Source.MoveTo(Nodes[I], TargetNode, Mode, False); - end; - Result := True; - end - else - begin - if Source = Self then - ChangeReason := crNodeCopied - else - ChangeReason := crNodeAdded; - Res := DataObject.GetData(StandardOLEFormat, Medium); - if Res = S_OK then - begin - case Medium.tymed of - TYMED_ISTREAM, // IStream interface - TYMED_HGLOBAL: // global memory block - begin - Stream := nil; - if Medium.tymed = TYMED_ISTREAM then - Stream := TOLEStream.Create(IUnknown(Medium.stm) as IStream) - else - begin - Data := GlobalLock(Medium.hGlobal); - if Assigned(Data) then - begin - // Get the total size of data to retrieve. - I := PCardinal(Data)^; - Inc(PCardinal(Data)); - Stream := TOLEMemoryStream.Create; - TOLEMemoryStream(Stream).SetPointer(Data, I); - end; - end; - - if Assigned(Stream) then - try - while Stream.Position < Stream.Size do - begin - Node := MakeNewNode; - InternalConnectNode(Node, TargetNode, Self, Mode); - InternalAddFromStream(Stream, VTTreeStreamVersion, Node); - // This seems a bit strange because of the callback for granting to add the node - // which actually comes after the node has been added. The reason is that the node must - // contain valid data otherwise I don't see how the application can make a funded decision. - if not DoNodeCopying(Node, TargetNode) then - begin - DeleteNode(Node); - end - else - begin - DoNodeCopied(Node); - StructureChange(Node, ChangeReason); - // In order to maintain the same node order when restoring nodes in the case of amInsertAfter - // we have to move the reference node continously. Othwise we would end up with reversed node order. - if Mode = amInsertAfter then - TargetNode := Node; - end; - end; - Result := True; - finally - Stream.Free; - if Medium.tymed = TYMED_HGLOBAL then - GlobalUnlock(Medium.hGlobal); - end; - end; - end; - ReleaseStgMedium(Medium); - end; - end; - finally - EndUpdate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ReinitChildren(Node: PVirtualNode; Recursive: Boolean); - -// Forces all child nodes of Node to be reinitialized. -// If Recursive is True then also the grandchildren are reinitialized. - -var - Run: PVirtualNode; - -begin - if Assigned(Node) then - begin - InitChildren(Node); - Run := Node.FirstChild; - end - else - begin - InitChildren(FRoot); - Run := FRoot.FirstChild; - end; - - while Assigned(Run) do - begin - ReinitNode(Run, Recursive); - Run := Run.NextSibling; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ReinitNode(Node: PVirtualNode; Recursive: Boolean); - -// Forces the given node and all its children (if recursive is True) to be initialized again without -// modifying any data in the nodes nor deleting children (unless the application requests a different amount). - -begin - if Assigned(Node) and (Node <> FRoot) then - begin - // Remove dynamic styles. - Node.States := Node.States - [vsChecking, vsCutOrCopy, vsDeleting, vsHeightMeasured]; - if vsInitialized in Node.States then - InitNode(Node); - end; - - if Recursive then - ReinitChildren(Node, True); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.RepaintNode(Node: PVirtualNode); - -// Causes an immediate repaint of the given node. - -var - R: Trect; - -begin - if Assigned(Node) and (Node <> FRoot) then - begin - R := GetDisplayRect(Node, NoColumn, False); - RedrawWindow(Handle, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE or RDW_VALIDATE or RDW_NOCHILDREN); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ResetNode(Node: PVirtualNode); - -// Deletes all children of the given node and marks it as being uninitialized. - -begin - DoCancelEdit; - if (Node = nil) or (Node = FRoot) then - Clear - else - begin - DoReset(Node); - DeleteChildren(Node); - // Remove initialized and other dynamic styles, keep persistent styles. - Node.States := Node.States - [vsInitialized, vsChecking, vsCutOrCopy, vsDeleting, vsHasChildren, vsExpanded, - vsHeightMeasured]; - InvalidateNode(Node); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SaveToFile(const FileName: TFileName); - -// Saves the entire content of the tree into a file (see further notes in SaveToStream). - -var - FileStream: TFileStream; - -begin - FileStream := TFileStream.Create(FileName, fmCreate); - try - SaveToStream(FileStream); - finally - FileStream.Free; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SaveToStream(Stream: TStream; Node: PVirtualNode = nil); - -// Saves Node and all its children to Stream. If Node is nil then all top level nodes will be stored. -// Note: You should be careful about assuming what is actually saved. The problem here is that we are dealing with -// virtual data. The tree can so not know what it has to save. The only fact we reliably know is the tree's -// structure. To be flexible for future enhancements as well as unknown content (unknown to the tree class which -// is saving/loading the stream) a chunk based approach is used here. Every tree class handles only those -// chunks which are not handled by an anchestor class and are known by the class. -// -// The base tree class saves only the structure of the tree along with application provided data. descendants may -// optionally add their own chunks to store additional information. See: WriteChunks. - -var - Count: Cardinal; - -begin - Stream.Write(MagicID, SizeOf(MagicID)); - if Node = nil then - begin - // Keep number of top level nodes for easy restauration. - Count := FRoot.ChildCount; - Stream.WriteBuffer(Count, SizeOf(Count)); - - // Save entire tree here. - Node := FRoot.FirstChild; - while Assigned(Node) do - begin - WriteNode(Stream, Node); - Node := Node.NextSibling; - end; - end - else - begin - Count := 1; - Stream.WriteBuffer(Count, SizeOf(Count)); - WriteNode(Stream, Node); - end; - if Assigned(FOnSaveTree) then - FOnSaveTree(Self, Stream); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ScrollIntoView(Node: PVirtualNode; Center: Boolean; Horizontally: Boolean = False): Boolean; - -// Scrolls the tree so that the given node is in the client area and returns True if the tree really has been -// scrolled (e.g. to avoid further updates) else returns False. If extened focus is enabled then the tree will also -// be horizontally scrolled if needed. -// Note: All collapsed parents of the node are expanded. - -var - R: TRect; - Run: PVirtualNode; - UseColumns, - HScrollBarVisible: Boolean; - ScrolledVertically, - ScrolledHorizontally: Boolean; - -begin - ScrolledVertically := False; - ScrolledHorizontally := False; - - if Assigned(Node) and (Node <> FRoot) and HandleAllocated then // We don't want to create the handle if it has not yet been created, see issue #897 - begin - // Make sure all parents of the node are expanded. - Run := Node.Parent; - while Run <> FRoot do - begin - if not (vsExpanded in Run.States) then - ToggleNode(Run); - Run := Run.Parent; - end; - UseColumns := FHeader.UseColumns; - if UseColumns and FHeader.FColumns.IsValidColumn(FFocusedColumn) then - R := GetDisplayRect(Node, FFocusedColumn, not (toGridExtensions in FOptions.FMiscOptions)) - else - R := GetDisplayRect(Node, NoColumn, not (toGridExtensions in FOptions.FMiscOptions)); - - // The returned rectangle can never be empty after the expand code above. - // 1) scroll vertically - if R.Top < 0 then - begin - if Center then - SetOffsetY(FOffsetY - R.Top + ClientHeight div 2) - else - SetOffsetY(FOffsetY - R.Top); - ScrolledVertically := True; - end - else - if (R.Bottom > ClientHeight) or Center then - begin - HScrollBarVisible := (ScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssBoth, System.UITypes.TScrollStyle.ssHorizontal]) and - (ScrollBarOptions.AlwaysVisible or (Integer(FRangeX) > ClientWidth)); - if Center then - SetOffsetY(FOffsetY - R.Bottom + ClientHeight div 2) - else - SetOffsetY(FOffsetY - R.Bottom + ClientHeight); - // When scrolling up and the horizontal scroll appears because of the operation - // then we have to move up the node the horizontal scrollbar's height too - // in order to avoid that the scroll bar hides the node which we wanted to have in view. - if not UseColumns and not HScrollBarVisible and (Integer(FRangeX) > ClientWidth) then - SetOffsetY(FOffsetY - GetSystemMetrics(SM_CYHSCROLL)); - ScrolledVertically := True; - end; - - if Horizontally then - // 2) scroll horizontally - // Center only if there is enough space for the focused column, otherwise left align, see issue #397. - ScrolledHorizontally := ScrollIntoView(FFocusedColumn, Center and (R.Width <= (ClientWidth - Header.Columns.GetVisibleFixedWidth)), Node); - end; - - Result := ScrolledVertically or ScrolledHorizontally; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.ScaledPixels(pPixels: Integer): Integer; - - /// Returns the given pixels scaled to the current dpi assuming that we designed at 96dpi (100%) -begin - Result := MulDiv(pPixels, {$if CompilerVersion > 31}Self.FCurrentPPI{$else}Screen.PixelsPerInch{$ifend}, 96); -end; - -function TBaseVirtualTree.ScrollIntoView(Column: TColumnIndex; Center: Boolean; Node: PVirtualNode = nil): Boolean; - -// Scrolls the columns so that the given column is in the client area and returns True if the columns really have been -// scrolled (e.g. to avoid further updates) else returns False. - -var - ColumnLeft, - ColumnRight: Integer; - NewOffset: Integer; - R: TRect; - -begin - Result := False; - - if FHeader.UseColumns and FHeader.Columns.IsValidColumn(Column) then begin - ColumnLeft := Header.Columns.Items[Column].Left; - ColumnRight := ColumnLeft + Header.Columns.Items[Column].Width; - end else if Assigned(Node) and (toCenterScrollIntoView in FOptions.SelectionOptions) then begin - Center := False; - R := GetDisplayRect(Node, NoColumn, not (toGridExtensions in FOptions.FMiscOptions)); - ColumnLeft := R.Left; - ColumnRight := R.Right; - end else - Exit; - - NewOffset := FEffectiveOffsetX; - if not (FHeader.UseColumns and (coFixed in Header.Columns[Column].Options)) and (not Center) then - begin - if ColumnRight > ClientWidth then - NewOffset := FEffectiveOffsetX + Min(ColumnRight - ClientWidth, - - (Header.Columns.GetVisibleFixedWidth - ColumnLeft)) - else if ColumnLeft < Header.Columns.GetVisibleFixedWidth then - NewOffset := FEffectiveOffsetX - (Header.Columns.GetVisibleFixedWidth - ColumnLeft); - if NewOffset <> FEffectiveOffsetX then - begin - if UseRightToLeftAlignment then - SetOffsetX(-Integer(FRangeX) + ClientWidth + NewOffset) - else - SetOffsetX(-NewOffset); - end; - Result := True; - end - else if Center then - begin - NewOffset := FEffectiveOffsetX + ColumnLeft - (Header.Columns.GetVisibleFixedWidth div 2) - (ClientWidth div 2) + ((ColumnRight - ColumnLeft) div 2); - if NewOffset <> FEffectiveOffsetX then - begin - if UseRightToLeftAlignment then - SetOffsetX(-Integer(FRangeX) + ClientWidth + NewOffset) - else - SetOffsetX(-NewOffset); - end; - Result := True; - end -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SelectAll(VisibleOnly: Boolean); - -// Select all nodes in the tree. -// If VisibleOnly is True then only visible nodes are selected. - -var - Run: PVirtualNode; - NextFunction: TGetNextNodeProc; -begin - if not FSelectionLocked and (toMultiSelect in FOptions.FSelectionOptions) then - begin - ClearTempCache; - if VisibleOnly then - begin - Run := GetFirstVisible(nil, True); - NextFunction := GetNextVisible; - end - else - begin - Run := GetFirst; - NextFunction := GetNext; - end; - BeginUpdate(); // Improve performance, see issue #690 - try - while Assigned(Run) do - begin - if not(vsSelected in Run.States) then - InternalCacheNode(Run); - Run := NextFunction(Run); - end;//while - if FTempNodeCount > 0 then - AddToSelection(FTempNodeCache, FTempNodeCount); - ClearTempCache; - finally - EndUpdate(); - end;//try..finally - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); - -// Sorts the given node. The application is queried about how to sort via the OnCompareNodes event. -// Column is simply passed to the the compare function so the application can also sort in a particular column. -// In order to free the application from taking care about the sort direction the parameter Direction is used. -// This way the application can always sort in increasing order, while this method reorders nodes according to this flag. - - //--------------- local functions ------------------------------------------- - - function MergeAscending(A, B: PVirtualNode): PVirtualNode; - - // Merges A and B (which both must be sorted via Compare) into one list. - - var - Dummy: TVirtualNode; - CompareResult: Integer; - begin - // This avoids checking for Result = nil in the loops. - Result := @Dummy; - while Assigned(A) and Assigned(B) do - begin - if OperationCanceled then - CompareResult := 0 - else - CompareResult := DoCompare(A, B, Column); - - if CompareResult <= 0 then - begin - Result.NextSibling := A; - Result := A; - A := A.NextSibling; - end - else - begin - Result.NextSibling := B; - Result := B; - B := B.NextSibling; - end; - end; - - // Just append the list which is not nil (or set end of result list to nil if both lists are nil). - if Assigned(A) then - Result.NextSibling := A - else - Result.NextSibling := B; - // return start of the new merged list - Result := Dummy.NextSibling; - end; - - //--------------------------------------------------------------------------- - - function MergeDescending(A, B: PVirtualNode): PVirtualNode; - - // Merges A and B (which both must be sorted via Compare) into one list. - - var - Dummy: TVirtualNode; - CompareResult: Integer; - - begin - // this avoids checking for Result = nil in the loops - Result := @Dummy; - while Assigned(A) and Assigned(B) do - begin - if OperationCanceled then - CompareResult := 0 - else - CompareResult := DoCompare(A, B, Column); - - if CompareResult >= 0 then - begin - Result.NextSibling := A; - Result := A; - A := A.NextSibling; - end - else - begin - Result.NextSibling := B; - Result := B; - B := B.NextSibling; - end; - end; - - // Just append the list which is not nil (or set end of result list to nil if both lists are nil). - if Assigned(A) then - Result.NextSibling := A - else - Result.NextSibling := B; - // Return start of the newly merged list. - Result := Dummy.NextSibling; - end; - - //--------------------------------------------------------------------------- - - function MergeSortAscending(var Node: PVirtualNode; N: Cardinal): PVirtualNode; - - // Sorts the list of nodes given by Node (which must not be nil). - - var - A, B: PVirtualNode; - - begin - if N > 1 then - begin - A := MergeSortAscending(Node, N div 2); - B := MergeSortAscending(Node, (N + 1) div 2); - Result := MergeAscending(A, B); - end - else - begin - Result := Node; - Node := Node.NextSibling; - Result.NextSibling := nil; - end; - end; - - //--------------------------------------------------------------------------- - - function MergeSortDescending(var Node: PVirtualNode; N: Cardinal): PVirtualNode; - - // Sorts the list of nodes given by Node (which must not be nil). - - var - A, B: PVirtualNode; - - begin - if N > 1 then - begin - A := MergeSortDescending(Node, N div 2); - B := MergeSortDescending(Node, (N + 1) div 2); - Result := MergeDescending(A, B); - end - else - begin - Result := Node; - Node := Node.NextSibling; - Result.NextSibling := nil; - end; - end; - - //--------------- end local functions --------------------------------------- - -var - Run: PVirtualNode; - Index: Cardinal; - -begin - InterruptValidation; - if tsEditPending in FStates then - begin - StopTimer(EditTimer); - DoStateChange([], [tsEditPending]); - end; - - if not (tsEditing in FStates) or DoEndEdit then - begin - if Node = nil then - Node := FRoot; - if vsHasChildren in Node.States then - begin - if (Node.ChildCount = 0) and DoInit then - InitChildren(Node); - // Make sure the children are valid, so they can be sorted at all. - if DoInit and (Node.ChildCount > 0) then - ValidateChildren(Node, False); - // Child count might have changed. - if Node.ChildCount > 1 then - begin - StartOperation(okSortNode); - try - // Sort the linked list, check direction flag only once. - if Direction = sdAscending then - Node.FirstChild := MergeSortAscending(Node.FirstChild, Node.ChildCount) - else - Node.FirstChild := MergeSortDescending(Node.FirstChild, Node.ChildCount); - finally - EndOperation(okSortNode); - end; - // Consolidate the child list finally. - Run := Node.FirstChild; - Run.PrevSibling := nil; - Index := 0; - repeat - Run.Index := Index; - Inc(Index); - if Run.NextSibling = nil then - Break; - Run.NextSibling.PrevSibling := Run; - Run := Run.NextSibling; - until False; - Node.LastChild := Run; - - InvalidateCache; - end; - if FUpdateCount = 0 then - begin - ValidateCache; - Invalidate; - end; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.SortTree(Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); - - //--------------- local function -------------------------------------------- - - procedure DoSort(Node: PVirtualNode); - - // Recursively sorts Node and its child nodes. - - var - Run: PVirtualNode; - - begin - Sort(Node, Column, Direction, DoInit); - // Recurse to next level - Run := Node.FirstChild; - while Assigned(Run) and not FOperationCanceled do - begin - if DoInit and not (vsInitialized in Run.States) then - InitNode(Run); - if (vsInitialized in Run.States) and (not (toAutoSort in TreeOptions.AutoOptions) or Expanded[Run]) then // There is no need to sort collapsed branches - DoSort(Run); - Run := Run.NextSibling; - end; - end; - - //--------------- end local function ---------------------------------------- - -begin - if RootNode.TotalCount <= 2 then - Exit;//Nothing to do if there are one or zero nodes. RootNode.TotalCount is 1 if there are no nodes in the treee as the root node counts too here. - // Instead of wrapping the sort using BeginUpdate/EndUpdate simply the update counter - // is modified. Otherwise the EndUpdate call will recurse here. - Inc(FUpdateCount); - try - if Column > InvalidColumn then - begin - StartOperation(okSortTree); - try - DoSort(FRoot); - finally - EndOperation(okSortTree); - end; - end; - InvalidateCache; - finally - if FUpdateCount > 0 then - Dec(FUpdateCount); - if FUpdateCount = 0 then - begin - ValidateCache; - Invalidate; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ToggleNode(Node: PVirtualNode); - -// Changes a node's expand state to the opposite state. - -var - Child, - FirstVisible: PVirtualNode; - HeightDelta, - StepsR1, - StepsR2, - Steps: Integer; - TogglingTree, - ChildrenInView, - NeedFullInvalidate, - NeedUpdate, - NodeInView, - PosHoldable, - TotalFit: Boolean; - ToggleData: TToggleAnimationData; - - //--------------- local function -------------------------------------------- - - procedure PrepareAnimation; - - // Prepares ToggleData. - - var - R: TRect; - S: Integer; - M: TToggleAnimationMode; - - begin - with ToggleData do - begin - Window := Handle; - DC := GetDC(Handle); - Self.Brush.Color := FColors.BackGroundColor; - Brush := Self.Brush.Handle; - - if (Mode1 <> tamNoScroll) and (Mode2 <> tamNoScroll) then - begin - if StepsR1 < StepsR2 then - begin - // As the primary rectangle is always R1 we will get a much smoother - // animation if R1 is the one that will be scrolled more. - R := R2; - R2 := R1; - R1 := R; - - M := Mode2; - Mode2 := Mode1; - Mode1 := M; - - S := StepsR2; - StepsR2 := StepsR1; - StepsR1 := S; - end; - ScaleFactor := StepsR2 / StepsR1; - MissedSteps := 0; - end; - - if Mode1 <> tamNoScroll then - Steps := StepsR1 - else - Steps := StepsR2; - end; - end; - - //--------------- end local function ---------------------------------------- - -begin - Assert(Assigned(Node), 'Node must not be nil.'); - - TogglingTree := tsToggling in FStates; - ChildrenInView := False; - HeightDelta := 0; - NeedFullInvalidate := False; - NeedUpdate := False; - NodeInView := False; - PosHoldable := False; - TotalFit := False; - - // We don't need to switch the expand state if the node is being deleted otherwise some - // updates (e.g. visible node count) are done twice with disasterous results). - if [vsDeleting, vsToggling] * Node.States = [] then - begin - try - DoStateChange([tsToggling]); - Include(Node.States, vsToggling); - - if vsExpanded in Node.States then - begin - if DoCollapsing(Node) then - begin - NeedUpdate := True; - - // Calculate the height delta right now as we need it for toChildrenAbove anyway. - HeightDelta := -Integer(Node.TotalHeight) + Integer(NodeHeight[Node]); - if (FUpdateCount = 0) and (toAnimatedToggle in FOptions.FAnimationOptions) and not - (tsCollapsing in FStates) then - begin - if tsHint in Self.FStates then - Application.CancelHint; - UpdateWindow(Handle); - - // animated collapsing - with ToggleData do - begin - // Determine the animation behaviour and rectangle. If toChildrenAbove is set, the behaviour is depending - // on the position of the node to be collapsed. - R1 := GetDisplayRect(Node, NoColumn, False); - Mode2 := tamNoScroll; - if toChildrenAbove in FOptions.FPaintOptions then - begin - PosHoldable := (FOffsetY + (Integer(Node.TotalHeight) - Integer(NodeHeight[Node]))) <= 0; - NodeInView := R1.Top < ClientHeight; - - StepsR1 := 0; - if NodeInView then - begin - if PosHoldable or not (toAdvancedAnimatedToggle in FOptions.FAnimationOptions) then - begin - // Scroll the child nodes down. - Mode1 := tamScrollDown; - R1.Bottom := R1.Top; - R1.Top := 0; - StepsR1 := Min(R1.Bottom - R1.Top + 1, Integer(Node.TotalHeight) - Integer(NodeHeight[Node])); - end - else - begin - // The position cannot be kept. So scroll the node up to its future position. - Mode1 := tamScrollUp; - R1.Top := Max(0, R1.Top + HeightDelta); - R1.Bottom := ClientHeight; - StepsR1 := FOffsetY - HeightDelta; - end; - end; - end - else - begin - if (Integer(FRangeY) + FOffsetY - R1.Bottom + HeightDelta >= ClientHeight - R1.Bottom) or - (Integer(FRangeY) <= ClientHeight) or (FOffsetY = 0) or not - (toAdvancedAnimatedToggle in FOptions.FAnimationOptions) then - begin - // Do a simple scroll up over the child nodes. - Mode1 := tamScrollUp; - Inc(R1.Top, NodeHeight[Node]); - R1.Bottom := ClientHeight; - StepsR1 := Min(R1.Bottom - R1.Top + 1, -HeightDelta); - end - else - begin - // Scroll the node down to its future position. As FOffsetY will change we need to invalidate the - // whole tree. - Mode1 := tamScrollDown; - StepsR1 := Min(-FOffsetY, ClientHeight - Integer(FRangeY) -FOffsetY - HeightDelta); - R1.Top := 0; - R1.Bottom := Min(ClientHeight, R1.Bottom + Steps); - NeedFullInvalidate := True; - end; - end; - - // No animation necessary if the node is below the current client height. - if R1.Top < ClientHeight then - begin - PrepareAnimation; - try - Animate(Steps, FAnimationDuration, ToggleCallback, @ToggleData); - finally - ReleaseDC(Window, DC); - end; - end; - end; - end; - - // collapse the node - AdjustTotalHeight(Node, IfThen(IsEffectivelyFiltered[Node], 0, NodeHeight[Node])); - if FullyVisible[Node] then - Dec(FVisibleCount, CountVisibleChildren(Node)); - Exclude(Node.States, vsExpanded); - DoCollapsed(Node); - - // Remove child nodes now, if enabled. - if (toAutoFreeOnCollapse in FOptions.FAutoOptions) and (Node.ChildCount > 0) then - begin - DeleteChildren(Node); - Include(Node.States, vsHasChildren); - end; - end; - end - else - if DoExpanding(Node) then - begin - NeedUpdate := True; - // expand the node, need to adjust the height - if not (vsInitialized in Node.States) then - InitNode(Node); - if (vsHasChildren in Node.States) and (Node.ChildCount = 0) then - InitChildren(Node); - - // Avoid setting the vsExpanded style if there are no child nodes. - if Node.ChildCount > 0 then - begin - // Iterate through the child nodes without initializing them. We have to determine the entire height. - Child := Node.FirstChild; - repeat - if vsVisible in Child.States then - begin - // Ensure the item height is measured - MeasureItemHeight(Canvas, Child); - - Inc(HeightDelta, Child.TotalHeight); - end; - Child := Child.NextSibling; - until Child = nil; - - // Getting the display rectangle is already done here as it is needed for toChildrenAbove in any case. - if (toChildrenAbove in FOptions.FPaintOptions) or (FUpdateCount = 0) then - begin - with ToggleData do - begin - R1 := GetDisplayRect(Node, NoColumn, False); - Mode2 := tamNoScroll; - TotalFit := HeightDelta + Integer(NodeHeight[Node]) <= ClientHeight; - - if toChildrenAbove in FOptions.FPaintOptions then - begin - // The main goal with toChildrenAbove being set is to keep the nodes visual position so the user does - // not get confused. Therefore we need to scroll the view when the expanding is done. - PosHoldable := TotalFit and (Integer(FRangeY) - ClientHeight >= 0) ; - ChildrenInView := (R1.Top - HeightDelta) >= 0; - NodeInView := R1.Bottom <= ClientHeight; - end - else - begin - PosHoldable := TotalFit; - ChildrenInView := R1.Bottom + HeightDelta <= ClientHeight; - end; - - R1.Bottom := ClientHeight; - end; - end; - - if FUpdateCount = 0 then - begin - // Do animated expanding if enabled. - if (ToggleData.R1.Top < ClientHeight) and ([tsPainting, tsExpanding] * FStates = []) and - (toAnimatedToggle in FOptions.FAnimationOptions)then - begin - if tsHint in Self.FStates then - Application.CancelHint; - UpdateWindow(Handle); - // animated expanding - with ToggleData do - begin - if toChildrenAbove in FOptions.FPaintOptions then - begin - // At first check if we hold the position, which is the most common case. - if not (toAdvancedAnimatedToggle in FOptions.FAnimationOptions) or - (PosHoldable and ( (NodeInView and ChildrenInView) or not - (toAutoScrollOnExpand in FOptions.FAutoOptions) )) then - begin - Mode1 := tamScrollUp; - R1 := Rect(R1.Left, 0, R1.Right, R1.Top); - StepsR1 := Min(HeightDelta, R1.Bottom); - end - else - begin - // If we will not hold the node's visual position we mostly scroll in both directions. - Mode1 := tamScrollDown; - Mode2 := tamScrollUp; - R2 := Rect(R1.Left, 0, R1.Right, R1.Top); - if not (toAutoScrollOnExpand in FOptions.FAutoOptions) then - begin - // If we shall not or cannot scroll to the desired extent we calculate the new position (with - // max FOffsetY applied) and animate it that way. - StepsR1 := -FOffsetY - Max(Integer(FRangeY) + HeightDelta - ClientHeight, 0) + HeightDelta; - if (Integer(FRangeY) + HeightDelta - ClientHeight) <= 0 then - Mode2 := tamNoScroll - else - StepsR2 := Min(Integer(FRangeY) + HeightDelta - ClientHeight, R2.Bottom); - end - else - begin - if TotalFit and NodeInView and (Integer(FRangeY) + HeightDelta > ClientHeight) then - begin - // If the whole subtree will fit into the client area and the node is currently fully visible, - // the first child will be made the top node if possible. - if HeightDelta >= R1.Top then - StepsR1 := Abs(R1.Top - HeightDelta) - else - StepsR1 := ClientHeight - Integer(FRangeY); - end - else - if Integer(FRangeY) + HeightDelta <= ClientHeight then - begin - // We cannot make the first child the top node as we cannot scroll to that extent, - // so we do a simple scroll down. - Mode2 := tamNoScroll; - StepsR1 := HeightDelta; - end - else - // If the subtree does not fit into the client area at once, the expanded node will - // be made the bottom node. - StepsR1 := ClientHeight - R1.Top - Integer(NodeHeight[Node]); - - if Mode2 <> tamNoScroll then - begin - if StepsR1 > 0 then - StepsR2 := Min(R1.Top, HeightDelta - StepsR1) - else - begin - // If the node is already at the bottom scrolling is needed. - Mode1 := tamNoScroll; - StepsR2 := Min(HeightDelta, R1.Bottom); - end; - end; - end; - end; - end - else - begin - // toChildrenAbove is not set. - if (PosHoldable and ChildrenInView) or not (toAutoScrollOnExpand in FOptions.FAutoOptions) or not - (toAdvancedAnimatedToggle in FOptions.FAnimationOptions) or (R1.Top <= 0) then - begin - // If the node will stay at its visual position, do a simple down-scroll. - Mode1 := tamScrollDown; - Inc(R1.Top, NodeHeight[Node]); - StepsR1 := Min(R1.Bottom - R1.Top, HeightDelta); - end - else - begin - // We will not hold the nodes visual position so perform a double scroll. - Mode1 := tamScrollUp; - Mode2 := tamScrollDown; - - R1.Bottom := R1.Top + Integer(NodeHeight[Node]) + 1; - R1.Top := 0; - R2 := Rect(R1.Left, R1.Bottom, R1.Right, ClientHeight); - - StepsR1 := Min(HeightDelta - (ClientHeight - R2.Top), R1.Bottom - Integer(NodeHeight[Node])); - StepsR2 := ClientHeight - R2.Top; - end; - end; - - if ClientHeight >= R1.Top then - begin - PrepareAnimation; - try - Animate(Steps, FAnimationDuration, ToggleCallback, @ToggleData); - finally - ReleaseDC(Window, DC); - end; - end; - end; - end; - if toAutoSort in FOptions.FAutoOptions then - Sort(Node, FHeader.FSortColumn, FHeader.FSortDirection, False); - end;// if UpdateCount = 0 - - Include(Node.States, vsExpanded); - AdjustTotalHeight(Node, HeightDelta, True); - if FullyVisible[Node] then - Inc(FVisibleCount, CountVisibleChildren(Node)); - - DoExpanded(Node); - end; - end; - - if NeedUpdate then - begin - InvalidateCache; - if FUpdateCount = 0 then - begin - ValidateCache; - if Node.ChildCount > 0 then - begin - UpdateRanges; - UpdateScrollBars(True); - if [tsPainting, tsExpanding] * FStates = [] then - begin - if (vsExpanded in Node.States) and ((toAutoScrollOnExpand in FOptions.FAutoOptions) or - (toChildrenAbove in FOptions.FPaintOptions)) then - begin - if toChildrenAbove in FOptions.FPaintOptions then - begin - NeedFullInvalidate := True; - if (PosHoldable and ChildrenInView and NodeInView) or not - (toAutoScrollOnExpand in FOptions.FAutoOptions) then - SetOffsetY(FOffsetY - Integer(HeightDelta)) - else - if TotalFit and NodeInView then - begin - FirstVisible := GetFirstVisible(Node, True); - if Assigned(FirstVisible) then // otherwise there is no visible child at all - SetOffsetY(FOffsetY - GetDisplayRect(FirstVisible, NoColumn, False).Top); - end - else - BottomNode := Node; - end - else - begin - // Scroll as much child nodes into view as possible if the node has been expanded. - if PosHoldable then - NeedFullInvalidate := ScrollIntoView(GetLastVisible(Node, True), False) - else - begin - TopNode := Node; - NeedFullInvalidate := True; - end; - end; - end - else - begin - // If we have collapsed the node or toAutoScrollOnExpand is not set, we try to keep the nodes - // visual position. - if toChildrenAbove in FOptions.FPaintOptions then - SetOffsetY(FOffsetY - Integer(HeightDelta)); - NeedFullInvalidate := True; - end; - end; - - //UpdateScrollBars(True); Moved up - - // Check for automatically scrolled tree. - if NeedFullInvalidate then - Invalidate - else - InvalidateToBottom(Node); - end - else - InvalidateNode(Node); - end - else - begin - UpdateRanges; - UpdateScrollBars(True); - end; - end; - - finally - Exclude(Node.States, vsToggling); - if not TogglingTree then - DoStateChange([], [tsToggling]); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateHorizontalRange; - -begin - if FHeader.UseColumns then - SetRangeX(FHeader.FColumns.TotalWidth) - else - SetRangeX(GetMaxRightExtend); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateHorizontalScrollBar(DoRepaint: Boolean); - -var - ScrollInfo: TScrollInfo; - -begin - UpdateHorizontalRange; - - if (tsUpdating in FStates) or not HandleAllocated then - Exit; - - // Adjust effect scroll offset depending on bidi mode. - if UseRightToLeftAlignment then - FEffectiveOffsetX := Integer(FRangeX) - ClientWidth + FOffsetX - else - FEffectiveOffsetX := -FOffsetX; - - if FScrollBarOptions.ScrollBars in [System.UITypes.TScrollStyle.ssHorizontal, System.UITypes.TScrollStyle.ssBoth] then - begin - ZeroMemory (@ScrollInfo, SizeOf(ScrollInfo)); - ScrollInfo.cbSize := SizeOf(ScrollInfo); - ScrollInfo.fMask := SIF_ALL; - GetScrollInfo(Handle, SB_HORZ, ScrollInfo); - - if (Integer(FRangeX) > ClientWidth) or FScrollBarOptions.AlwaysVisible then - begin - DoShowScrollBar(SB_HORZ, True); - - ScrollInfo.nMin := 0; - ScrollInfo.nMax := FRangeX; - ScrollInfo.nPos := FEffectiveOffsetX; - ScrollInfo.nPage := Max(0, ClientWidth + 1); - - ScrollInfo.fMask := SIF_ALL or ScrollMasks[FScrollBarOptions.AlwaysVisible]; - SetScrollInfo(Handle, SB_HORZ, ScrollInfo, DoRepaint); - if DoRepaint then - RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); // Fixes issue #698 - end - else - begin - ScrollInfo.nMin := 0; - ScrollInfo.nMax := 0; - ScrollInfo.nPos := 0; - ScrollInfo.nPage := 0; - DoShowScrollBar(SB_HORZ, False); - SetScrollInfo(Handle, SB_HORZ, ScrollInfo, False); - end; - - // Since the position is automatically changed if it doesn't meet the range - // we better read the current position back to stay synchronized. - FEffectiveOffsetX := GetScrollPos(Handle, SB_HORZ); - if UseRightToLeftAlignment then - SetOffsetX(-Integer(FRangeX) + ClientWidth + FEffectiveOffsetX) - else - SetOffsetX(-FEffectiveOffsetX); - end - else - begin - DoShowScrollBar(SB_HORZ, False); - - // Reset the current horizontal offset to account for window resize etc. - SetOffsetX(FOffsetX); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateRanges; - -begin - UpdateVerticalRange; - UpdateHorizontalRange; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateScrollBars(DoRepaint: Boolean); - -// adjusts scrollbars to reflect current size and paint offset of the tree - -begin - if HandleAllocated then - begin - UpdateVerticalScrollBar(DoRepaint); - UpdateHorizontalScrollBar(DoRepaint); - Perform(CM_UPDATE_VCLSTYLE_SCROLLBARS,0,0); - end; -end; - -procedure TBaseVirtualTree.UpdateStyleElements; -begin - inherited; - UpdateHeaderRect; - FHeader.Columns.PaintHeader(Canvas, FHeaderRect, Point(0,0)); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateVerticalRange; - -begin - // Total node height includes the height of the invisible root node. - FRangeY := Cardinal(Int64(FRoot.TotalHeight) - FRoot.NodeHeight + FBottomSpace); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.UpdateVerticalScrollBar(DoRepaint: Boolean); - -var - ScrollInfo: TScrollInfo; - -begin - UpdateVerticalRange; - - if tsUpdating in FStates then - Exit; - Assert(GetCurrentThreadId = MainThreadId, 'UI controls like ' + Classname + ' and its scrollbars should only be manipulated through the main thread.'); - - if FScrollBarOptions.ScrollBars in [ssVertical, ssBoth] then - begin - ScrollInfo.cbSize := SizeOf(ScrollInfo); - ScrollInfo.fMask := SIF_ALL; - GetScrollInfo(Handle, SB_VERT, ScrollInfo); - - if (Integer(FRangeY) > ClientHeight) or FScrollBarOptions.AlwaysVisible then - begin - DoShowScrollBar(SB_VERT, True); - - ScrollInfo.nMin := 0; - ScrollInfo.nMax := FRangeY; - ScrollInfo.nPos := -FOffsetY; - ScrollInfo.nPage := Max(0, ClientHeight + 1); - - ScrollInfo.fMask := SIF_ALL or ScrollMasks[FScrollBarOptions.AlwaysVisible]; - SetScrollInfo(Handle, SB_VERT, ScrollInfo, DoRepaint); - end - else - begin - ScrollInfo.nMin := 0; - ScrollInfo.nMax := 0; - ScrollInfo.nPos := 0; - ScrollInfo.nPage := 0; - DoShowScrollBar(SB_VERT, False); - SetScrollInfo(Handle, SB_VERT, ScrollInfo, False); - end; - - // Since the position is automatically changed if it doesn't meet the range - // we better read the current position back to stay synchronized. - SetOffsetY(-GetScrollPos(Handle, SB_VERT)); - end - else - begin - DoShowScrollBar(SB_VERT, False); - - // Reset the current vertical offset to account for window resize etc. - SetOffsetY(FOffsetY); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TBaseVirtualTree.UseRightToLeftReading: Boolean; - -// The tree can handle right-to-left reading also on non-middle-east systems, so we cannot use the same function as -// it is implemented in TControl. - -begin - Result := BiDiMode <> bdLeftToRight; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ValidateChildren(Node: PVirtualNode; Recursive: Boolean); - -// Ensures that the children of the given node (and all their children, if Recursive is True) are initialized. -// Node must already be initialized - -var - Child: PVirtualNode; - -begin - if Node = nil then - Node := FRoot; - - if (vsHasChildren in Node.States) and (Node.ChildCount = 0) then - InitChildren(Node); - Child := Node.FirstChild; - while Assigned(Child) do - begin - ValidateNode(Child, Recursive); - Child := Child.NextSibling; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.ValidateNode(Node: PVirtualNode; Recursive: Boolean); - -// Ensures that the given node (and all its children, if Recursive is True) are initialized. - -var - Child: PVirtualNode; - -begin - if Node = nil then - Node := FRoot - else - if not (vsInitialized in Node.States) then - InitNode(Node); - - if Recursive then - begin - if (vsHasChildren in Node.States) and (Node.ChildCount = 0) then - InitChildren(Node); - Child := Node.FirstChild; - while Assigned(Child) do - begin - ValidateNode(Child, Recursive); - Child := Child.NextSibling; - end; - end; -end; - -//----------------- TCustomStringTreeOptions --------------------------------------------------------------------------- - -constructor TCustomStringTreeOptions.Create(AOwner: TBaseVirtualTree); - -begin - inherited; - - FStringOptions := DefaultStringOptions; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TCustomStringTreeOptions.SetStringOptions(const Value: TVTStringOptions); - -var - ChangedOptions: TVTStringOptions; - -begin - if FStringOptions <> Value then - begin - // Exclusive ORing to get all entries wich are in either set but not in both. - ChangedOptions := FStringOptions + Value - (FStringOptions * Value); - FStringOptions := Value; - with FOwner do - if (toShowStaticText in ChangedOptions) and not (csLoading in ComponentState) and HandleAllocated then - Invalidate; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TCustomStringTreeOptions.AssignTo(Dest: TPersistent); - -begin - if Dest is TCustomStringTreeOptions then - begin - with Dest as TCustomStringTreeOptions do - begin - StringOptions := Self.StringOptions; - EditOptions := Self.EditOptions; - end; - end; - - // Let ancestors assign their options to the destination class. - inherited; -end; - -//----------------- TVTEdit -------------------------------------------------------------------------------------------- - -// Implementation of a generic node caption editor. - -constructor TVTEdit.Create(Link: TStringEditLink); - -begin - inherited Create(nil); - ShowHint := False; - ParentShowHint := False; - // This assignment increases the reference count for the interface. - FRefLink := Link; - // This reference is used to access the link. - FLink := Link; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTEdit.CalcMinHeight: Integer; -var - textHeight : Integer; -begin - // Get the actual text height. - textHeight := GetTextSize.cy; - // The minimal height is the actual text height in pixels plus the the non client area. - Result := textHeight + (Height - ClientHeight); - // Also, proportionally to the text size, additional pixel(s) needs to be added for the caret. - Result := Result + Trunc(textHeight * 0.05); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.CMAutoAdjust(var Message: TMessage); - -begin - AutoAdjustSize; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.CMExit(var Message: TMessage); - -begin - if Assigned(FLink) and not FLink.FStopping then - with FLink, FTree do - begin - if (toAutoAcceptEditChange in TreeOptions.StringOptions) then - DoEndEdit - else - DoCancelEdit; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.CMRelease(var Message: TMessage); - -begin - Free; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.CNCommand(var Message: TWMCommand); - -begin - if Assigned(FLink) and Assigned(FLink.FTree) and (Message.NotifyCode = EN_UPDATE) and - not (vsMultiline in FLink.FNode.States) then - // Instead directly calling AutoAdjustSize it is necessary on Win9x/Me to decouple this notification message - // and eventual resizing. Hence we use a message to accomplish that. - AutoAdjustSize() - else - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.WMChar(var Message: TWMChar); - -begin - if not (Message.CharCode in [VK_ESCAPE, VK_TAB]) then - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.WMDestroy(var Message: TWMDestroy); - -begin - // If editing stopped by other means than accept or cancel then we have to do default processing for - // pending changes. - if Assigned(FLink) and not FLink.FStopping then - begin - with FLink, FTree do - begin - if (toAutoAcceptEditChange in TreeOptions.StringOptions) and Modified then - Text[FNode, FColumn] := FEdit.Text; - end; - FLink := nil; - FRefLink := nil; - end; - - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.WMGetDlgCode(var Message: TWMGetDlgCode); - -begin - inherited; - - Message.Result := Message.Result or DLGC_WANTALLKEYS or DLGC_WANTTAB or DLGC_WANTARROWS; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.WMKeyDown(var Message: TWMKeyDown); - -// Handles some control keys. - -var - Shift: TShiftState; - EndEdit: Boolean; - Tree: TBaseVirtualTree; - NextNode: PVirtualNode; - ColumnCandidate: Integer; - EditOptions: TVTEditOptions; - Column: TVirtualTreeColumn; -begin - Tree := FLink.FTree; - case Message.CharCode of - VK_ESCAPE: - begin - Tree.DoCancelEdit; - end; - VK_RETURN: - begin - EndEdit := not (vsMultiline in FLink.FNode.States); - if not EndEdit then - begin - // If a multiline node is being edited the finish editing only if Ctrl+Enter was pressed, - // otherwise allow to insert line breaks into the text. - Shift := KeyDataToShiftState(Message.KeyData); - EndEdit := ssCtrl in Shift; - end; - if EndEdit then - begin - Tree := FLink.FTree; - FLink.FTree.InvalidateNode(FLink.FNode); - NextNode := Tree.GetNextVisible(FLink.FNode, True); - FLink.FTree.DoEndEdit; - - // get edit options for column as priority. If column has toDefaultEdit - // use global edit options for tree - EditOptions := Tree.TreeOptions.EditOptions; // default - ColumnCandidate := -1; - if Tree.Header.Columns.Count > 0 then // are there any columns? - begin - Column := Tree.Header.Columns[Tree.FocusedColumn]; - if Column.EditOptions <> toDefaultEdit then - EditOptions := Column.EditOptions; - - // next column candidate for toVerticalEdit and toHorizontalEdit - if Column.EditNextColumn <> -1 then - ColumnCandidate := Column.EditNextColumn; - end; - - case EditOptions of - toDefaultEdit: Tree.SetFocus; - toVerticalEdit: - if NextNode <> nil then - begin - Tree.FocusedNode := NextNode; - - // for toVerticalEdit ColumnCandidate is also proper, - // select ColumnCandidate column in row below - if ColumnCandidate <> -1 then - begin - Tree.FocusedColumn := ColumnCandidate; - Tree.EditColumn := ColumnCandidate; - end; - - if Tree.CanEdit(Tree.FocusedNode, Tree.FocusedColumn) then - Tree.DoEdit; - end; - toHorizontalEdit: - begin - if ColumnCandidate = -1 then - begin - // for toHorizontalEdit if property EditNextColumn is not used - // try to use just next column - ColumnCandidate := Tree.FocusedColumn+1; - while (ColumnCandidate < Tree.Header.Columns.Count) - and not Tree.CanEdit(Tree.FocusedNode, ColumnCandidate) - do - Inc(ColumnCandidate); - end - else - if not Tree.CanEdit(Tree.FocusedNode, ColumnCandidate) then - ColumnCandidate := Tree.Header.Columns.Count; // omit "focus/edit column" (see below) - - if ColumnCandidate < Tree.Header.Columns.Count then - begin - Tree.FocusedColumn := ColumnCandidate; - Tree.EditColumn := ColumnCandidate; - Tree.DoEdit; - end; - end; - end; - end; - end; - VK_UP: - begin - if not (vsMultiline in FLink.FNode.States) then - Message.CharCode := VK_LEFT; - inherited; - end; - VK_DOWN: - begin - if not (vsMultiline in FLink.FNode.States) then - Message.CharCode := VK_RIGHT; - inherited; - end; - VK_TAB: - begin - if Tree.IsEditing then - begin - Tree.InvalidateNode(FLink.FNode); - NextNode := Tree.GetNextVisible(FLink.FNode, True); - Tree.EndEditNode; - // check NextNode, otherwise we got AV - if NextNode <> nil then - begin - Tree.FocusedNode := NextNode; - if Tree.CanEdit(Tree.FocusedNode, Tree.FocusedColumn) then - Tree.DoEdit; - end; - end; - end; - Ord('A'): - begin - if Tree.IsEditing and ([ssCtrl] = KeyboardStateToShiftState) then - begin - Self.SelectAll(); - Message.CharCode := 0; - end; - end; - else - inherited; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.AutoAdjustSize; - -// Changes the size of the edit to accomodate as much as possible of its text within its container window. -// NewChar describes the next character which will be added to the edit's text. - -var - Size: TSize; -begin - if not (vsMultiline in FLink.FNode.States) and not (toGridExtensions in FLink.FTree.FOptions.FMiscOptions{see issue #252}) then - begin - // avoid flicker - SendMessage(Handle, WM_SETREDRAW, 0, 0); - try - Size := GetTextSize; - Inc(Size.cx, 2 * FLink.FTree.FTextMargin); - // Repaint associated node if the edit becomes smaller. - if Size.cx < Width then - FLink.FTree.Invalidate(); - - if FLink.FAlignment = taRightJustify then - FLink.SetBounds(Rect(Left + Width - Size.cx, Top, Left + Width, Top + Max(Size.cy, Height))) - else - FLink.SetBounds(Rect(Left, Top, Left + Size.cx, Top + Max(Size.cy, Height))); - finally - SendMessage(Handle, WM_SETREDRAW, 1, 0); - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.CreateParams(var Params: TCreateParams); - -begin - inherited; - - // Only with multiline style we can use the text formatting rectangle. - // This does not harm formatting as single line control, if we don't use word wrapping. - with Params do - begin - Style := Style or ES_MULTILINE; - if vsMultiline in FLink.FNode.States then - Style := Style and not (ES_AUTOHSCROLL or WS_HSCROLL) or WS_VSCROLL or ES_AUTOVSCROLL; - if tsUseThemes in FLink.FTree.FStates then - begin - Style := Style and not WS_BORDER; - ExStyle := ExStyle or WS_EX_CLIENTEDGE; - end - else - begin - Style := Style or WS_BORDER; - ExStyle := ExStyle and not WS_EX_CLIENTEDGE; - end; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVTEdit.GetTextSize: TSize; -var - DC: HDC; - LastFont: THandle; -begin - DC := GetDC(Handle); - LastFont := SelectObject(DC, Font.Handle); - try - // Read needed space for the current text. - GetTextExtentPoint32(DC, PChar(Text+'yG'), Length(Text)+2, Result); - finally - SelectObject(DC, LastFont); - ReleaseDC(Handle, DC); - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVTEdit.Release; - -begin - if HandleAllocated then - PostMessage(Handle, CM_RELEASE, 0, 0); -end; - -//----------------- TStringEditLink ------------------------------------------------------------------------------------ - -constructor TStringEditLink.Create; - -begin - inherited; - FEdit := TVTEdit.Create(Self); - with FEdit do - begin - Visible := False; - BorderStyle := bsSingle; - AutoSize := False; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -destructor TStringEditLink.Destroy; - -begin - if Assigned(FEdit) then - FEdit.Release; - inherited; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TStringEditLink.BeginEdit: Boolean; - -// Notifies the edit link that editing can start now. descendants may cancel node edit -// by returning False. - -begin - Result := not FStopping; - if Result then - begin - FEdit.Show; - FEdit.SelectAll; - FEdit.SetFocus; - FEdit.AutoAdjustSize; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TStringEditLink.SetEdit(const Value: TVTEdit); - -begin - if Assigned(FEdit) then - FEdit.Free; - FEdit := Value; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TStringEditLink.CancelEdit: Boolean; - -begin - Result := not FStopping; - if Result then - begin - FStopping := True; - FEdit.Hide; - FTree.CancelEditNode; - FEdit.FLink := nil; - FEdit.FRefLink := nil; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TStringEditLink.EndEdit: Boolean; - -begin - Result := not FStopping; - if Result then - try - FStopping := True; - if FEdit.Modified then - FTree.Text[FNode, FColumn] := FEdit.Text; - FEdit.Hide; - FEdit.FLink := nil; - FEdit.FRefLink := nil; - except - FStopping := False; - raise; - end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TStringEditLink.GetBounds: TRect; - -begin - Result := FEdit.BoundsRect; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TStringEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; - -// Retrieves the true text bounds from the owner tree. - -var - Text: string; - -begin - Result := Tree is TCustomVirtualStringTree; - if Result then - begin - if not Assigned(FEdit) then - begin - FEdit := TVTEdit.Create(Self); - FEdit.Visible := False; - FEdit.BorderStyle := bsSingle; - end; - FEdit.AutoSize := True; - FTree := Tree as TCustomVirtualStringTree; - FNode := Node; - FColumn := Column; - FEdit.Parent := Tree; - // Initial size, font and text of the node. - FTree.GetTextInfo(Node, Column, FEdit.Font, FTextBounds, Text); - FEdit.Font.Color := clWindowText; - FEdit.RecreateWnd; - FEdit.AutoSize := False; - FEdit.Text := Text; - - if Column <= NoColumn then - begin - FEdit.BidiMode := FTree.BidiMode; - FAlignment := FTree.Alignment; - end - else - begin - FEdit.BidiMode := FTree.Header.Columns[Column].BidiMode; - FAlignment := FTree.Header.Columns[Column].Alignment; - end; - - if FEdit.BidiMode <> bdLeftToRight then - ChangeBidiModeAlignment(FAlignment); + property OnShortenString; + property OnShowScrollBar; + property OnBeforeGetCheckState; + property OnStartDock; + property OnStartDrag; + property OnStartOperation; + property OnStateChange; + property OnStructureChange; + property OnUpdating; + property OnCanResize; + property OnGesture; + property Touch; + property OnColumnHeaderSpanning; end; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TStringEditLink.ProcessMessage(var Message: TMessage); - -begin - FEdit.WindowProc(Message); -end; //---------------------------------------------------------------------------------------------------------------------- -procedure TStringEditLink.SetBounds(R: TRect); +implementation +uses + System.TypInfo, // for migration stuff + System.StrUtils, + System.Types, // prevent inline compiler warning + System.UITypes, // prevent inline compiler warning + VirtualTrees.StyleHooks, + VirtualTrees.ClipBoard, + VirtualTrees.Utils, + VirtualTrees.Export, + VirtualTrees.EditLink, + VirtualTrees.BaseAncestorVcl{to eliminate H2443 about inline expanding} + ; -// Sets the outer bounds of the edit control and the actual edit area in the control. +const + cDefaultText = 'Node'; + RTLFlag: array[Boolean] of Integer = (0, ETO_RTLREADING); + AlignmentToDrawFlag: array[TAlignment] of Cardinal = (DT_LEFT, DT_RIGHT, DT_CENTER); + gInitialized: Integer = 0; // >0 if global structures have been initialized; otherwise 0 -var - lOffset, tOffset, height: Integer; - offsets : TVTOffsets; +//// initialization of stuff global to the unit +procedure InitializeGlobalStructures(); begin - if not FStopping then - begin - // Check if the provided rect height is smaller than the edit control height. - height := R.Bottom - R.Top; - if height < FEdit.ClientHeight then - begin - // If the height is smaller than the minimal height we must correct it, otherwise the caret will be invisible. - tOffset := FEdit.CalcMinHeight - height; - if tOffset > 0 then - Inc(R.Bottom, tOffset); - end; - - // Set the edit's bounds but make sure there's a minimum width and the right border does not - // extend beyond the parent's left/right border. - if R.Left < 0 then - R.Left := 0; - if R.Right - R.Left < 30 then - begin - if FAlignment = taRightJustify then - R.Left := R.Right - 30 - else - R.Right := R.Left + 30; - end; - if R.Right > FTree.ClientWidth then - R.Right := FTree.ClientWidth; - FEdit.BoundsRect := R; - - // The selected text shall exclude the text margins and be centered vertically. - // We have to take out the two pixel border of the edit control as well as a one pixel "edit border" the - // control leaves around the (selected) text. - R := FEdit.ClientRect; - - // If toGridExtensions are turned on, we can fine tune the left margin (or the right margin if RTL is on) - // of the text to exactly match the text in the tree cell. - if (toGridExtensions in FTree.TreeOptions.MiscOptions) and - ((FAlignment = taLeftJustify) and (FEdit.BidiMode = bdLeftToRight) or - (FAlignment = taRightJustify) and (FEdit.BidiMode <> bdLeftToRight)) then - begin - // Calculate needed text area offset. - FTree.GetOffsets(FNode, offsets, ofsText, FColumn); - if FColumn = FTree.Header.MainColumn then - begin - if offsets[ofsToggleButton] < 0 then - lOffset := -(offsets[ofsToggleButton] + 2) - else - lOffset := 0; - end - else - lOffset := offsets[ofsText] - offsets[ofsMargin] + 1; - // Apply the offset. - if FEdit.BidiMode = bdLeftToRight then - Inc(R.Left, lOffset) - else - Dec(R.Right, lOffset); - end; + if (gInitialized > 0) or (AtomicIncrement(gInitialized) <> 1) then // Ensure threadsafe that this code is executed only once + exit; - lOffset := IfThen(vsMultiline in FNode.States, 0, 2); - if tsUseThemes in FTree.FStates then - Inc(lOffset); - InflateRect(R, -FTree.FTextMargin + lOffset, lOffset); - if not (vsMultiline in FNode.States) then - begin - tOffset := FTextBounds.Top - FEdit.Top; - // Do not apply a negative offset, the cursor will disappear. - if tOffset > 0 then - OffsetRect(R, 0, tOffset); - end; - R.Top := Max(-1, R.Top); // A value smaller than -1 will prevent the edit cursor from being shown by Windows, see issue #159 - R.Left := Max(-1, R.Left); - SendMessage(FEdit.Handle, EM_SETRECTNP, 0, LPARAM(@R)); - end; + // Clipboard format registration. + // Specialized string tree formats. + CF_HTML := RegisterVTClipboardFormat(CFSTR_HTML, TCustomVirtualStringTree, 80); + CF_VRTFNOOBJS := RegisterVTClipboardFormat(CFSTR_RTFNOOBJS, TCustomVirtualStringTree, 84); + CF_VRTF := RegisterVTClipboardFormat(CFSTR_RTF, TCustomVirtualStringTree, 85); + CF_CSV := RegisterVTClipboardFormat(CFSTR_CSV, TCustomVirtualStringTree, 90); + // Predefined clipboard formats. Just add them to the internal list. + RegisterVTClipboardFormat(CF_TEXT, TCustomVirtualStringTree, 100); + RegisterVTClipboardFormat(CF_UNICODETEXT, TCustomVirtualStringTree, 95); end; + //----------------- TCustomVirtualString ------------------------------------------------------------------------------- constructor TCustomVirtualStringTree.Create(AOwner: TComponent); begin + InitializeGlobalStructures(); inherited; FPreviouslySelected := nil; FDefaultText := cDefaultText; @@ -33249,7 +751,7 @@ function TCustomVirtualStringTree.GetImageText(Node: PVirtualNode; function TCustomVirtualStringTree.GetOptions: TCustomStringTreeOptions; begin - Result := FOptions as TCustomStringTreeOptions; + Result := inherited TreeOptions as TCustomStringTreeOptions; end; //---------------------------------------------------------------------------------------------------------------------- @@ -33292,35 +794,35 @@ procedure TCustomVirtualStringTree.InitializeTextProperties(var PaintInfo: TVTPa with PaintInfo do begin // Set default font values first. - Canvas.Font := Font; + Canvas.Font.Assign(Font); if Enabled then // Otherwise only those colors are used, which are passed from Font to Canvas.Font. - Canvas.Font.Color := FColors.NodeFontColor + Canvas.Font.Color := Colors.NodeFontColor else - Canvas.Font.Color := FColors.DisabledColor; + Canvas.Font.Color := Colors.DisabledColor; - if (toHotTrack in FOptions.FPaintOptions) and (Node = FCurrentHotNode) then + if (toHotTrack in TreeOptions.PaintOptions) and (Node = HotNode) then begin - if not (tsUseExplorerTheme in FStates) then + if not (tsUseExplorerTheme in TreeStates) then begin - Canvas.Font.Style := Canvas.Font.Style + [fsUnderline]; - Canvas.Font.Color := FColors.HotColor; + Canvas.Font.Style := Canvas.Font.Style + [TFontStyle.fsUnderline]; + Canvas.Font.Color := Colors.HotColor; end; end; // Change the font color only if the node also is drawn in selected style. if poDrawSelection in PaintOptions then begin - if (Column = FFocusedColumn) or (toFullRowSelect in FOptions.FSelectionOptions) then + if (Column = FocusedColumn) or (toFullRowSelect in TreeOptions.SelectionOptions) then begin - if Node = FDropTargetNode then + if Node = DropTargetNode then begin - if ((FLastDropMode = dmOnNode) or (vsSelected in Node.States)) then - Canvas.Font.Color := FColors.GetSelectedNodeFontColor(Focused); + if (LastDropMode = dmOnNode) or (vsSelected in Node.States) or InternalIsCellSelected(Node, Column) then + Canvas.Font.Color := Colors.GetSelectedNodeFontColor(True); // See #1083, since drop highlight color is chosen independent of the focus state, we need to choose Font color also independent of it. end else - if vsSelected in Node.States then + if (vsSelected in Node.States) or InternalIsCellSelected(Node, Column) then begin - Canvas.Font.Color := FColors.GetSelectedNodeFontColor(Focused); + Canvas.Font.Color := Colors.GetSelectedNodeFontColor(Focused or (toPopupMode in TreeOptions.PaintOptions)); end; end; end; @@ -33338,22 +840,21 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; // the node rectangle. The clipping rectangle comprises the entire node (including tree lines, buttons etc.). var - TripleWidth: Integer; + TripleWidth: TDimension; R: TRect; DrawFormat: Cardinal; - Size: TSize; - Height: Integer; - + Height: TDimension; + lNewNodeWidth: TDimension; begin InitializeTextProperties(PaintInfo); with PaintInfo do begin R := ContentRect; Canvas.TextFlags := 0; - InflateRect(R, -FTextMargin, 0); + InflateRect(R, -TextMargin, 0); if (vsDisabled in Node.States) or not Enabled then - Canvas.Font.Color := FColors.DisabledColor; + Canvas.Font.Color := Colors.DisabledColor; // Multiline nodes don't need special font handling or text manipulation. // Note: multiline support requires the Unicode version of DrawText, which is able to do word breaking. // The emulation in this unit does not support this so we have to use the OS version. However @@ -33372,7 +873,7 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; // Center the text vertically if it fits entirely into the content rect. if R.Bottom - R.Top > Height then - InflateRect(R, 0, (Height - R.Bottom - R.Top) div 2); + InflateRect(R, 0, Divide(Height - R.Bottom - R.Top, 2)); end else begin @@ -33384,15 +885,19 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; // If the font has been changed then the ellipsis width must be recalculated. TripleWidth := 0; // Recalculate also the width of the normal text. - GetTextExtentPoint32W(Canvas.Handle, PWideChar(Text), Length(Text), Size); - NodeWidth := Size.cx + 2 * FTextMargin; - end; + lNewNodeWidth := DoTextMeasuring(Canvas, Node, Column, Text).cx + 2 * TextMargin; + if lNewNodeWidth <> NodeWidth then + begin + NodeWidth := lNewNodeWidth; + InvalidateNode(Node); // repaint node and selection as the font chnaged, see #1084 + end;//if + end;// if FFontChanged DrawFormat := DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE; if BidiMode <> bdLeftToRight then DrawFormat := DrawFormat or DT_RTLREADING; // Check if the text must be shortend. - if (Column > NoColumn) and ((NodeWidth - 2 * FTextMargin) > R.Right - R.Left) then + if (Column > NoColumn) and ((NodeWidth - 2 * TextMargin) > R.Width) then begin Text := DoShortenString(Canvas, Node, Column, Text, R.Right - R.Left, TripleWidth); if Alignment = taRightJustify then @@ -33415,8 +920,7 @@ procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; //---------------------------------------------------------------------------------------------------------------------- -procedure TCustomVirtualStringTree.PaintStaticText(const PaintInfo: TVTPaintInfo; TextOutFlags: Integer; - const Text: string); +procedure TCustomVirtualStringTree.PaintStaticText(const PaintInfo: TVTPaintInfo; pStaticTextAlignment: TAlignment; const Text: string); // This method retrives and draws the static text bound to a particular node. @@ -33427,23 +931,23 @@ procedure TCustomVirtualStringTree.PaintStaticText(const PaintInfo: TVTPaintInfo begin with PaintInfo do begin - Canvas.Font := Font; - if toFullRowSelect in FOptions.FSelectionOptions then + Canvas.Font.Assign(Font); + if toFullRowSelect in TreeOptions.SelectionOptions then begin - if Node = FDropTargetNode then + if Node = DropTargetNode then begin - if (FLastDropMode = dmOnNode) or (vsSelected in Node.States) then - Canvas.Font.Color := FColors.GetSelectedNodeFontColor(Focused) + if (LastDropMode = dmOnNode) or (vsSelected in Node.States) or InternalIsCellSelected(Node, Column) then + Canvas.Font.Color := Colors.GetSelectedNodeFontColor(Focused or (toPopupMode in TreeOptions.PaintOptions)) else - Canvas.Font.Color := FColors.NodeFontColor; + Canvas.Font.Color := Colors.NodeFontColor; end else - if vsSelected in Node.States then + if (vsSelected in Node.States) or InternalIsCellSelected(Node, Column) then begin - if Focused or (toPopupMode in FOptions.FPaintOptions) then - Canvas.Font.Color := FColors.GetSelectedNodeFontColor(Focused) + if Focused or (toPopupMode in TreeOptions.PaintOptions) then + Canvas.Font.Color := Colors.GetSelectedNodeFontColor(Focused or (toPopupMode in TreeOptions.PaintOptions)) else - Canvas.Font.Color := FColors.NodeFontColor; + Canvas.Font.Color := Colors.NodeFontColor; end; end; @@ -33453,15 +957,20 @@ procedure TCustomVirtualStringTree.PaintStaticText(const PaintInfo: TVTPaintInfo // Disabled node color overrides all other variants. if (vsDisabled in Node.States) or not Enabled then - Canvas.Font.Color := FColors.DisabledColor; + Canvas.Font.Color := Colors.DisabledColor; R := ContentRect; - if Alignment = taRightJustify then begin - Dec(R.Right, NodeWidth + FTextMargin); - DrawFormat := DrawFormat or DT_RIGHT + if pStaticTextAlignment = taRightJustify then begin + DrawFormat := DrawFormat or DT_RIGHT; + Dec(R.Right, TextMargin); + if PaintInfo.Alignment = taRightJustify then + Dec(R.Right, NodeWidth); // room for node text end - else - Inc(R.Left, NodeWidth + FTextMargin); + else begin + Inc(R.Left, TextMargin); + if PaintInfo.Alignment = taLeftJustify then + Inc(R.Left, NodeWidth); // room for node text + end; if Canvas.TextFlags and ETO_OPAQUE = 0 then SetBkMode(Canvas.Handle, TRANSPARENT) @@ -33519,7 +1028,7 @@ procedure TCustomVirtualStringTree.SetDefaultText(const Value: string); procedure TCustomVirtualStringTree.SetOptions(const Value: TCustomStringTreeOptions); begin - FOptions.Assign(Value); + inherited TreeOptions.Assign(Value); end; //---------------------------------------------------------------------------------------------------------------------- @@ -33551,7 +1060,7 @@ procedure TCustomVirtualStringTree.WMSetFont(var Msg: TWMSetFont); MemDC := CreateCompatibleDC(0); try SelectObject(MemDC, Msg.Font); - GetTextMetrics(MemDC, TM); + WinApi.Windows.GetTextMetrics(MemDC, TM); FTextHeight := TM.tmHeight; GetTextExtentPoint32W(MemDC, '...', 3, Size); @@ -33561,7 +1070,7 @@ procedure TCustomVirtualStringTree.WMSetFont(var Msg: TWMSetFont); end; // Have to reset all node widths. - Run := FRoot.FirstChild; + Run := RootNode.FirstChild; while Assigned(Run) do begin Data := InternalData(Run); @@ -33582,19 +1091,19 @@ function TCustomVirtualStringTree.AddChild(Parent: PVirtualNode; UserData: Point if (toRestoreSelection in TreeOptions.SelectionOptions) and Assigned(FPreviouslySelected) and Assigned(OnGetText) then begin // See if this was the previously selected node and restore it in this case - Self.OnGetText(Self, Result, 0, ttNormal, NewNodeText); + Self.OnGetText(Self, Result, Header.RestoreSelectionColumnIndex, ttNormal, NewNodeText); if FPreviouslySelected.IndexOf(NewNodeText) >= 0 then begin // Select this node and make sure that the parent node is expanded - Include(FStates, tsPreviouslySelectedLocked); + TreeStates:= TreeStates + [tsPreviouslySelectedLocked]; try Self.Selected[Result] := True; finally - Exclude(FStates, tsPreviouslySelectedLocked); + TreeStates:= TreeStates - [tsPreviouslySelectedLocked]; end; // if a there is a selected node now, then make sure that it is visible if (Self.GetFirstSelected <> nil) then - Self.SetFullyVisible(Self.GetFirstSelected, True); + Self.FullyVisible[Self.GetFirstSelected]:= True; end; end; end; @@ -33607,8 +1116,8 @@ procedure TCustomVirtualStringTree.AdjustPaintCellRect(var PaintInfo: TVTPaintIn // Note: the autospan feature can only be used with left-to-right layout. begin - if (toAutoSpanColumns in FOptions.FAutoOptions) and FHeader.UseColumns and (PaintInfo.BidiMode = bdLeftToRight) then - with FHeader.FColumns, PaintInfo do + if (toAutoSpanColumns in TreeOptions.AutoOptions) and Header.UseColumns and (PaintInfo.BidiMode = bdLeftToRight) then + with Header.Columns, PaintInfo do begin // Start with the directly following column. NextNonEmpty := GetNextVisibleColumn(Column); @@ -33630,7 +1139,7 @@ procedure TCustomVirtualStringTree.AdjustPaintCellRect(var PaintInfo: TVTPaintIn //---------------------------------------------------------------------------------------------------------------------- -function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): Integer; +function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): TDimension; begin Result := 0; @@ -33639,22 +1148,22 @@ function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node DoPaintText(Node, Canvas, Column, ttStatic); Inc(Result, DoTextMeasuring(Canvas, Node, Column, Text).cx); - Inc(Result, FTextMargin); + Inc(Result, TextMargin); end; end; //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.CalculateTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - const Text: string): Integer; + const Text: string): TDimension; // Determines the width of the given text. begin - Result := 2 * FTextMargin; + Result := 2 * TextMargin; if Length(Text) > 0 then begin - Canvas.Font := Font; + Canvas.Font.Assign(Font); DoPaintText(Node, Canvas, Column, ttNormal); Inc(Result, DoTextMeasuring(Canvas, Node, Column, Text).cx); @@ -33700,8 +1209,30 @@ destructor TCustomVirtualStringTree.Destroy; //---------------------------------------------------------------------------------------------------------------------- -function TCustomVirtualStringTree.DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; +procedure TCustomVirtualStringTree.DoAddToSelection(Node: PVirtualNode); +var + lSelectedNodeCaption: string; +begin + inherited; + if (toRestoreSelection in TreeOptions.SelectionOptions) and Assigned(Self.OnGetText) and not (tsPreviouslySelectedLocked in TreeStates) then + begin + if not Assigned(FPreviouslySelected) then + begin + FPreviouslySelected := TStringList.Create(); + FPreviouslySelected.Duplicates := dupIgnore; + FPreviouslySelected.Sorted := True; //Improves performance, required to use Find() + FPreviouslySelected.CaseSensitive := False; + end; + if Self.SelectedCount = 1 then + FPreviouslySelected.Clear(); + Self.OnGetText(Self, Node, Header.RestoreSelectionColumnIndex, ttNormal, lSelectedNodeCaption); + FPreviouslySelected.Add(lSelectedNodeCaption); + end;//if +end; + +//---------------------------------------------------------------------------------------------------------------------- +function TCustomVirtualStringTree.DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; begin Result := inherited DoCreateEditor(Node, Column); // Enable generic label editing support if the application does not have own editors. @@ -33736,10 +1267,10 @@ function TCustomVirtualStringTree.DoGetNodeTooltip(Node: PVirtualNode; Column: T //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex; - Canvas: TCanvas = nil): Integer; + Canvas: TCanvas = nil): TDimension; begin - if not (toShowStaticText in TreeOptions.FStringOptions) then + if not (toShowStaticText in TreeOptions.StringOptions) then Exit(0); if Canvas = nil then Canvas := Self.Canvas; @@ -33748,23 +1279,23 @@ function TCustomVirtualStringTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column //---------------------------------------------------------------------------------------------------------------------- -function TCustomVirtualStringTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; +function TCustomVirtualStringTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): TDimension; // Returns the text width of the given node in pixels. // This width is stored in the node's data member to increase access speed. var - Data: PInteger; + Data: PDimension; begin if (Column > NoColumn) and (vsMultiline in Node.States) then - Result := FHeader.Columns[Column].Width + Result := Header.Columns[Column].Width else begin if Canvas = nil then Canvas := Self.Canvas; - if (Column = FHeader.MainColumn) or (Column = NoColumn) then + if (Column = Header.MainColumn) or (Column = NoColumn) then begin // Primary column or no columns. Data := InternalData(Node); @@ -33772,7 +1303,7 @@ function TCustomVirtualStringTree.DoGetNodeWidth(Node: PVirtualNode; Column: TCo begin Result := Data^; if (Result = 0) - or FHeader.doingAutoFitColumns then + or Header.doingAutoFitColumns then begin Data^ := CalculateTextWidth(Canvas, Node, Column, Text[Node, Column]); Result := Data^; @@ -33814,8 +1345,8 @@ function TCustomVirtualStringTree.DoIncrementalSearch(Node: PVirtualNode; const begin Result := 0; - if Assigned(FOnIncrementalSearch) then - FOnIncrementalSearch(Self, Node, Text, Result) + if Assigned(OnIncrementalSearch) then + OnIncrementalSearch(Self, Node, Text, Result) else // Default behavior is to match the search string with the start of the node text. if not StartsText(Text, GetText(Node, FocusedColumn)) then @@ -33831,7 +1362,7 @@ procedure TCustomVirtualStringTree.DoNewText(Node: PVirtualNode; Column: TColumn FOnNewText(Self, Node, Column, Text); // The width might have changed, so update the scrollbar. - if FUpdateCount = 0 then + if UpdateCount = 0 then UpdateHorizontalScrollBar(True); end; @@ -33857,6 +1388,7 @@ procedure TCustomVirtualStringTree.DoPaintNode(var PaintInfo: TVTPaintInfo); lEventArgs := TVSTGetCellTextEventArgs.Create(PaintInfo.Node, PaintInfo.Column); lEventArgs.CellText := FDefaultText; + lEventArgs.StaticTextAlignment := PaintInfo.Alignment; DoGetText(lEventArgs); // Paint the normal text first... @@ -33864,8 +1396,8 @@ procedure TCustomVirtualStringTree.DoPaintNode(var PaintInfo: TVTPaintInfo); PaintNormalText(PaintInfo, TextOutFlags, lEventArgs.CellText); // ... and afterwards the static text if not centered and the node is not multiline enabled. - if (Alignment <> taCenter) and not (vsMultiline in PaintInfo.Node.States) and (toShowStaticText in TreeOptions.FStringOptions) and not lEventArgs.StaticText.IsEmpty then - PaintStaticText(PaintInfo, TextOutFlags, lEventArgs.StaticText); + if (Alignment <> taCenter) and not (vsMultiline in PaintInfo.Node.States) and (toShowStaticText in TreeOptions.StringOptions) and not lEventArgs.StaticText.IsEmpty then + PaintStaticText(PaintInfo, lEventArgs.StaticTextAlignment, lEventArgs.StaticText); finally RestoreFontChangeEvent(PaintInfo.Canvas); end; @@ -33873,19 +1405,8 @@ procedure TCustomVirtualStringTree.DoPaintNode(var PaintInfo: TVTPaintInfo); //---------------------------------------------------------------------------------------------------------------------- - -procedure TCustomVirtualStringTree.DoPaintText(Node: PVirtualNode; const Canvas: TCanvas; Column: TColumnIndex; - TextType: TVSTTextType); - -begin - if Assigned(FOnPaintText) then - FOnPaintText(Self, Canvas, Node, Column, TextType); -end; - -//---------------------------------------------------------------------------------------------------------------------- - function TCustomVirtualStringTree.DoShortenString(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - const S: string; Width: Integer; EllipsisWidth: Integer = 0): string; + const S: string; Width: TDimension; EllipsisWidth: TDimension = 0): string; var Done: Boolean; @@ -33905,13 +1426,19 @@ procedure TCustomVirtualStringTree.DoTextDrawing(var PaintInfo: TVTPaintInfo; co var DefaultDraw: Boolean; - + lText: string; begin DefaultDraw := True; - if Assigned(FOnDrawText) then + if not Assigned(FOnDrawTextEx) and Assigned(FOnDrawText) then FOnDrawText(Self, PaintInfo.Canvas, PaintInfo.Node, PaintInfo.Column, Text, CellRect, DefaultDraw); + if ((DrawFormat and DT_RIGHT) > 0) and (TFontStyle.fsItalic in PaintInfo.Canvas.Font.Style) then + lText := Text + ' ' + else + lText := Text; + if Assigned(FOnDrawTextEx) then + FOnDrawTextEx(Self, PaintInfo.Canvas, PaintInfo.Node, PaintInfo.Column, lText, CellRect, DefaultDraw, DrawFormat); if DefaultDraw then - Winapi.Windows.DrawTextW(PaintInfo.Canvas.Handle, PWideChar(Text), Length(Text), CellRect, DrawFormat); + Winapi.Windows.DrawTextW(PaintInfo.Canvas.Handle, PWideChar(lText), Length(lText), CellRect, DrawFormat); end; //---------------------------------------------------------------------------------------------------------------------- @@ -33956,6 +1483,8 @@ function TCustomVirtualStringTree.InternalData(Node: PVirtualNode): Pointer; begin if (Node = nil) or (FInternalDataOffset = 0) then Result := nil + else if Node = RootNode then + Result := PByte(Node) + FInternalDataOffset else Result := PByte(Node) + Self.NodeDataSize + FInternalDataOffset; end; @@ -33972,7 +1501,7 @@ procedure TCustomVirtualStringTree.MainColumnChanged; inherited; // Have to reset all node widths. - Run := FRoot.FirstChild; + Run := RootNode.FirstChild; while Assigned(Run) do begin Data := InternalData(Run); @@ -34003,7 +1532,7 @@ function TCustomVirtualStringTree.ReadChunk(Stream: TStream; Version: Integer; N Stream.Read(PWideChar(NewText)^, ChunkSize); end; // Do a new text event regardless of the caption content to allow removing the default string. - Text[Node, FHeader.MainColumn] := NewText; + Text[Node, Header.MainColumn] := NewText; Result := True; end; else @@ -34046,9 +1575,9 @@ procedure TCustomVirtualStringTree.ReadOldStringOptions(Reader: TReader); OldOption := TOldVTStringOption(GetEnumValue(TypeInfo(TOldVTStringOption), EnumName)); case OldOption of soSaveCaptions: - StringOptions := FStringOptions + [toSaveCaptions]; + StringOptions := StringOptions + [toSaveCaptions]; soShowStaticText: - StringOptions := FStringOptions + [toShowStaticText]; + StringOptions := StringOptions + [toShowStaticText]; end; end; end; @@ -34093,25 +1622,25 @@ procedure TCustomVirtualStringTree.WriteChunks(Stream: TStream; Node: PVirtualNo // (take out soSaveCaption from StringOptions). Otherwise the caption is unnecessarily stored twice. var - Header: TChunkHeader; + ChunkHeader: TChunkHeader; S: string; Len: Integer; begin inherited; - if (toSaveCaptions in TreeOptions.FStringOptions) and (Node <> FRoot) and + if (toSaveCaptions in TreeOptions.StringOptions) and (Node <> RootNode) and (vsInitialized in Node.States) then with Stream do begin // Read the node's caption (primary column only). - S := Text[Node, FHeader.MainColumn]; + S := Text[Node, Header.MainColumn]; Len := 2 * Length(S); if Len > 0 then begin // Write a new sub chunk. - Header.ChunkType := CaptionChunk; - Header.ChunkSize := Len; - Write(Header, SizeOf(Header)); + ChunkHeader.ChunkType := CaptionChunk; + ChunkHeader.ChunkSize := Len; + Write(ChunkHeader, SizeOf(ChunkHeader)); Write(PWideChar(S)^, Len); end; end; @@ -34125,7 +1654,7 @@ procedure TCustomVirtualStringTree.WriteText(Writer: TWriter); //---------------------------------------------------------------------------------------------------------------------- function TCustomVirtualStringTree.ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - S: string): Integer; + S: string): TDimension; // Default node height calculation for multi line nodes. This method can be used by the application to delegate the // computation to the string tree. @@ -34172,7 +1701,7 @@ function TCustomVirtualStringTree.ComputeNodeHeight(Canvas: TCanvas; Node: PVirt GetOffsets(Node, lOffsets, TVTElement.ofsEndOfClientArea, Column); if Column > NoColumn then begin - PaintInfo.CellRect.Right := FHeader.Columns[Column].Width - 2 * FTextMargin; + PaintInfo.CellRect.Right := Header.Columns[Column].Width - 2 * TextMargin; PaintInfo.CellRect.Left := lOffsets[TVTElement.ofsLabel]; end else @@ -34212,7 +1741,7 @@ function TCustomVirtualStringTree.ContentToHTML(Source: TVSTTextSourceType; cons // Renders the current tree content (depending on Source) as HTML text encoded in UTF-8. // If Caption is not empty then it is used to create and fill the header for the table built here. -// Based on ideas and code from Frank van den Bergh and Andreas Hörstemeier. +// Based on ideas and code from Frank van den Bergh and Andreas Hörstemeier. begin Result := VirtualTrees.Export.ContentToHTML(Self, Source, Caption); @@ -34223,11 +1752,11 @@ function TCustomVirtualStringTree.ContentToHTML(Source: TVSTTextSourceType; cons function TCustomVirtualStringTree.CanExportNode(Node: PVirtualNode): Boolean; begin - case FOptions.ExportMode of + case TreeOptions.ExportMode of emChecked: - Result := GetCheckState(Node) = csCheckedNormal; + Result := CheckState[Node] = csCheckedNormal; emUnchecked: - Result := GetCheckState(Node) = csUncheckedNormal; + Result := CheckState[Node] = csUncheckedNormal; emVisibleDueToExpansion: //Do not export nodes that are not visible because their parent is not expanded Result := not Assigned(Node.Parent) or Self.Expanded[Node.Parent]; emSelected: // export selected nodes only @@ -34239,29 +1768,6 @@ function TCustomVirtualStringTree.CanExportNode(Node: PVirtualNode): Boolean; //---------------------------------------------------------------------------------------------------------------------- -procedure TCustomVirtualStringTree.AddToSelection(Node: PVirtualNode; NotifySynced: Boolean); -var - lSelectedNodeCaption: string; -begin - inherited; - if (toRestoreSelection in TreeOptions.SelectionOptions) and Assigned(Self.OnGetText) and Self.Selected[Node] and not (tsPreviouslySelectedLocked in FStates) then - begin - if not Assigned(FPreviouslySelected) then - begin - FPreviouslySelected := TStringList.Create(); - FPreviouslySelected.Duplicates := dupIgnore; - FPreviouslySelected.Sorted := True; //Improves performance, required to use Find() - FPreviouslySelected.CaseSensitive := False; - end; - if Self.SelectedCount = 1 then - FPreviouslySelected.Clear(); - Self.OnGetText(Self, Node, 0, ttNormal, lSelectedNodeCaption); - FPreviouslySelected.Add(lSelectedNodeCaption); - end;//if -end; - -//---------------------------------------------------------------------------------------------------------------------- - procedure TCustomVirtualStringTree.RemoveFromSelection(Node: PVirtualNode); var lSelectedNodeCaption: string; @@ -34274,7 +1780,7 @@ procedure TCustomVirtualStringTree.RemoveFromSelection(Node: PVirtualNode); FPreviouslySelected.Clear() else begin - Self.OnGetText(Self, Node, 0, ttNormal, lSelectedNodeCaption); + Self.OnGetText(Self, Node, Header.RestoreSelectionColumnIndex, ttNormal, lSelectedNodeCaption); if FPreviouslySelected.Find(lSelectedNodeCaption, lIndex) then FPreviouslySelected.Delete(lIndex); end;//else @@ -34286,7 +1792,7 @@ procedure TCustomVirtualStringTree.RemoveFromSelection(Node: PVirtualNode); function TCustomVirtualStringTree.ContentToRTF(Source: TVSTTextSourceType): RawByteString; // Renders the current tree content (depending on Source) as RTF (rich text). -// Based on ideas and code from Frank van den Bergh and Andreas Hörstemeier. +// Based on ideas and code from Frank van den Bergh and Andreas Hörstemeier. begin Result := VirtualTrees.Export.ContentToRTF(Self, Source); @@ -34339,14 +1845,14 @@ procedure TCustomVirtualStringTree.GetTextInfo(Node: PVirtualNode; Column: TColu // bounding rectangle around Text. var - NewHeight: Integer; + NewHeight: TDimension; TM: TTextMetric; begin // Get default font and initialize the other parameters. inherited GetTextInfo(Node, Column, AFont, R, Text); - Canvas.Font := AFont; + Canvas.Font.Assign(AFont); FFontChanged := False; RedirectFontChangeEvent(Canvas); @@ -34354,7 +1860,7 @@ procedure TCustomVirtualStringTree.GetTextInfo(Node: PVirtualNode; Column: TColu if FFontChanged then begin AFont.Assign(Canvas.Font); - GetTextMetrics(Canvas.Handle, TM); + GetTextMetrics(Canvas, TM); NewHeight := TM.tmHeight; end else // Otherwise the correct font is already there and we only need to set the correct height. @@ -34366,7 +1872,7 @@ procedure TCustomVirtualStringTree.GetTextInfo(Node: PVirtualNode; Column: TColu R := GetDisplayRect(Node, Column, True, not (vsMultiline in Node.States)); if toShowHorzGridLines in TreeOptions.PaintOptions then Dec(R.Bottom); - InflateRect(R, 0, -(R.Bottom - R.Top - NewHeight) div 2); + InflateRect(R, 0, -Divide(R.Bottom - R.Top - NewHeight, 2)); end; //---------------------------------------------------------------------------------------------------------------------- @@ -34397,12 +1903,12 @@ function TCustomVirtualStringTree.Path(Node: PVirtualNode; Column: TColumnIndex; // given delimiter. begin - if (Node = nil) or (Node = FRoot) then + if (Node = nil) or (Node = RootNode) then Result := Delimiter else begin Result := ''; - while Node <> FRoot do + while Node <> RootNode do begin Result := Text[Node, Column] + Delimiter + Result; Node := Node.Parent; @@ -34420,7 +1926,7 @@ procedure TCustomVirtualStringTree.ResetInternalData(Node: PVirtualNode; Recursi begin // Reset node width so changed text attributes are applied correctly. - if Assigned(Node) and (Node <> FRoot) then + if Assigned(Node) and (Node <> RootNode) then begin Data := InternalData(Node); if Assigned(Data) then @@ -34432,7 +1938,7 @@ procedure TCustomVirtualStringTree.ResetInternalData(Node: PVirtualNode; Recursi if Assigned(Node) then Run := Node.FirstChild else - Run := FRoot.FirstChild; + Run := RootNode.FirstChild; while Assigned(Run) do begin @@ -34444,7 +1950,7 @@ procedure TCustomVirtualStringTree.ResetInternalData(Node: PVirtualNode; Recursi //---------------------------------------------------------------------------------------------------------------------- -procedure TCustomVirtualStringTree.ReinitNode(Node: PVirtualNode; Recursive: Boolean); +procedure TCustomVirtualStringTree.ReinitNode(Node: PVirtualNode; Recursive: Boolean; ForceReinit: Boolean = False); begin inherited; @@ -34467,7 +1973,7 @@ procedure TCustomVirtualStringTree.SetChildCount(Node: PVirtualNode; NewChildCou function TVirtualStringTree.GetOptions: TStringTreeOptions; begin - Result := FOptions as TStringTreeOptions; + Result := inherited TreeOptions as TStringTreeOptions; end; //---------------------------------------------------------------------------------------------------------------------- @@ -34475,7 +1981,7 @@ function TVirtualStringTree.GetOptions: TStringTreeOptions; procedure TVirtualStringTree.SetOptions(const Value: TStringTreeOptions); begin - FOptions.Assign(Value); + inherited TreeOptions.Assign(Value); end; //---------------------------------------------------------------------------------------------------------------------- @@ -34486,149 +1992,10 @@ function TVirtualStringTree.GetOptionsClass: TTreeOptionsClass; Result := TStringTreeOptions; end; -//---------------------------------------------------------------------------------------------------------------------- - -function TCustomVirtualDrawTree.DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex; - CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; - -begin - Result := Point(0, 0); - if Canvas = nil then - Canvas := Self.Canvas; - - if Assigned(FOnGetCellContentMargin) then - FOnGetCellContentMargin(Self, Canvas, Node, Column, CellContentMarginType, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TCustomVirtualDrawTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; - -begin - Result := 2 * FTextMargin; - if Canvas = nil then - Canvas := Self.Canvas; - - if Assigned(FOnGetNodeWidth) then - FOnGetNodeWidth(Self, Canvas, Node, Column, Result); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TCustomVirtualDrawTree.DoPaintNode(var PaintInfo: TVTPaintInfo); - -begin - if Assigned(FOnDrawNode) then - FOnDrawNode(Self, PaintInfo); -end; - -function TCustomVirtualDrawTree.GetDefaultHintKind: TVTHintKind; - -begin - Result := vhkOwnerDraw; -end; - -//----------------- TVirtualDrawTree ----------------------------------------------------------------------------------- - -function TVirtualDrawTree.GetOptions: TVirtualTreeOptions; - -begin - Result := FOptions as TVirtualTreeOptions; -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TVirtualDrawTree.SetOptions(const Value: TVirtualTreeOptions); - -begin - FOptions.Assign(Value); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -function TVirtualDrawTree.GetOptionsClass: TTreeOptionsClass; - -begin - Result := TVirtualTreeOptions; -end; - +{ TVSTGetCellTextEventArgs } //---------------------------------------------------------------------------------------------------------------------- -{ PVirtualNodeHelper } - -function TVirtualNode.GetData(): Pointer; - -// Returns the associated data converted to the class given in the generic part of the function. - -begin - Result := @Self.Data; - Include(States, vsOnFreeNodeCallRequired); -end; - -function TVirtualNode.GetData: T; - -// Returns the associated data converted to the class given in the generic part of the function. - -begin - Result := T(Pointer((PByte(@(Self.Data))))^); - Include(States, vsOnFreeNodeCallRequired); -end; - -function TVirtualNode.IsAssigned: Boolean; - -// Returns False if this node is nil, True otherwise - -begin - Exit(@Self <> nil); -end; - -procedure TVirtualNode.SetData(pUserData: Pointer); - - - // Can be used to set user data of a PVirtualNode with the size of a pointer, useful for setting - // A pointer to a record or a reference to a class instance. -var - NodeData: PPointer; -begin - NodeData := PPointer(@Self.Data); - NodeData^ := pUserData; - Include(Self.States, vsOnFreeNodeCallRequired); -end; - -procedure TVirtualNode.SetData(const pUserData: IInterface); - - - // Can be used to set user data of a PVirtualNode to a class instance, - // will take care about reference counting. - -begin - pUserData._AddRef(); - SetData(Pointer(pUserData)); - Include(Self.States, vsReleaseCallOnUserDataRequired); -end; - -procedure TVirtualNode.SetData(pUserData: T); - -begin - T(Pointer((PByte(@(Self.Data))))^) := pUserData; - if PTypeInfo(TypeInfo(T)).Kind = tkInterface then - Include(Self.States, vsReleaseCallOnUserDataRequired); - Include(Self.States, vsOnFreeNodeCallRequired); -end; - -{ TVTImageInfo } - -function TVTImageInfo.Equals(const pImageInfo2: TVTImageInfo): Boolean; - - // Returns true if both images are the same, does not regard Ghosted and position. - -begin - Result := (Self.Index = pImageInfo2.Index) and (Self.Images = pImageInfo2.Images); -end; - -{ TVSTGetCellTextEventArgs } - constructor TVSTGetCellTextEventArgs.Create(pNode: PVirtualNode; pColumn: TColumnIndex; pExportType: TVTExportType); begin Self.Node := pNode; @@ -34636,115 +2003,10 @@ constructor TVSTGetCellTextEventArgs.Create(pNode: PVirtualNode; pColumn: TColum Self.ExportType := pExportType; end; -{ TCheckStateHelper } - -function TCheckStateHelper.IsDisabled: Boolean; -begin - Result := Self >= TCheckState.csUncheckedDisabled; -end; - -function TCheckStateHelper.IsChecked: Boolean; -begin - Result := Self in [csCheckedNormal, csCheckedPressed, csCheckedDisabled]; -end; - -function TCheckStateHelper.IsUnChecked: Boolean; -begin - Result := Self in [csUnCheckedNormal, csUnCheckedPressed, csUnCheckedDisabled]; -end; - -function TCheckStateHelper.IsMixed: Boolean; -begin - Result := Self in [csMixedNormal, csMixedPressed, csMixedDisabled]; -end; - -function TCheckStateHelper.GetEnabled: TCheckState; -begin - Result := cEnabledState[Self]; -end; - -function TCheckStateHelper.GetPressed(): TCheckState; -begin - Result := cPressedState[Self]; -end; - -function TCheckStateHelper.GetUnpressed(): TCheckState; -begin - Result := cUnpressedState[Self]; -end; - -function TCheckStateHelper.GetToggled(): TCheckState; -begin - Result := cToggledState[Self]; -end; - -{ TSortDirectionHelper } - -function TSortDirectionHelper.ToInt(): Integer; -begin - Result := cSortDirectionToInt[Self]; -end; - - -{ TVTPaintInfo } - -procedure TVTPaintInfo.AdjustImageCoordinates(); -// During painting of the main column some coordinates must be adjusted due to the tree lines. -begin - ContentRect := CellRect; - if BidiMode = bdLeftToRight then - begin - ContentRect.Left := CellRect.Left + Offsets[TVTElement.ofsLabel]; - ImageInfo[iiNormal].XPos := CellRect.Left + Offsets[TVTElement.ofsImage]; - ImageInfo[iiState].XPos := CellRect.Left + Offsets[TVTElement.ofsStateImage]; - ImageInfo[iiCheck].XPos := CellRect.Left + Offsets[TVTElement.ofsCheckBox]; - end - else - begin - /// Since images are still drawn from left to right, we need to substract the image sze as well. - ImageInfo[iiNormal].XPos := CellRect.Right - Offsets[TVTElement.ofsImage] - (Offsets[TVTElement.ofsLabel] - Offsets[TVTElement.ofsImage]); - ImageInfo[iiState].XPos := CellRect.Right - Offsets[TVTElement.ofsStateImage] - (Offsets[TVTElement.ofsImage] - Offsets[TVTElement.ofsStateImage]); - ImageInfo[iiCheck].XPos := CellRect.Right - Offsets[TVTElement.ofsCheckBox] - (Offsets[TVTElement.ofsStateImage] - Offsets[TVTElement.ofsCheckBox]); - ContentRect.Right := CellRect.Right - Offsets[TVTElement.ofsLabel]; - end; - if ImageInfo[iiNormal].Index > -1 then - ImageInfo[iiNormal].YPos := CellRect.Top + VAlign - ImageInfo[iiNormal].Images.Height div 2; - if ImageInfo[iiState].Index > -1 then - ImageInfo[iiState].YPos := CellRect.Top + VAlign - ImageInfo[iiState].Images.Height div 2; - if ImageInfo[iiCheck].Index > -1 then - ImageInfo[iiCheck].YPos := CellRect.Top + VAlign - ImageInfo[iiCheck].Images.Height div 2; -end; - -{ THeaderPaintInfo } - -procedure THeaderPaintInfo.DrawDropMark(); -var - Y: Integer; - lArrowWidth: Integer; -begin - lArrowWidth := Self.Column.Owner.Header.Treeview.ScaledPixels(5); - Y := (PaintRectangle.Top + PaintRectangle.Bottom - 3 * lArrowWidth) div 2; - if DropMark = dmmLeft then - DrawArrow(TargetCanvas, TScrollDirection.sdLeft, Point(PaintRectangle.Left, Y), lArrowWidth) - else - DrawArrow(TargetCanvas, TScrollDirection.sdRight, Point(PaintRectangle.Right - lArrowWidth - (lArrowWidth div 2) {spacing}, Y), lArrowWidth); -end; - -procedure THeaderPaintInfo.DrawSortArrow(pDirection: TSortDirection); -const - cDirection: array[TSortDirection] of TScrollDirection = (TScrollDirection.sdUp, TScrollDirection.sdDown); -var - lOldColor: TColor; -begin - lOldColor := TargetCanvas.Pen.Color; - TargetCanvas.Pen.Color := clDkGray; - DrawArrow(TargetCanvas, cDirection[pDirection], Point(SortGlyphPos.X, SortGlyphPos.Y), SortGlyphSize.cy); - TargetCanvas.Pen.Color := lOldColor; -end; - initialization + TCustomStyleEngine.RegisterStyleHook(TVirtualStringTree, TVclStyleScrollBarsHook); finalization - FinalizeGlobalStructures(); + TCustomStyleEngine.UnRegisterStyleHook(TVirtualStringTree, TVclStyleScrollBarsHook); end. diff --git a/Source/VirtualTrees.res b/Source/VirtualTrees.res deleted file mode 100644 index deb671eba..000000000 Binary files a/Source/VirtualTrees.res and /dev/null differ diff --git a/Tests/Tests.dpr b/Tests/Tests.dpr index 903b72772..46c91cd06 100644 --- a/Tests/Tests.dpr +++ b/Tests/Tests.dpr @@ -4,7 +4,7 @@ program Tests; {$APPTYPE CONSOLE} {$ENDIF}{$STRONGLINKTYPES ON} uses - SysUtils, + System.SysUtils, {$IFDEF TESTINSIGHT} TestInsight.DUnitX, {$ENDIF } @@ -12,7 +12,14 @@ uses DUnitX.Loggers.Xml.NUnit, DUnitX.TestFramework, VirtualTreeTests in 'VirtualTreeTests.pas', - VirtualStringTreeTests in 'VirtualStringTreeTests.pas'; + VirtualStringTreeTests in 'VirtualStringTreeTests.pas', + VTWorkerThreadIssue1001Tests in 'VTWorkerThreadIssue1001Tests.pas', + VTOnEditCancelledTests in 'VTOnEditCancelledTests.pas', + VTOnDrawTextTests in 'VTOnDrawTextTests.pas', + VTCellSelectionTests in 'VTCellSelectionTests.pas', + VirtualTrees.MouseUtils in 'VirtualTrees.MouseUtils.pas', + VTCellSelectionTests.VisibilityForm in 'VTCellSelectionTests.VisibilityForm.pas' {VisibilityForm}, + VTCellSelectionTests.VTSelectionTestForm in 'VTCellSelectionTests.VTSelectionTestForm.pas' {SelectionTestForm}; var runner : ITestRunner; @@ -25,6 +32,7 @@ begin exit; {$ENDIF} try + TDUnitX.Options.ExitBehavior := TDUnitXExitBehavior.Pause; //Check command line options, will exit if invalid TDUnitX.CheckCommandLine; //Create the test runner diff --git a/Tests/Tests.dproj b/Tests/Tests.dproj index 8bab5281a..8d1ccaf83 100644 --- a/Tests/Tests.dproj +++ b/Tests/Tests.dproj @@ -1,14 +1,15 @@  - {D37CFA56-3B13-4C93-91F7-DDC227C20116} - 17.2 - Tests.dpr True + Console Debug + VCL + Tests.dpr Win32 - 1 - Console - None + {D37CFA56-3B13-4C93-91F7-DDC227C20116} + 20.3 + 3 + Tests true @@ -34,54 +35,66 @@ true true + + true + Cfg_1 + true + true + true Base true - $(BDS)\bin\delphi_PROJECTICNS.icns - System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + Tests + DCU\$(Platform)\$(Config) + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) $(DUnitX);..\Source;$(DCC_UnitSearchPath) - 1031 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + $(BDS)\bin\delphi_PROJECTICNS.icns + $(BDS)\bin\delphi_PROJECTICON.ico $(BDS)\bin\default_app.manifest - Tests - false - false - false - false - false + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 1031 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - 1033 FireDACTDataDriver;FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;FireDACPgDriver;fmx;IndySystem;TeeDB;tethering;DBXInterBaseDriver;DataSnapClient;DataSnapServer;DataSnapCommon;DataSnapProviderClient;DBXSybaseASEDriver;frxe22;DbxCommonDriver;vclimg;DUnitXRuntime;dbxcds;DatasnapConnectorsFreePascal;appanalytics;vcldb;vcldsnap;fmxFireDAC;UIRibbonPackage;DBXDb2Driver;DBXOracleDriver;CustomIPTransport;vclribbon;dsnap;IndyIPServer;fmxase;vcl;IndyCore;DBXMSSQLDriver;IndyIPCommon;CloudService;FmxTeeUI;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;adortl;madBasic_;FireDACASADriver;frx22;bindcompfmx;FireDACODBCDriver;RESTBackendComponents;emsclientfiredac;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;inetdb;Tee;DBXOdbcDriver;vclFireDAC;madDisAsm_;xmlrtl;DataSnapNativeClient;svnui;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindengine;vclactnband;bindcompdbx;soaprtl;FMXTee;TeeUI;bindcompvcl;vclie;frxDB22;FireDACADSDriver;vcltouch;madExcept_;emsclient;VCLRESTComponents;FireDACMSSQLDriver;FireDAC;VclSmp;DBXInformixDriver;DataSnapConnectors;DataSnapServerMidas;dsnapcon;DBXFirebirdDriver;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;svn;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;VirtualTreesR;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage) + 1033 + Debug + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) FireDACTDataDriver;FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;FireDACPgDriver;fmx;IndySystem;TeeDB;tethering;DBXInterBaseDriver;DataSnapClient;DataSnapServer;DataSnapCommon;DataSnapProviderClient;DBXSybaseASEDriver;DbxCommonDriver;vclimg;dbxcds;DatasnapConnectorsFreePascal;appanalytics;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;CustomIPTransport;vclribbon;dsnap;IndyIPServer;fmxase;vcl;IndyCore;DBXMSSQLDriver;IndyIPCommon;CloudService;FmxTeeUI;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;adortl;FireDACASADriver;bindcompfmx;FireDACODBCDriver;RESTBackendComponents;emsclientfiredac;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;inetdb;Tee;DBXOdbcDriver;vclFireDAC;xmlrtl;DataSnapNativeClient;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindengine;vclactnband;bindcompdbx;soaprtl;FMXTee;TeeUI;bindcompvcl;vclie;FireDACADSDriver;vcltouch;emsclient;VCLRESTComponents;FireDACMSSQLDriver;FireDAC;VclSmp;DBXInformixDriver;DataSnapConnectors;DataSnapServerMidas;dsnapcon;DBXFirebirdDriver;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;VirtualTreesR;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage) + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 - true - true - false - off - DEBUG;$(DCC_Define) true - true true + DEBUG;$(DCC_Define) + true + off + true + false + true true - 1033 - None + madExcept;$(DCC_Define) + 3 false + 1033 + none + + + 3 - false + 0 RELEASE;$(DCC_Define) + false 0 - 0 @@ -89,10 +102,19 @@ - - Cfg_2 - Base - + + + + + + +
VisibilityForm
+ dfm + + +
SelectionTestForm
+ dfm + Base @@ -100,6 +122,10 @@ Cfg_1 Base + + Cfg_2 + Base + Delphi.Personality.12 @@ -110,358 +136,14 @@ Tests.dpr - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - Embarcadero C++Builder Office 2000 Servers Package - Embarcadero C++Builder Office XP Servers Package + (untitled) + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components - - - - Tests.exe - true - - - - - true - - - - - true - - - - - 1 - .dylib - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - - - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - - - 1 - - - 1 - - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - res\drawable-normal - 1 - - - - - library\lib\x86 - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-xhdpi - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - library\lib\mips - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 0 - - - - - 1 - .framework - - - 0 - - - - - res\drawable-small - 1 - - - - - - 1 - - - Contents\MacOS - 0 - - - - - classes - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable - 1 - - - - - Contents\Resources - 1 - - - - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi-v7a - 1 - - - 1 - - - 0 - - - 1 - - - 1 - - - 1 - - - - - library\lib\armeabi - 1 - - - - - res\drawable-large - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-ldpi - 1 - - - - - res\values - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - - - 1 - - - - - - - - - - True - False + True 12 diff --git a/Tests/VTCellSelectionTests.VTSelectionTestForm.dfm b/Tests/VTCellSelectionTests.VTSelectionTestForm.dfm new file mode 100644 index 000000000..64621d640 --- /dev/null +++ b/Tests/VTCellSelectionTests.VTSelectionTestForm.dfm @@ -0,0 +1,73 @@ +object SelectionTestForm: TSelectionTestForm + Left = 0 + Top = 0 + Caption = 'SelectionTestForm' + ClientHeight = 843 + ClientWidth = 1424 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -27 + Font.Name = 'Segoe UI' + Font.Style = [] + OnShow = FormShow + PixelsPerInch = 216 + TextHeight = 37 + object VSTA: TVirtualStringTree + Left = 0 + Top = 0 + Width = 1424 + Height = 843 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Align = alClient + ClipboardFormats.Strings = ( + 'Plain text' + 'Virtual Tree Data') + DefaultNodeHeight = 46 + Header.AutoSizeIndex = 0 + Header.Height = 41 + Header.MaxHeight = 22500 + Header.MinHeight = 23 + Header.Options = [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible] + Indent = 41 + Margin = 9 + TabOrder = 0 + TextMargin = 9 + TreeOptions.SelectionOptions = [toMultiSelect, toSelectNextNodeOnRemoval] + OnChange = VSTAChange + OnClick = VSTAClick + OnDragAllowed = VSTADragAllowed + OnDragOver = VSTADragOver + OnDragDrop = VSTADragDrop + OnFreeNode = VSTAFreeNode + OnGetText = VSTAGetText + Touch.InteractiveGestures = [igPan, igPressAndTap] + Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough] + Columns = < + item + MaxWidth = 11250 + MinWidth = 72 + Position = 0 + Text = 'Name' + Width = 563 + end + item + MaxWidth = 11250 + MinWidth = 72 + Position = 1 + Text = 'Desp' + Width = 150 + end + item + MaxWidth = 11250 + MinWidth = 72 + Position = 2 + Text = 'Location' + Width = 135 + end> + DefaultText = '' + end +end diff --git a/Tests/VTCellSelectionTests.VTSelectionTestForm.pas b/Tests/VTCellSelectionTests.VTSelectionTestForm.pas new file mode 100644 index 000000000..8607e636c --- /dev/null +++ b/Tests/VTCellSelectionTests.VTSelectionTestForm.pas @@ -0,0 +1,181 @@ +unit VTCellSelectionTests.VTSelectionTestForm; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees.BaseAncestorVCL, + VirtualTrees.BaseTree, VirtualTrees.AncestorVCL, VirtualTrees, + VirtualTrees.Types, VirtualTrees.ClipBoard, ActiveX, Vcl.ExtCtrls; + +type + + TDataRec = record + Name: String; + Desp: String; + Loc: String; + end; + PDataRec = ^TDataRec; + + TSelectionTestForm = class(TForm) + VSTA: TVirtualStringTree; + procedure VSTAGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + procedure VSTADragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; var Allowed: Boolean); + procedure VSTADragDrop(Sender: TBaseVirtualTree; Source: TObject; + DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; + Pt: TPoint; var Effect: Integer; Mode: TDropMode); + procedure VSTADragOver(Sender: TBaseVirtualTree; Source: TObject; + Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; + var Effect: Integer; var Accept: Boolean); + procedure VSTAFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure FormShow(Sender: TObject); + procedure VSTAChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure VSTAClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + SelectionTestForm: TSelectionTestForm; + +implementation + +{$R *.dfm} + +procedure TSelectionTestForm.FormShow(Sender: TObject); +var + Data: PDataRec; + PNode: PVirtualNode; +begin + VSTA.BeginUpdate; + New(Data); + FillChar(Data^, SizeOf(TDataRec), 0); + Data.Name := 'Name-0'; + Data.Desp := 'Desp-0'; + Data.Loc := 'Loc-0'; + PNode := VSTA.AddChild(nil, Data); + + New(Data); + FillChar(Data^, SizeOf(TDataRec), 0); + Data.Name := 'Name-1'; + Data.Desp := 'Desp-1'; + Data.Loc := 'Loc-1'; + VSTA.AddChild(PNode, Data); + + New(Data); + FillChar(Data^, SizeOf(TDataRec), 0); + Data.Name := 'Name-2'; + Data.Desp := 'Desp-2'; + Data.Loc := 'Loc-2'; + VSTA.AddChild(PNode, Data); + VSTA.Expanded[PNode] := True; + + New(Data); + FillChar(Data^, SizeOf(TDataRec), 0); + Data.Name := 'Name-3'; + Data.Desp := 'Desp-3'; + Data.Loc := 'Loc-3'; + VSTA.AddChild(nil, Data); + VSTA.EndUpdate; +end; + +procedure TSelectionTestForm.VSTAChange(Sender: TBaseVirtualTree; Node: PVirtualNode); +begin + Beep; +end; + +procedure TSelectionTestForm.VSTAClick(Sender: TObject); +begin +// Beep; +end; + +procedure TSelectionTestForm.VSTADragAllowed(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); +begin + Allowed := true; +end; + +procedure TSelectionTestForm.VSTADragDrop(Sender: TBaseVirtualTree; Source: TObject; + DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; + Pt: TPoint; var Effect: Integer; Mode: TDropMode); +var + I: Integer; + AttachMode: TVTNodeAttachMode; + +begin + if Length(Formats) > 0 then + begin + // OLE drag'n drop + // If the native tree format is listed then use this and accept the drop, otherwise recject (ignore) it. + // It is recommend by Microsoft to order available clipboard formats in decreasing detail richness so + // the first best format which we can accept is usually the best format we can get at all. + for I := 0 to High(Formats) do + if Formats[I] = CF_VIRTUALTREE then + begin + case Mode of + dmAbove: + AttachMode := amInsertBefore; + dmOnNode: + AttachMode := amAddChildLast; + dmBelow: + AttachMode := amInsertAfter; + else + if Assigned(Source) and (Source is TBaseVirtualTree) and (Sender <> Source) then + AttachMode := amInsertBefore + else + AttachMode := amNowhere; + end; + // in the case the drop target does an optimized move Effect is set to DROPEFFECT_NONE + // to indicate this also to the drag source (so the source doesn't need to take any further action) + Sender.ProcessDrop(DataObject, Sender.DropTargetNode, Effect, AttachMode); + Sender.Expanded[Sender.DropTargetNode] := True; + Break; + end; + end + else + begin + // VCL drag'n drop, Effects contains by default both move and copy effect suggestion, + // as usual the application has to find out what operation is finally to do + Beep; + end; +end; + +procedure TSelectionTestForm.VSTADragOver(Sender: TBaseVirtualTree; Source: TObject; + Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; + var Effect: Integer; var Accept: Boolean); +begin + Accept := true; +// Accept := (Source = Sender); +end; + +procedure TSelectionTestForm.VSTAFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); +var + Data: PDataRec; +begin + Data := PPointer(Sender.GetNodeData(Node))^; + Dispose(Data); +end; + +procedure TSelectionTestForm.VSTAGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); +var + Data: PDataRec; +begin + Data := PPointer(Sender.GetNodeData(Node))^; + if TextType = ttNormal then begin + case Column of + -1, + 0: CellText := Data.Name; + 1: CellText := Data.Desp; + 2: CellText := Data.Loc; + else + CellText := ''; + end; + end; +end; + +end. diff --git a/Tests/VTCellSelectionTests.VisibilityForm.dfm b/Tests/VTCellSelectionTests.VisibilityForm.dfm new file mode 100644 index 000000000..1ba50d1f3 --- /dev/null +++ b/Tests/VTCellSelectionTests.VisibilityForm.dfm @@ -0,0 +1,76 @@ +object VisibilityForm: TVisibilityForm + Left = 5 + Top = 5 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Anchors = [akLeft, akTop, akRight, akBottom] + Caption = 'VisibilityForm' + ClientHeight = 641 + ClientWidth = 1046 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -27 + Font.Name = 'Segoe UI' + Font.Style = [] + OnCreate = FormCreate + PixelsPerInch = 216 + DesignSize = ( + 1046 + 641) + TextHeight = 37 + object VST1: TVirtualStringTree + Left = 4 + Top = 12 + Width = 951 + Height = 538 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Anchors = [akLeft, akTop, akRight, akBottom] + Colors.BorderColor = clWindowText + Colors.HotColor = clBlack + DefaultNodeHeight = 46 + Header.AutoSizeIndex = 0 + Header.Height = 37 + Header.MainColumn = -1 + Header.MaxHeight = 22500 + Header.MinHeight = 23 + Header.Options = [hoColumnResize, hoDrag] + HintMode = hmTooltip + IncrementalSearch = isAll + Indent = 41 + Margin = 9 + ParentShowHint = False + ShowHint = True + TabOrder = 0 + TextMargin = 9 + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoHideButtons, toAutoChangeScale] + TreeOptions.SelectionOptions = [toMultiSelect] + OnChange = VST1Change + OnFreeNode = VST1FreeNode + OnGetText = VST1GetText + OnInitChildren = VST1InitChildren + OnInitNode = VST1InitNode + Touch.InteractiveGestures = [igPan, igPressAndTap] + Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough] + Columns = <> + DefaultText = '' + end + object btnCheck: TButton + Left = 786 + Top = 573 + Width = 169 + Height = 56 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Caption = 'btnCheck' + TabOrder = 1 + OnClick = btnCheckClick + end +end diff --git a/Tests/VTCellSelectionTests.VisibilityForm.pas b/Tests/VTCellSelectionTests.VisibilityForm.pas new file mode 100644 index 000000000..e24b44bae --- /dev/null +++ b/Tests/VTCellSelectionTests.VisibilityForm.pas @@ -0,0 +1,224 @@ +unit VTCellSelectionTests.VisibilityForm; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees.BaseAncestorVCL, + VirtualTrees.BaseTree, VirtualTrees.AncestorVCL, VirtualTrees, Vcl.StdCtrls; + +type + TVisibilityForm = class(TForm) + VST1: TVirtualStringTree; + btnCheck: TButton; + procedure btnCheckClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure VST1Change(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure VST1FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + TColumnIndex; TextType: TVSTTextType; var CellText: string); + procedure VST1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var + ChildCount: Cardinal); + procedure VST1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: + PVirtualNode; var InitialStates: TVirtualNodeInitStates); + private + type + TVTChangeEventProc = reference to procedure(Sender: TBaseVirtualTree; Node: PVirtualNode); + var + FChangeEventProc: TVTChangeEventProc; + { Private declarations } + procedure AssignChange( + const AChangeEventProc: TVTChangeEventProc; + const ATree: TBaseVirtualTree = nil); + procedure DoChangeEvent(Sender: TBaseVirtualTree; Node: PVirtualNode); + public + { Public declarations } + procedure HideNodes(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean); + procedure TestEmptyAreaOnChange2; + end; + +var + VisibilityForm: TVisibilityForm; + +implementation + +uses + VirtualTrees.Types, VirtualTrees.MouseUtils; + +{$R *.dfm} + +type + PLinkData = ^TLinkData; + TLinkData = record + Caption: string; + OtherNode: PVirtualNode; + end; + + Assert = class + class procedure IsTrue(ACondition: Boolean; const AMsg: string = ''); static; + end; + +class procedure Assert.IsTrue(ACondition: Boolean; const AMsg: string = ''); +begin + System.Assert(ACondition, AMsg); +end; + +procedure TVisibilityForm.AssignChange( + const AChangeEventProc: TVTChangeEventProc; + const ATree: TBaseVirtualTree = nil); +var + FTree: TVirtualStringTree; +begin + FTree := VST1; + FChangeEventProc := AChangeEventProc; + if not Assigned(ATree) then + FTree.OnChange := DoChangeEvent else + TVirtualStringTree(ATree).OnChange := DoChangeEvent; +end; + +procedure TVisibilityForm.btnCheckClick(Sender: TObject); +begin + TestEmptyAreaOnChange2; +end; + +procedure TVisibilityForm.DoChangeEvent(Sender: TBaseVirtualTree; Node: PVirtualNode); +begin + if Assigned(FChangeEventProc) then + FChangeEventProc(Sender, Node); +end; + +procedure TVisibilityForm.FormCreate(Sender: TObject); +begin + VST1.RootNodeCount := 5; +end; + +procedure TVisibilityForm.HideNodes(Sender: TBaseVirtualTree; + Node: PVirtualNode; Data: Pointer; var Abort: Boolean); +begin + case Integer(Data) of + 0: // show all nodes + Sender.IsVisible[Node] := True; + 1: // hide every second + Sender.IsVisible[Node] := not Odd(Node.Index); + 2: // hide nodes with child nodes only + Sender.IsVisible[Node] := not Sender.HasChildren[Node]; + 3: // hide all + Sender.IsVisible[Node] := False; + end; +end; + +procedure TVisibilityForm.VST1FreeNode(Sender: TBaseVirtualTree; Node: + PVirtualNode); +var + Data: PLinkData; +begin + Data := Sender.GetNodeData(Node); + Finalize(Data^); +end; + +procedure TVisibilityForm.VST1GetText(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: + string); +begin + CellText := Format('Node Level %d, Index %d', [Sender.GetNodeLevel(Node), Node.Index]); +end; + +procedure TVisibilityForm.VST1InitChildren(Sender: TBaseVirtualTree; Node: + PVirtualNode; var ChildCount: Cardinal); +begin + ChildCount := Random(5) + 1; +end; + +procedure TVisibilityForm.VST1InitNode(Sender: TBaseVirtualTree; ParentNode, + Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); +var + Level: Integer; +begin + Level := Sender.GetNodeLevel(Node); + if Level < 4 then + Include(InitialStates, ivsHasChildren); + if Level > 0 then + Node.CheckType := TCheckType(Level) + else + Node.CheckType := ctTriStateCheckBox; +end; + +procedure TVisibilityForm.TestEmptyAreaOnChange2; +var + LTree: TVirtualStringTree; + n1: PVirtualNode; + LOnChangeFired: LongBool; + I, LColumnCount, LMaxWidth: Integer; + Rects: TArray; + LargestRect: TRect; + LTextOnly, LUnclipped, LApplyCellContentMargin: Boolean; + LastNode, LHitNode: PVirtualNode; + LEmptyArea: TPoint; + LHitInfo: THitInfo; + LTestForm: TVisibilityForm; +begin + LTestForm := Self; + + LTree := LTestForm.VST1; + + n1 := LTree.GetLastVisible; + + // Calculate the largest client area for the VirtualTree and set it + LColumnCount := LTree.Header.Columns.Count; + LMaxWidth := 0; + for I := 0 to LColumnCount-1 do + begin + if LTree.Header.Columns[I].Width > LMaxWidth then + LMaxWidth := LTree.Header.Columns[I].Width; + end; + if LMaxWidth = 0 then + LMaxWidth := 300; + I := 0; + LargestRect := TRect.Empty; + for LTextOnly := False to True do + for LUnclipped := False to True do + for LApplyCellContentMargin := False to True do + begin + SetLength(Rects, I+1); + Rects[I] := LTree.GetDisplayRect(n1, LColumnCount-1, LTextOnly, LUnclipped, LApplyCellContentMargin); + LargestRect := TRect.Union(LargestRect, Rects[I]); + Inc(I); + end; + + LastNode := LTree.GetLastVisibleChild(LTree.RootNode); + + LTree.ClientHeight := LargestRect.BottomRight.Y + (LastNode.NodeHeight * 2); + LTree.ClientWidth := LargestRect.BottomRight.X + LMaxWidth; + + // This should be an empty area, beyond any visible nodes + LEmptyArea := Point(LargestRect.BottomRight.X + LMaxWidth, LargestRect.BottomRight.Y + LastNode.NodeHeight); + + // At this point, there should be no nodes selected + Assert.IsTrue(LTree.SelectedCount = 0); + LTree.MouseClick(n1, NoColumn); + // At this point, a node should be selected + Assert.IsTrue(LTree.SelectedCount = 1); + + LOnChangeFired := False; + LHitNode := Pointer($FFFFFFFF); + AssignChange(procedure (Sender: TBaseVirtualTree; ANode: PVirtualNode) + begin + LOnChangeFired := True; + LHitNode := ANode; + end, LTree); + + LTree.GetHitTestInfoAt(LEmptyArea.X, LEmptyArea.Y, True, LHitInfo); + LTree.MouseClick(LEmptyArea); + + Assert.IsTrue(hiNowhere in LHitInfo.HitPositions, 'Mouse click is not in an unpopulated/empty area!'); + Assert.IsTrue(LOnChangeFired, 'OnChange event not fired!'); + Assert.IsTrue(LHitNode = nil, 'Node is not nil!'); +end; + +procedure TVisibilityForm.VST1Change(Sender: TBaseVirtualTree; Node: + PVirtualNode); +begin + OutputDebugString(PChar(Format('Node: %p', [Pointer(Node)]))); +end; + +end. diff --git a/Tests/VTCellSelectionTests.pas b/Tests/VTCellSelectionTests.pas new file mode 100644 index 000000000..9bad74d01 --- /dev/null +++ b/Tests/VTCellSelectionTests.pas @@ -0,0 +1,1389 @@ +unit VTCellSelectionTests; + +// Virtual Treeview cell selection tests +// Written by CheeWee Chua. + +interface + +uses + DUnitX.TestFramework, Vcl.Forms, VirtualTrees, System.Types, + Winapi.Messages, Winapi.Windows, Vcl.ComCtrls, VirtualTrees.Types; + +type + + [TestFixture] + TCellSelectionTests = class(TObject) + strict private + const MaxTries = 10; + type + TVTChangeEventProc = reference to procedure(Sender: TBaseVirtualTree; Node: PVirtualNode); + TVTChangeCellEventProc = reference to procedure(Sender: TBaseVirtualTree; const Cells: TVTCellArray); + var + FTree: TVirtualStringTree; + FForm: TForm; + FNode1, + FNode2, + FNode3, + FNode4, + FNode5, + FNode6, + FNode7, + FNode8: PVirtualNode; + FRichEdit: TRichEdit; + + FChangeEventProc: TVTChangeEventProc; + FChangeCellEventProc: TVTChangeCellEventProc; + + procedure AssignChange(const AChangeEventProc: TVTChangeEventProc; const ATree: TBaseVirtualTree = nil); overload; + procedure AssignChange(const AChangeCellEventProc: TVTChangeCellEventProc); overload; + procedure DoChangeEvent(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure DoChangeCellEvent(Sender: TBaseVirtualTree; const Cells: TVTCellArray); + procedure FreeNodeEvent(Sender: TBaseVirtualTree; Node: PVirtualNode); + private + FClipboardAllocated: LongBool; + FClipboardWindow: HWND; + procedure CompleteClipboardCopy; + procedure OpenClipboard; + procedure CloseClipboard; + procedure MainWndProc(var Message: TMessage); + procedure WndProc(var Message: TMessage); + procedure VirtualStringTree1GetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: string); + procedure EnableMultiCellSelection(const ATree: TBaseVirtualTree = nil); + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + [Test] + procedure TestChangeCellEvent; + + [Test] + procedure TestSelectSingleCell; + + [Test] + procedure TestShiftClickMultipleCells; + + [Test] + procedure TestClear; + + [Test] + procedure TestClearCellSelection; + + [Test] + procedure TestSelectMultipleCellsFailWithoutMultiSelect; + + [Test] + procedure TestSelectMultipleCellsFailWithoutExtendedFocus; + + [Test] + procedure TestSelectCellsRectangular; + + [Test] + procedure TestClickUnselectsSelectedCells; + + [Test] + procedure TestCopyHTML1; + + [Test] + procedure TestCopyHTML2; + + [Test] + procedure TestCopyPlainText1; + + [Test] + procedure TestCopyPlainText2; + + [Test] + procedure TestCopyRTF1; + + [Test] + procedure TestCopyRTF2; + + /// + /// This tests that OnChange is fired when a node is selected + /// + [Test] + procedure TestOnChange; + + /// + /// This tests that OnChange is fired when an empty area is clicked + /// + [Test] + procedure TestEmptyAreaOnChange1; + + /// + /// This tests that OnChange is fired when an empty area is clicked + /// + [Test] + procedure TestEmptyAreaOnChange2; + + /// + /// This tests that when left click is performed, node is selected + /// + [Test] + procedure TestLeftClickSelectsNode; + + /// + /// This tests that when left click is performed without multiselect, cell doesn't get selected + /// + [Test] + procedure TestLeftClickWithoutMultiSelectDoesNotSelectCell; + + /// + /// This tests that setting and removing various states clears cell selection + /// + [Test] + procedure TestRemovingSetsClearCellSelection; + + end; + +implementation + +uses + System.SysUtils, Vcl.Controls, + Vcl.Clipbrd, VirtualTrees.ClipBoard, + System.Classes, Winapi.ActiveX, Vcl.ClipboardHelper, VirtualTrees.MouseUtils, + VTCellSelectionTests.VisibilityForm, VTCellSelectionTests.VTSelectionTestForm; + +type + TRowData = record + col1: string; + col2: string; + col3: string; + col4: string; + col5: string; + public + constructor Create(const ACol1, ACol2, ACol3, ACol4, ACol5: string); + procedure Clear; + end; + +{ TRowData } + +procedure TRowData.Clear; +begin + System.Finalize(Self); +end; + +constructor TRowData.Create(const ACol1, ACol2, ACol3, ACol4, ACol5: string); +begin + col1 := ACol1; + col2 := ACol2; + col3 := ACol3; + col4 := ACol4; + col5 := ACol5; +end; + +const + col0 = 0; + col1 = 1; + col2 = 2; + col3 = 3; + col4 = 4; + col5 = 5; + // skip the 4th column + +{ TCellSelectionTests } + +procedure TCellSelectionTests.CloseClipboard; +begin + if FClipboardAllocated then + begin + DeallocateHWnd(FClipboardWindow); + FClipboardWindow := 0; + Application.Handle := 0; + FClipboardAllocated := False; + end; +end; + +// Hacks to make OLE clipboard and VCL clipboard compatible +// within DUnit test framework +procedure TCellSelectionTests.CompleteClipboardCopy; +var + LResult: HRESULT; + LErrorMsg: string; +begin + Application.ProcessMessages; + FTree.FlushClipboard; + LResult := Winapi.ActiveX.OleFlushClipboard; + if Failed(LResult) then + begin + LErrorMsg := SysErrorMessage(GetLastError); + end; + Application.ProcessMessages; +end; + +procedure TCellSelectionTests.OpenClipboard; +begin + if FClipboardWindow = 0 then + begin + FClipboardWindow := AllocateHWnd(MainWndProc); + Application.Handle := FClipboardWindow; + FClipboardAllocated := True; + end; +end; + +procedure TCellSelectionTests.MainWndProc(var Message: TMessage); +begin + try + WndProc(Message); + except + if Assigned(ApplicationHandleException) then + ApplicationHandleException(Self) + else + raise; + end; +end; + +procedure TCellSelectionTests.WndProc(var Message: TMessage); +begin + with Message do + Result := DefWindowProc(FClipboardWindow, Msg, wParam, lParam); +end; + +procedure TCellSelectionTests.VirtualStringTree1GetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: string); +var + LData: TRowData; +begin + if not Assigned(Node) then + Exit; + LData := Node.GetData; + case Column of + col0: begin + CellText := LData.col1; + end; + col1: begin + CellText := LData.col2; + end; + col2: begin + CellText := LData.col3; + end; + col3: begin + CellText := LData.col4; + end; + col4: begin + CellText := LData.col5; + end; + end; +end; + +procedure TCellSelectionTests.AssignChange( + const AChangeEventProc: TVTChangeEventProc; + const ATree: TBaseVirtualTree = nil); +begin + FChangeEventProc := AChangeEventProc; + if not Assigned(ATree) then + FTree.OnChange := DoChangeEvent else + TVirtualStringTree(ATree).OnChange := DoChangeEvent; +end; + +procedure TCellSelectionTests.AssignChange(const AChangeCellEventProc: TVTChangeCellEventProc); +begin + FChangeCellEventProc := AChangeCellEventProc; + FTree.OnChangeCell := DoChangeCellEvent; +end; + +procedure TCellSelectionTests.DoChangeEvent(Sender: TBaseVirtualTree; Node: PVirtualNode); +begin + if Assigned(FChangeEventProc) then + FChangeEventProc(Sender, Node); +end; + +procedure TCellSelectionTests.EnableMultiCellSelection(const ATree: TBaseVirtualTree); +var + LTree: TVirtualStringTree; +begin + if not Assigned(ATree) then + LTree := FTree else + LTree := TVirtualStringTree(ATree); + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions + + [toExtendedFocus, toMultiSelect, toMultiCellSelect] - [toFullRowSelect]; +end; + +procedure TCellSelectionTests.DoChangeCellEvent(Sender: TBaseVirtualTree; const Cells: TVTCellArray); +begin + if Assigned(FChangeCellEventProc) then + FChangeCellEventProc(Sender, Cells); +end; + +procedure TCellSelectionTests.FreeNodeEvent(Sender: TBaseVirtualTree; + Node: PVirtualNode); +var + LRowData: TRowData; +begin + LRowData := Node.GetData; + LRowData.Clear; +end; + +// End hacks + +procedure TCellSelectionTests.Setup; +var + LTree: TVirtualStringTree; + LCol1, LCol2, LCol3, LCol4, LCol5: TVirtualTreeColumn; +begin + + OpenClipboard; + + FForm := TForm.Create(nil); + FRichEdit := TRichEdit.Create(FForm); + FForm.InsertControl(FRichEdit); + FTree := TVirtualStringTree.Create(FForm); + LTree := FTree; + LTree.Parent := FForm; + LTree.Align := alClient; + LTree.OnFreeNode := FreeNodeEvent; + LTree.OnGetText := VirtualStringTree1GetText; + LTree.TreeStates := LTree.TreeStates + [tsUseCache]; + + try + OleSetClipboard(nil); + Clipboard.AsText := ''; + except + end; + + LTree.ClipboardFormats.Add(GetVTClipboardFormatDescription(CF_TEXT)); + LTree.ClipboardFormats.Add(GetVTClipboardFormatDescription(CF_OEMTEXT)); + LTree.ClipboardFormats.Add(GetVTClipboardFormatDescription(CF_UNICODETEXT)); + LTree.ClipboardFormats.Add(GetVTClipboardFormatDescription(CF_VRTF)); + LTree.ClipboardFormats.Add(GetVTClipboardFormatDescription(CF_HTML)); + + // Add three columns + LCol1 := LTree.Header.Columns.Add; + LCol2 := LTree.Header.Columns.Add; + LCol3 := LTree.Header.Columns.Add; + LCol4 := LTree.Header.Columns.Add; + LCol5 := LTree.Header.Columns.Add; + LCol1.Text := 'col1'; + LCol2.Text := 'col2'; + LCol3.Text := 'col3'; + LCol4.Text := 'col4'; + LCol5.Text := 'col5'; + + LTree.NodeDataSize := SizeOf(TRowData); + + FNode1 := LTree.AddChild(LTree.RootNode); + FNode2 := LTree.AddChild(LTree.RootNode); + FNode3 := LTree.AddChild(LTree.RootNode); + FNode4 := LTree.AddChild(LTree.RootNode); + FNode5 := LTree.AddChild(LTree.RootNode); + + FNode1.SetData( + TRowData.Create('1a', '1b', '1c', '1d', '1e') + ); + FNode2.SetData( + TRowData.Create('2a', '2b', '2c', '2d', '2e') + ); + FNode3.SetData( + TRowData.Create('3a', '3b', '3c', '3d', '3e') + ); + FNode4.SetData( + TRowData.Create('4a', '4b', '4c', '4d', '4e') + ); + FNode5.SetData( + TRowData.Create('5a', '5b', '5c', '5d', '5e') + ); +end; + +procedure TCellSelectionTests.TearDown; +begin + CloseClipboard; + OleSetClipboard(nil); + FreeAndNil(FForm); +end; + +procedure TCellSelectionTests.TestChangeCellEvent; +var + LTree: TVirtualStringTree; + n3: PVirtualNode; + LChangeFired, + LChangeCellFiredWhenAdding, LChangeCellFiredWhenRemoving: LongBool; +begin + LTree := FTree; + + EnableMultiCellSelection(LTree); + + LChangeCellFiredWhenAdding := False; + AssignChange(procedure (Sender: TBaseVirtualTree; const Cells: TVTCellArray) + begin + LChangeCellFiredWhenAdding := True; + end); + + n3 := FNode3; + LTree.SelectCells(n3, 1, n3, 1, False); + + Assert.IsTrue(LChangeCellFiredWhenAdding, 'OnChangeCell event not fired when adding!'); + + LChangeCellFiredWhenRemoving := False; + AssignChange(procedure (Sender: TBaseVirtualTree; const Cells: TVTCellArray) + begin + LChangeCellFiredWhenRemoving := True; + end); + LChangeFired := False; + AssignChange(procedure (Sender: TBaseVirtualTree; Node: PVirtualNode) + begin + LChangeFired := True; + end); + LTree.ClearCellSelection; + + Assert.IsTrue(LChangeCellFiredWhenRemoving, 'OnChangeCell event not fired when removing!'); + + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions + + [toExtendedFocus, toMultiSelect] - [toFullRowSelect, toMultiCellSelect]; + + LChangeFired := False; + LTree.MouseClick(n3); + + Assert.IsTrue(LChangeFired, 'Change event not fired'); +end; + +procedure TCellSelectionTests.TestClear; +var + LTree: TVirtualStringTree; + n3, n4: PVirtualNode; + LSelectedCells: TVTCellArray; +begin + LTree := FTree; + + EnableMultiCellSelection(LTree); + + n3 := FNode3; + n4 := FNode4; + + // Select rectangle from n3, col2 to n2, col3 + LTree.SelectCells(n3, 1, n4, 2, False); + LSelectedCells := LTree.SelectedCells; + + // How long is not important here, other tests in this suite checks it. + Assert.IsTrue(Length(LSelectedCells) > 0); + + LTree.Clear; + + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 0, 'Selected cells are not cleared!'); +end; + +procedure TCellSelectionTests.TestClearCellSelection; +var + LTree: TVirtualStringTree; + n3, n4: PVirtualNode; + LSelectedCells: TVTCellArray; +begin + LTree := FTree; + + EnableMultiCellSelection(LTree); + + n3 := FNode3; + n4 := FNode4; + + // Select rectangle from n3, col2 to n2, col3 + LTree.SelectCells(n3, 1, n4, 2, False); + + Assert.IsTrue(toExtendedFocus in LTree.TreeOptions.SelectionOptions); + Assert.IsTrue(toMultiSelect in LTree.TreeOptions.SelectionOptions); + + // Ensure the selected cells above are selected + Assert.IsTrue(LTree.IsCellSelected(n3, 1), 'n3, col1 should be selected'); + Assert.IsTrue(LTree.IsCellSelected(n3, 2), 'n3, col2 should be selected'); + Assert.IsTrue(LTree.IsCellSelected(n4, 1), 'n4, col1 should be selected'); + Assert.IsTrue(LTree.IsCellSelected(n4, 2), 'n4, col2 should be selected'); + + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 4, 'Length of selected cells is not 4!'); + + LTree.ClearCellSelection; + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 0, 'Length of selected cells is not 0!'); +end; + +procedure TCellSelectionTests.TestClickUnselectsSelectedCells; +var + LTree: TVirtualStringTree; + n1, n3, n4: PVirtualNode; + LSelCel1, LSelCel2: TVTCellArray; +begin + LTree := FTree; + + EnableMultiCellSelection(LTree); + + n3 := FNode3; + n4 := FNode4; + + // Select rectangle from n3, col2 to n2, col3 + LTree.SelectCells(n3, 1, n4, 2, False); + + Assert.IsTrue(toExtendedFocus in LTree.TreeOptions.SelectionOptions); + Assert.IsTrue(toMultiSelect in LTree.TreeOptions.SelectionOptions); + + // Ensure the selected cells above are selected + Assert.IsTrue(LTree.IsCellSelected(n3, 1), 'n3, col1 should be selected'); + Assert.IsTrue(LTree.IsCellSelected(n3, 2), 'n3, col2 should be selected'); + Assert.IsTrue(LTree.IsCellSelected(n4, 1), 'n4, col1 should be selected'); + Assert.IsTrue(LTree.IsCellSelected(n4, 2), 'n4, col2 should be selected'); + + LSelCel1 := LTree.SelectedCells; + n1 := FNode1; + LTree.MouseClick(n1); + LSelCel2 := LTree.SelectedCells; + + // Ensures the above cells are no longer selected + Assert.IsFalse(LTree.IsCellSelected(n3, 1), 'n3, col1 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n3, 2), 'n3, col2 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n4, 1), 'n4, col1 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n4, 2), 'n4, col2 should not be selected'); + + Assert.IsTrue(LTree.IsCellSelected(n1, 0), 'n1, col0 should be selected'); +end; + +procedure TCellSelectionTests.TestCopyHTML1; +var + LTree: TVirtualStringTree; + n3, n4: PVirtualNode; + LText, LExpected: string; + LTries: Integer; + LCompareSuccessful: LongBool; +begin + LTree := FTree; + LTree.Font.Name := 'Tahoma'; + LTree.Font.Size := 8; + + EnableMultiCellSelection(LTree); + + n3 := FNode3; + n4 := FNode4; + +// Occasional failure caused by clipboard copy issues, but this +// is due to interaction of complex interaction of Windows, console and +// DUnit testing, the failure is not seen in actual interacting applications + + // Select rectangle from n3, col2 to n4, col4 + LText := ''; LTries := 0; + repeat + LTree.SelectCells(n3, 1, n4, 3, False); + LTree.CopyToClipboard; + + // The following are not necessary in an actual application + Sleep(0); + + CompleteClipboardCopy; + Inc(LTries); + try + LText := Clipboard.AsHTML; + except + // Clipboard exception is ok, anything else is not + on EClipboardException do + begin + Clipboard.Close; + end; + else + raise; + end; + // End unnecessary stuff + until (LText <> '') or (LTries > MaxTries); + LExpected := 'Version:1.0'#$D#$A'StartHTML:00000097'#$D#$A'EndHTML:00001737'#$D#$A'StartFragment:00000269'#$D#$A'EndFragment:00001705'#$D#$A + + ''+ + ''#$D#$A + + ''#$D#$A''#$D#$A + + ''#$D#$A+ + ' '#$D#$A' '#$D#$A+ + ' '#$D#$A' '#$D#$A'
col2col3col4
3b 3c 3d
4b 4c 4d
'; + LCompareSuccessful := LText = LExpected; + Assert.IsTrue(LCompareSuccessful, 'Clipboard text is unexpected!'); +end; + +procedure TCellSelectionTests.TestCopyHTML2; +var + LTree: TVirtualStringTree; + n3, n5: PVirtualNode; + LText, LExpected: string; + LTries: Integer; + LCompareSuccessful: LongBool; +begin + LTree := FTree; + LTree.Font.Name := 'Tahoma'; + LTree.Font.Size := 10; + + EnableMultiCellSelection(LTree); + + n3 := FNode3; + n5 := FNode5; + +// Occasional failure caused by clipboard copy issues, but this +// is due to interaction of complex interaction of Windows, console and +// DUnit testing, the failure is not seen in actual interacting applications + + // Select rectangle from n3, col2 to n5, col4 + LText := ''; LTries := 0; + repeat + LTree.SelectCells(n3, 1, n5, 3, False); + LTree.CopyToClipboard; + + // The following are not necessary in an actual application + Sleep(0); + + CompleteClipboardCopy; + Inc(LTries); + try + LText := Clipboard.AsHTML; + except + // Clipboard exception is ok, anything else is not + on EClipboardException do + begin + Clipboard.Close; + end; + else + raise; + end; + // End unnecessary stuff + until (LText <> '') or (LTries > MaxTries); + LExpected := 'Version:1.0'#$D#$A'StartHTML:00000097'#$D#$A'EndHTML:00001947'#$D#$A'StartFragment:00000269'#$D#$A'EndFragment:00001915'#$D#$A''+ + ''#$D#$A + + ''#$D#$A''#$D#$A+ + ''#$D#$A+ + ' '#$D#$A' '#$D#$A+ + ' '#$D#$A' '#$D#$A' '#$D#$A + + ' '#$D#$A'
col2col3col4
3b 3c 3d
4b 4c 4d
5b 5c 5d
'; + LCompareSuccessful := LText = LExpected; + Assert.IsTrue(LCompareSuccessful, 'Clipboard text is unexpected!'); +end; + +procedure TCellSelectionTests.TestCopyPlainText1; +var + LTree: TVirtualStringTree; + n3, n4: PVirtualNode; + LText: string; + LTries: Integer; + LCompareSuccessful: LongBool; +begin + LTree := FTree; + LTree.Font.Name := 'Tahoma'; + LTree.Font.Size := 10; + + EnableMultiCellSelection(LTree); + + n3 := FNode3; + n4 := FNode4; + +// Occasional failure caused by clipboard copy issues, but this +// is due to interaction of complex interaction of Windows, console and +// DUnit testing, the failure is not seen in actual interacting applications + + // Select rectangle from n3, col2 to n4, col4 + LText := ''; LTries := 0; + repeat + LTree.SelectCells(n3, 1, n4, 3, False); + LTree.CopyToClipboard; + + // The following are not necessary in an actual application + Sleep(0); + + CompleteClipboardCopy; + Inc(LTries); + try + LText := Clipboard.AsText; + except + // Clipboard exception is ok, anything else is not + on EClipboardException do + begin + Clipboard.Close; + end; + else + raise; + end; + // End unnecessary stuff + until (LText <> '') or (LTries > MaxTries); + LCompareSuccessful := LText = 'col2'#9'col3'#9'col4'#$D#$A'3b'#9'3c'#9'3d'#$D#$A'4b'#9'4c'#9'4d'#$D#$A; + Assert.IsTrue(LCompareSuccessful, 'Clipboard text is unexpected!'); +end; + +procedure TCellSelectionTests.TestCopyPlainText2; +var + LTree: TVirtualStringTree; + n3, n5: PVirtualNode; + LText, LExpected: string; + LTries: Integer; + LCompareSuccessful: LongBool; +begin + LTree := FTree; + LTree.Font.Name := 'Tahoma'; + LTree.Font.Size := 10; + + EnableMultiCellSelection(LTree); + + n3 := FNode3; + n5 := FNode5; + +// Occasional failure caused by clipboard copy issues, but this +// is due to interaction of complex interaction of Windows, console and +// DUnit testing, the failure is not seen in actual interacting applications + + // Select rectangle from n3, col2 to n5, col4 + LText := ''; LTries := 0; + repeat + LTree.SelectCells(n3, 1, n5, 3, False); + LTree.CopyToClipboard; + + // The following are not necessary in an actual application + Sleep(0); + + CompleteClipboardCopy; + Inc(LTries); + try + LText := Clipboard.AsText; + except + // Clipboard exception is ok, anything else is not + on EClipboardException do + begin + Clipboard.Close; + end; + else + raise; + end; + // End unnecessary stuff + until (LText <> '') or (LTries > MaxTries); + LExpected := 'col2'#9'col3'#9'col4'#$D#$A'3b'#9'3c'#9'3d'#$D#$A'4b'#9'4c'#9'4d'#$D#$A'5b'#9'5c'#9'5d'#$D#$A; + LCompareSuccessful := LText = LExpected; + Assert.IsTrue(LCompareSuccessful, 'Clipboard text is unexpected!'); +end; + +procedure TCellSelectionTests.TestCopyRTF1; +var + LTree: TVirtualStringTree; + n3, n4: PVirtualNode; + LText, LPlainText, LExpected: string; + LTries: Integer; + LCompareSuccessful: LongBool; +begin + LTree := FTree; + LTree.Font.Name := 'Tahoma'; + LTree.Font.Size := 8; + + EnableMultiCellSelection(LTree); + + n3 := FNode3; + n4 := FNode4; + +// Occasional failure caused by clipboard copy issues, but this +// is due to interaction of complex interaction of Windows, console and +// DUnit testing, the failure is not seen in actual interacting applications + + // Select rectangle from n3, col2 to n4, col4 + LText := ''; LTries := 0; + repeat + LTree.SelectCells(n3, 1, n4, 3, False); + LTree.CopyToClipboard; + + // The following are not necessary in an actual application + Sleep(0); + + CompleteClipboardCopy; + Inc(LTries); + try + LText := Clipboard.AsRTF; + except + // Clipboard exception is ok, anything else is not + on EClipboardException do + begin + Clipboard.Close; + end; + else + raise; + end; + // End unnecessary stuff + until (LText <> '') or (LTries > MaxTries); + LExpected := '{\rtf1\ansi\ansicpg1252\deff0\deflang1043{\fonttbl{\f0 Tahoma;}}{\colortbl;\red0\green0\blue0;}\paperw16840\paperh11907\margl720\margr720\margt720\margb720\uc1\trowd\trgaph70\cellx750\cellx1500\cellx2250\pard\intbl\ql\f0\cf1'+ + '\fs16 \u99\''3f\u111\''3f\u108\''3f\u50\''3f\cell\ql \u99\''3f\u111\''3f\u108\''3f\u51\''3f\cell\ql \u99\''3f\u111\''3f\u108\''3f\u52\''3f\cell\row\pard\intbl \u51\''3f\u98\''3f\cell\pard\intbl \u51\''3f\u99\''3f\cell\pard\intbl \u51\''3f'+ + '\u100\''3f\cell\row'#$D#$A'\pard\intbl \u52\''3f\u98\''3f\cell\pard\intbl \u52\''3f\u99\''3f\cell\pard\intbl \u52\''3f\u100\''3f\cell\row'#$D#$A'\pard\par}'; + FRichEdit.SelText := LText; + LPlainText := FRichEdit.Text; + LCompareSuccessful := LText = LExpected; + Assert.IsTrue(LCompareSuccessful, 'Clipboard text is unexpected!'); +end; + +procedure TCellSelectionTests.TestCopyRTF2; +var + LTree: TVirtualStringTree; + n3, n5: PVirtualNode; + LText, LPlainText, LExpected: string; + LTries: Integer; + LCompareSuccessful: LongBool; +begin + LTree := FTree; + LTree.Font.Name := 'Tahoma'; + LTree.Font.Size := 8; + + EnableMultiCellSelection(LTree); + + n3 := FNode3; + n5 := FNode5; + +// Occasional failure caused by clipboard copy issues, but this +// is due to interaction of complex interaction of Windows, console and +// DUnit testing, the failure is not seen in actual interacting applications + + // Select rectangle from n3, col2 to n5, col4 + LText := ''; LTries := 0; + repeat + LTree.SelectCells(n3, 1, n5, 3, False); + LTree.CopyToClipboard; + + // The following are not necessary in an actual application + Sleep(0); + + CompleteClipboardCopy; + Inc(LTries); + try + LText := Clipboard.AsRTF; + except + // Clipboard exception is ok, anything else is not + on EClipboardException do + begin + Clipboard.Close; + end; + else + raise; + end; + // End unnecessary stuff + until (LText <> '') or (LTries > MaxTries); + LExpected := '{\rtf1\ansi\ansicpg1252\deff0\deflang1043{\fonttbl{\f0 Tahoma;}}{\colortbl;\red0\green0\blue0;}\paperw16840\paperh11907\margl720\margr720\margt720\margb720\uc1\trowd\trgaph70\cellx750\cellx1500\cellx2250\pard\intbl\ql\f0\cf1\fs16 \u99\''3f\u111\''3f\u108\''3' + + 'f\u50\''3f\cell\ql \u99\''3f\u111\''3f\u108\''3f\u51\''3f\cell\ql \u99\''3f\u111\''3f\u108\''3f\u52\''3f\cell\row\pard\intbl \u51\''3f\u98\''3f\cell\pard\intbl \u51\''3f\u99\''3f\cell\pard\intbl \u51\''3f\u100\''3f\cell\row' + sLineBreak + + '\pard\intbl \u52\''3f\u98\''3f\cell\pard\intbl \u52\''3f\u99\''3f\cell\pard\intbl \u52\''3f\u100\''3f\cell\row' + sLineBreak + + '\pard\intbl \u53\''3f\u98\''3f\cell\pard\intbl \u53\''3f\u99\''3f\cell\pard\intbl \u53\''3f\u100\''3f\cell\row' + sLineBreak + + '\pard\par}'; + FRichEdit.SelText := LText; + LPlainText := FRichEdit.Text; + LCompareSuccessful := LText = LExpected; + Assert.IsTrue(LCompareSuccessful, 'Clipboard text is unexpected!'); +end; + +procedure TCellSelectionTests.TestEmptyAreaOnChange1; +var + LTree: TVirtualStringTree; + n3: PVirtualNode; + LOnChangeFired: LongBool; + I, LColumnCount, LMaxWidth: Integer; + Rects: TArray; + LargestRect: TRect; + LTextOnly, LUnclipped, LApplyCellContentMargin: Boolean; + LastNode, LHitNode: PVirtualNode; + LEmptyArea: TPoint; + LHitInfo: THitInfo; +begin + LTree := FTree; + n3 := FNode3; + + // Calculate the largest client area for the VirtualTree and set it + LColumnCount := LTree.Header.Columns.Count; + LMaxWidth := 0; + for I := 0 to LColumnCount-1 do + begin + if LTree.Header.Columns[I].Width > LMaxWidth then + LMaxWidth := LTree.Header.Columns[I].Width; + end; + I := 0; + for LTextOnly := False to True do + for LUnclipped := False to True do + for LApplyCellContentMargin := False to True do + begin + SetLength(Rects, I+1); + Rects[I] := LTree.GetDisplayRect(n3, LColumnCount-1, LTextOnly, LUnclipped, LApplyCellContentMargin); + Inc(I); + end; + LargestRect := Rects[0]; + for I := 1 to High(Rects) do + begin + LargestRect := TRect.Union(LargestRect, Rects[I]); + end; + + LastNode := LTree.GetLastVisible; + + LTree.ClientHeight := LargestRect.BottomRight.Y + (LastNode.NodeHeight * 2); + LTree.ClientWidth := LargestRect.BottomRight.X + LMaxWidth; + + // This should be an empty area, beyond any visible nodes + LEmptyArea := Point(LargestRect.BottomRight.X + LMaxWidth, LargestRect.BottomRight.Y + LastNode.NodeHeight); + + // At this point, there should be no nodes selected + Assert.IsTrue(LTree.SelectedCount = 0); + LTree.MouseClick(n3); + // At this point, a node should be selected + Assert.IsTrue(LTree.SelectedCount = 1); + + LOnChangeFired := False; + LHitNode := Pointer($FFFFFFFF); + AssignChange(procedure (Sender: TBaseVirtualTree; ANode: PVirtualNode) + begin + LOnChangeFired := True; + LHitNode := ANode; + end); + + LTree.GetHitTestInfoAt(LEmptyArea.X, LEmptyArea.Y, True, LHitInfo); + LTree.MouseClick(LEmptyArea); + + Assert.IsTrue(hiNowhere in LHitInfo.HitPositions, 'Mouse click is not in an unpopulated/empty area!'); + Assert.IsTrue(LOnChangeFired, 'OnChange event not fired!'); + Assert.IsTrue(LHitNode = nil, 'Node is not nil!'); +end; + +procedure TCellSelectionTests.TestEmptyAreaOnChange2; +var + LTree: TVirtualStringTree; + n1: PVirtualNode; + LOnChangeFired: LongBool; + I, LColumnCount, LMaxWidth: Integer; + Rects: TArray; + LargestRect: TRect; + LTextOnly, LUnclipped, LApplyCellContentMargin: Boolean; + LastNode, LHitNode: PVirtualNode; + LEmptyArea: TPoint; + LHitInfo: THitInfo; + LTestForm: TVisibilityForm; +begin + LTestForm := TVisibilityForm.Create(nil); + try + LTestForm.Show; + LTree := LTestForm.VST1; + + n1 := LTree.GetLastVisible; + + // Calculate the largest client area for the VirtualTree and set it + LColumnCount := LTree.Header.Columns.Count; + LMaxWidth := 0; + for I := 0 to LColumnCount-1 do + begin + if LTree.Header.Columns[I].Width > LMaxWidth then + LMaxWidth := LTree.Header.Columns[I].Width; + end; + if LMaxWidth = 0 then + LMaxWidth := 300; + I := 0; + LargestRect := TRect.Empty; + for LTextOnly := False to True do + for LUnclipped := False to True do + for LApplyCellContentMargin := False to True do + begin + SetLength(Rects, I+1); + Rects[I] := LTree.GetDisplayRect(n1, LColumnCount-1, LTextOnly, LUnclipped, LApplyCellContentMargin); + LargestRect := TRect.Union(LargestRect, Rects[I]); + Inc(I); + end; + + LastNode := LTree.GetLastVisibleChild(LTree.RootNode); + + LTree.ClientHeight := LargestRect.BottomRight.Y + (LastNode.NodeHeight * 2); + LTree.ClientWidth := LargestRect.BottomRight.X + LMaxWidth; + + // This should be an empty area, beyond any visible nodes + LEmptyArea := Point(LargestRect.BottomRight.X + LMaxWidth, LargestRect.BottomRight.Y + LastNode.NodeHeight); + + // At this point, there should be no nodes selected + Assert.IsTrue(LTree.SelectedCount = 0); + LTree.MouseClick(n1, NoColumn); + // At this point, a node should be selected + Assert.IsTrue(LTree.SelectedCount = 1); + + LOnChangeFired := False; + LHitNode := Pointer($FFFFFFFF); + AssignChange(procedure (Sender: TBaseVirtualTree; ANode: PVirtualNode) + begin + LOnChangeFired := True; + LHitNode := ANode; + end, LTree); + + LTree.GetHitTestInfoAt(LEmptyArea.X, LEmptyArea.Y, True, LHitInfo); + LTree.MouseClick(LEmptyArea); + + // Clicking on an empty area clears the selection + + Assert.IsTrue(hiNowhere in LHitInfo.HitPositions, 'Mouse click is not in an unpopulated/empty area!'); + Assert.IsTrue(LOnChangeFired, 'OnChange event not fired!'); + Assert.IsTrue(LHitNode = nil, 'Node is not nil!'); + finally + LTestForm.Free; + end; +end; + +procedure TCellSelectionTests.TestOnChange; +var + LTree: TVirtualStringTree; + n3: PVirtualNode; + LOnChangeFired: LongBool; +begin + LTree := FTree; + n3 := FNode3; + + LOnChangeFired := False; + AssignChange(procedure (Sender: TBaseVirtualTree; ANode: PVirtualNode) + begin + LOnChangeFired := True; + end); + + LTree.MouseClick(n3); + Assert.IsTrue(LOnChangeFired, 'OnChange event not fired!'); +end; + +procedure TCellSelectionTests.TestSelectCellsRectangular; +var + LTree: TVirtualStringTree; + n3, n4: PVirtualNode; + LNodes: TArray; + LNode: PVirtualNode; + LColumn: Integer; +begin + + LTree := FTree; + + EnableMultiCellSelection; + + n3 := FNode3; + n4 := FNode4; + + // Select rectangle from n3, col2 to n2, col3 + LTree.SelectCells(n3, 1, n4, 2, False); + + Assert.IsTrue(toExtendedFocus in LTree.TreeOptions.SelectionOptions); + Assert.IsTrue(toMultiSelect in LTree.TreeOptions.SelectionOptions); + + // Ensure the selected cells above are selected + Assert.IsTrue(LTree.IsCellSelected(n3, 1), 'n3, col1 should be selected'); + Assert.IsTrue(LTree.IsCellSelected(n3, 2), 'n3, col2 should be selected'); + Assert.IsTrue(LTree.IsCellSelected(n4, 1), 'n4, col1 should be selected'); + Assert.IsTrue(LTree.IsCellSelected(n4, 2), 'n4, col2 should be selected'); + + // Ensure the non-selected cells are not selected + Assert.IsFalse(LTree.IsCellSelected(n3, 0), 'n3, col0 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n3, 3), 'n3, col3 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n4, 0), 'n4, col0 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n4, 3), 'n4, col3 should not be selected'); + + LNodes := [FNode1, FNode2, FNode5, FNode6, FNode7, FNode8]; + for LNode in LNodes do + for LColumn := 0 to 3 do + Assert.IsFalse(LTree.IsCellSelected(LNode, LColumn), + Format('Row: $%p Column: %d should not be selected', [Pointer(LNode), LColumn])); +end; + +procedure TCellSelectionTests.TestSelectMultipleCellsFailWithoutExtendedFocus; +var + LTree: TVirtualStringTree; + n3, n4: PVirtualNode; +begin + LTree := FTree; + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions - + [toExtendedFocus]; + + n3 := FNode3; + n4 := FNode4; + + // Select rectangle from n3, col2 to n2, col3 + LTree.SelectCells(n3, 1, n4, 2, False); + + // Ensure the selected cells above are not selected + Assert.IsFalse(LTree.IsCellSelected(n3, 1), 'n3, col1 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n3, 2), 'n3, col2 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n4, 1), 'n4, col1 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n4, 2), 'n4, col2 should not be selected'); +end; + +procedure TCellSelectionTests.TestSelectMultipleCellsFailWithoutMultiSelect; +var + LTree: TVirtualStringTree; + n3, n4: PVirtualNode; +begin + LTree := FTree; + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions - + [toMultiSelect]; + + n3 := FNode3; + n4 := FNode4; + + // Select rectangle from n3, col2 to n2, col3 + LTree.SelectCells(n3, 1, n4, 2, False); + + // Ensure the selected cells above are not selected + Assert.IsFalse(LTree.IsCellSelected(n3, 1), 'n3, col1 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n3, 2), 'n3, col2 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n4, 1), 'n4, col1 should not be selected'); + Assert.IsFalse(LTree.IsCellSelected(n4, 2), 'n4, col2 should not be selected'); +end; + +procedure TCellSelectionTests.TestSelectSingleCell; +var + LTree: TVirtualStringTree; + n3: PVirtualNode; + LSelectedCells: TVTCellArray; + LNodes: TArray; + LNode: PVirtualNode; + LColumn: Integer; + LCellChangeFired: LongBool; +begin + LTree := FTree; + + EnableMultiCellSelection; + + LCellChangeFired := False; + AssignChange(procedure(Sender: TBaseVirtualTree; const Cells: TVTCellArray) + begin + LCellChangeFired := True; + end); + n3 := FNode3; + Assert.IsFalse(LCellChangeFired, 'LCellChangedFired is True!'); + LTree.SelectCells(n3, 1, n3, 1, False); + Assert.IsTrue(LCellChangeFired, 'LCellChangedFired is False!'); + + + Assert.IsTrue(LTree.IsCellSelected(n3, 1), 'n3, col1 should be selected'); + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 1, 'Should only have 1 cell selected'); + Assert.IsTrue((LSelectedCells[0].Node = n3) and (LSelectedCells[0].Column = 1)); + + LNodes := [FNode1, FNode2, n3, FNode4, FNode5, FNode6, FNode7, FNode8]; + for LNode in LNodes do + for LColumn := 0 to 3 do + begin + if (LNode = n3) and (LColumn = 1) then + Continue; + Assert.IsFalse(LTree.IsCellSelected(LNode, LColumn), + Format('Row: $%p Column: %d should not be selected', [Pointer(LNode), LColumn])); + end; +end; + +procedure TCellSelectionTests.TestShiftClickMultipleCells; +var + LTree: TVirtualStringTree; + n3, n4: PVirtualNode; + LSelectedCells, LNewSelectedCells: TVTCellArray; +begin + LTree := FTree; + + EnableMultiCellSelection; + + n3 := FNode3; + n4 := FNode4; + + LTree.MouseClick(n3, 1); + LSelectedCells := LTree.SelectedCells; + LTree.ShiftMouseClick(n4, 2); + LNewSelectedCells := LTree.SelectedCells; + + Assert.IsTrue(Length(LSelectedCells) = 1, 'Length of selected cell is unexpected!'); + Assert.IsTrue((LSelectedCells[0].Node = n3) and (LSelectedCells[0].Column = 1), 'Unexpected cell selection 1'); + + Assert.IsTrue(Length(LNewSelectedCells) = 4, 'Length of selected cells is unexpected!'); + Assert.IsTrue((LNewSelectedCells[0].Node = n3) and (LNewSelectedCells[0].Column = 1), 'Unexpected cell selection 0!'); + Assert.IsTrue((LNewSelectedCells[1].Node = n3) and (LNewSelectedCells[1].Column = 2), 'Unexpected cell selection 1!'); + Assert.IsTrue((LNewSelectedCells[2].Node = n4) and (LNewSelectedCells[2].Column = 1), 'Unexpected cell selection 2!'); + Assert.IsTrue((LNewSelectedCells[3].Node = n4) and (LNewSelectedCells[3].Column = 2), 'Unexpected cell selection 3!'); +end; + +procedure TCellSelectionTests.TestLeftClickSelectsNode; +var + LTree: TVirtualStringTree; + LNode: PVirtualNode; + LSelectedCells: TVTCellArray; + LSelected: LongBool; + LForm: TSelectionTestForm; +begin + LTree := FTree; + + LNode := FNode3; + EnableMultiCellSelection; + + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 0, 'Length of selected cell is unexpected!'); + LTree.MouseClick(LNode, 0); + + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 1, 'Length of selected cell is unexpected!'); + + LTree.ClearCellSelection; + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 0, 'Length of selected cell is unexpected!'); + + // Remove multiselect, which is part of multicell select + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions - + [toMultiSelect]; + // SelectionOptions should now be [toExtendedFocus,toSelectNextNodeOnRemoval] + LTree.MouseClick(LNode); + + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 0, 'Length of selected cell is unexpected!'); + + LSelected := LTree.Selected[LNode]; + Assert.IsTrue(LSelected, 'Node is not selected!'); + + // This test is the same as the one below with TSelectionTestForm + LTree.TreeOptions.SelectionOptions := [toMultiSelect,toSelectNextNodeOnRemoval]; + LSelected := LTree.Selected[LNode]; + Assert.IsFalse(LSelected, 'Node should not be selected!'); + LTree.MouseClick(LNode); + LSelected := LTree.Selected[LNode]; + Assert.IsTrue(LSelected, 'Node should be selected!'); + + // This test ensures that left click is working correctly + LForm := TSelectionTestForm.Create(nil); + try + LForm.Show; // Needed to initialize VST + LTree := LForm.VSTA; + LNode := LTree.GetFirstVisible; + Assert.IsTrue(LNode <> nil, 'Node is nil!'); + LSelected := LTree.Selected[LNode]; + Assert.IsFalse(LSelected, 'Node is selected'); + LTree.MouseClick(LNode); + LSelected := LTree.Selected[LNode]; + Assert.IsTrue(LSelected, 'Node is selected'); + finally + LForm.Free; + end; +end; + +procedure TCellSelectionTests.TestLeftClickWithoutMultiSelectDoesNotSelectCell; +var + LTree: TVirtualStringTree; + n3: PVirtualNode; + LSelectedCells: TVTCellArray; +begin + LTree := FTree; + + n3 := FNode3; + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions - + [toMultiSelect]; + + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 0, 'Length of selected cell is unexpected!'); + + LTree.MouseClick(n3, 1); + + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 0, 'Length of selected cell is unexpected!'); +end; + +procedure TCellSelectionTests.TestRemovingSetsClearCellSelection; +var + LTree: TVirtualStringTree; + n3: PVirtualNode; + LSelectedCells: TVTCellArray; + LNodeSelected: LongBool; + + procedure DisableMulticellSelection; + begin + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions - + [toMultiCellSelect]; + end; + + procedure SelectCell; + begin + EnableMultiCellSelection(LTree); + LTree.MouseClick(n3, 0); + end; + + procedure SelectNode; + begin + LTree.MouseClick(n3); + end; + + procedure EnsureNodeSelected; + begin + LNodeSelected := LTree.Selected[n3]; + Assert.IsTrue(LNodeSelected, 'Node is not selected!'); + end; + + procedure EnsureNodeNotSelected; + begin + LNodeSelected := LTree.Selected[n3]; + Assert.IsFalse(LNodeSelected, 'Node is selected!'); + end; + + procedure EnsureCellNotSelected; + begin + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 0, 'Length of selected cell is unexpected!'); + end; + + procedure EnsureCellSelected; + begin + LSelectedCells := LTree.SelectedCells; + Assert.IsTrue(Length(LSelectedCells) = 1, 'Length of selected cell is unexpected!'); + end; + + procedure EnsureSelectCell; + begin + EnsureCellNotSelected; + SelectCell; + EnsureCellSelected; + end; + + procedure CheckTree; + begin + EnsureSelectCell; + DisableMulticellSelection; + EnsureCellNotSelected; + + EnableMulticellSelection; + SelectCell; + EnsureCellSelected; + + LTree.ClearCellSelection; + EnsureCellNotSelected; + + DisableMulticellSelection; + LTree.ClearSelection; + EnsureNodeNotSelected; + SelectNode; + EnsureNodeSelected; + + EnsureSelectCell; + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions - [toMultiCellSelect]; + EnsureCellNotSelected; + + EnsureSelectCell; + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions - [toExtendedFocus]; + EnsureCellNotSelected; + + EnsureSelectCell; + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions - [toMultiSelect]; + EnsureCellNotSelected; + + EnsureSelectCell; + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions - [toExtendedFocus, toMultiSelect]; + EnsureCellNotSelected; + + EnsureSelectCell; + LTree.TreeOptions.SelectionOptions := LTree.TreeOptions.SelectionOptions + [toFullRowSelect]; + EnsureCellNotSelected; + end; + +var + LForm: TSelectionTestForm; +begin + LTree := FTree; + n3 := FNode3; + + // Run against the default tree + CheckTree; + + LForm := TSelectionTestForm.Create(nil); + try + LForm.Show; + LTree := LForm.VSTA; + n3 := LTree.GetFirstVisibleChild(LTree.RootNode); + + // Run against the form's tree + CheckTree; + finally + LForm.Free; + end; +end; + +initialization + TDUnitX.RegisterTestFixture(TCellSelectionTests); +end. diff --git a/Tests/VTOnDrawTextTests.pas b/Tests/VTOnDrawTextTests.pas new file mode 100644 index 000000000..3d4dcb7fa --- /dev/null +++ b/Tests/VTOnDrawTextTests.pas @@ -0,0 +1,181 @@ +unit VTOnDrawTextTests; + +interface + +uses + DUnitX.TestFramework, + Vcl.Forms, + VirtualTrees, System.Types; + +type + + [TestFixture] + TVTOnDrawTextTests = class + strict private + fTree: TVirtualStringTree; + fForm: TForm; + + FDrawText1Called: Boolean; + FDrawTextEx1Called: Boolean; + + FDrawText2Called: Boolean; + FDrawTextEx2Called: Boolean; + + FDrawText3Called: Boolean; + FDrawTextEx3Called: Boolean; + + procedure DrawText1Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; const Text: string; + const CellRect: TRect; var DefaultDraw: Boolean); + + procedure DrawTextEx2Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; const Text: string; + const CellRect: TRect; var DefaultDraw: Boolean; var DrawFormat: Cardinal); + + procedure DrawText3Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; const Text: string; + const CellRect: TRect; var DefaultDraw: Boolean); + procedure DrawTextEx3Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; const Text: string; + const CellRect: TRect; var DefaultDraw: Boolean; var DrawFormat: Cardinal); + + procedure GetTextEvent(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + [Test] + procedure TestOnDrawText; + + [Test] + procedure TestOnDrawTextOnDrawTextEx; + + [Test] + procedure TestOnDrawTextEx; + end; + +implementation + +uses + System.SysUtils, VirtualTrees.Types; + +const + colCaption = 0; + colData = 1; + +procedure TVTOnDrawTextTests.DrawText1Event(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + const Text: string; const CellRect: TRect; var DefaultDraw: Boolean); +begin + FDrawText1Called := True; +end; + +procedure TVTOnDrawTextTests.DrawText3Event(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + const Text: string; const CellRect: TRect; var DefaultDraw: Boolean); +begin + FDrawText3Called := True; +end; + +procedure TVTOnDrawTextTests.DrawTextEx2Event(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + const Text: string; const CellRect: TRect; var DefaultDraw: Boolean; + var DrawFormat: Cardinal); +begin + FDrawTextEx2Called := True; +end; + +procedure TVTOnDrawTextTests.DrawTextEx3Event(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + const Text: string; const CellRect: TRect; var DefaultDraw: Boolean; + var DrawFormat: Cardinal); +begin + FDrawTextEx3Called := True; +end; + +procedure TVTOnDrawTextTests.GetTextEvent(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: string); +begin + case Column of + colCaption: begin + CellText := 'Caption'; + end; + colData: begin + CellText := 'Data'; + end; + end; +end; + +procedure TVTOnDrawTextTests.Setup; +var + LCol1, LCol2: TVirtualTreeColumn; +begin + FDrawText1Called := False; + FDrawTextEx1Called := False; + + FDrawText2Called := False; + FDrawTextEx2Called := False; + + FDrawText3Called := False; + FDrawTextEx3Called := False; + + fForm := TForm.Create(nil); + fTree := TVirtualStringTree.Create(fForm); + fForm.InsertControl(fTree); + + fTree.OnGetText := GetTextEvent; + + LCol1 := fTree.Header.Columns.Add; + LCol2 := fTree.Header.Columns.Add; + LCol1.Text := 'Caption'; + LCol2.Text := 'Data'; + + fTree.AddChild(fTree.RootNode); + fTree.AddChild(fTree.RootNode); + fForm.Show; +end; + +procedure TVTOnDrawTextTests.TearDown; +begin + FreeAndNil(fForm); +end; + +procedure TVTOnDrawTextTests.TestOnDrawText; +begin + // This test ensures that OnDrawText event is called when OnDrawText is assigned + fTree.OnDrawText := DrawText1Event; + fTree.OnDrawTextEx := nil; + fTree.Update; + + Assert.IsTrue(FDrawText1Called and not FDrawTextEx1Called); +end; + +procedure TVTOnDrawTextTests.TestOnDrawTextEx; +begin + // This test ensures that OnDrawTextEx event is called when OnDrawTextEx is assigned + // and that OnDrawText is not called + fTree.OnDrawText := nil; + fTree.OnDrawTextEx := DrawTextEx2Event; + fTree.Update; + + Assert.IsTrue(not FDrawText2Called and FDrawTextEx2Called); +end; + +procedure TVTOnDrawTextTests.TestOnDrawTextOnDrawTextEx; +begin + // This test ensures that only the OnDrawTextEx event is called when both + // OnDrawText and OnDrawTextEx are assigned and that OnDrawText is not called + fTree.OnDrawText := DrawText3Event; + fTree.OnDrawTextEx := DrawTextEx3Event; + fTree.Update; + + Assert.IsTrue(not FDrawText3Called and FDrawTextEx3Called); +end; + +initialization + TDUnitX.RegisterTestFixture(TVTOnDrawTextTests); +end. diff --git a/Tests/VTOnEditCancelledTests.pas b/Tests/VTOnEditCancelledTests.pas new file mode 100644 index 000000000..36e7aec53 --- /dev/null +++ b/Tests/VTOnEditCancelledTests.pas @@ -0,0 +1,136 @@ +unit VTOnEditCancelledTests; + +interface + +uses + DUnitX.TestFramework, + Vcl.Forms, + VirtualTrees; + +type + + [TestFixture] + TVTOnEditCancelledTests = class + strict private + fTree: TVirtualStringTree; + fForm: TForm; + FEditCancelled: Boolean; + procedure TreeEditCancelled(Sender: TBaseVirtualTree; Column: TColumnIndex); + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + [Test] + procedure TestAddColumn; + + [Test] + procedure TestEditNodeFail; + + [Test] + procedure TestEditNode; + + [Test] + procedure TestEditNodeReadOnly; + + [Test] + procedure TestOnEditCancelled; + end; + +implementation + +uses + System.SysUtils, VirtualTrees.Types; + +procedure TVTOnEditCancelledTests.Setup; +begin + fForm := TForm.Create(nil); + fTree := TVirtualStringTree.Create(fForm); +end; + +procedure TVTOnEditCancelledTests.TearDown; +begin + FreeAndNil(fForm); +end; + +procedure TVTOnEditCancelledTests.TestAddColumn; +var + LBeforeColumnCount, LAfterColumnCount: Integer; +begin + LBeforeColumnCount := fTree.Header.Columns.Count; + fTree.Header.Columns.Add; + LAfterColumnCount := fTree.Header.Columns.Count; + Assert.AreEqual(LAfterColumnCount - LBeforeColumnCount, 1); +end; + +procedure TVTOnEditCancelledTests.TestEditNode; +var + LNode: PVirtualNode; + LEditNodeResult: Boolean; + LAfterStates: TVirtualTreeStates; +begin + fForm.Show; + fTree.TreeOptions.MiscOptions := fTree.TreeOptions.MiscOptions + [toEditable]; + fTree.Parent := fForm; + fTree.Header.Columns.Add; + LNode := fTree.AddChild(fTree.RootNode); + LEditNodeResult := fTree.EditNode(LNode, 0); + LAfterStates := fTree.TreeStates; + Assert.AreEqual(LAfterStates * [tsEditing], [tsEditing]); + Assert.IsTrue(LEditNodeResult); +end; + +procedure TVTOnEditCancelledTests.TestEditNodeFail; +var + LNode: PVirtualNode; + LEditNodeResult: Boolean; +begin + fForm.Show; + fTree.TreeOptions.MiscOptions := fTree.TreeOptions.MiscOptions - [toEditable]; + fTree.Parent := fForm; + fTree.Header.Columns.Add; + LNode := fTree.AddChild(fTree.RootNode); + LEditNodeResult := fTree.EditNode(LNode, 0); + Assert.IsFalse(LEditNodeResult); +end; + +procedure TVTOnEditCancelledTests.TestEditNodeReadOnly; +var + LNode: PVirtualNode; + LEditNodeResult: Boolean; +begin + fForm.Show; + fTree.Parent := fForm; + fTree.Header.Columns.Add; + LNode := fTree.AddChild(fTree.RootNode); + fTree.TreeOptions.MiscOptions := fTree.TreeOptions.MiscOptions + [toReadOnly]; + LEditNodeResult := fTree.EditNode(LNode, 0); + Assert.IsFalse(LEditNodeResult); +end; + +procedure TVTOnEditCancelledTests.TestOnEditCancelled; +var + LNode: PVirtualNode; +begin + fForm.Show; + FEditCancelled := False; + fTree.OnEditCancelled := TreeEditCancelled; + fTree.TreeOptions.MiscOptions := fTree.TreeOptions.MiscOptions + [toEditable]; + LNode := fTree.AddChild(fTree.RootNode); + fTree.Parent := fForm; + fTree.Header.Columns.Add; + fTree.EditNode(LNode, 0); + fTree.CancelEditNode; + Assert.IsTrue(FEditCancelled); +end; + +procedure TVTOnEditCancelledTests.TreeEditCancelled(Sender: TBaseVirtualTree; + Column: TColumnIndex); +begin + FEditCancelled := True; +end; + +initialization + TDUnitX.RegisterTestFixture(TVTOnEditCancelledTests); +end. diff --git a/Tests/VTWorkerThreadIssue1001Tests.pas b/Tests/VTWorkerThreadIssue1001Tests.pas new file mode 100644 index 000000000..04142fc04 --- /dev/null +++ b/Tests/VTWorkerThreadIssue1001Tests.pas @@ -0,0 +1,91 @@ +unit VTWorkerThreadIssue1001Tests; + +interface + +uses + DUnitX.TestFramework, + Classes, + Vcl.Forms, + VirtualTrees; + +type + TTestBaseVirtualTree = class(TVTAncestor) + public + property OnCompareNodes; + end; + + [TestFixture] + TVTWorkerThreadIssue1001Tests = class + strict private + fTree: TTestBaseVirtualTree; + fForm: TForm; + procedure TreeCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; + Column: TColumnIndex; var Result: Integer); + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + /// Test for CheckSynchronize when tree is destroyed + /// repeated 50 times because AVs are not realiable + [Test, RepeatTestAttribute(100)] + procedure TestDestroyWhileWorkerThreadBusy; + end; + +implementation + +uses + VirtualTrees.WorkerThread, + SysUtils; + +procedure TVTWorkerThreadIssue1001Tests.Setup; +begin + TThread.Synchronize(nil, procedure + begin + fForm := TForm.Create(nil); + fTree := TTestBaseVirtualTree.Create(fForm); + fTree.TreeOptions.AutoOptions:= fTree.TreeOptions.AutoOptions - [toAutoSort]; + fTree.OnCompareNodes:= TreeCompareNodes; + end); +end; + +procedure TVTWorkerThreadIssue1001Tests.TearDown; +begin + TThread.Synchronize(nil, procedure + begin + FreeAndNil(fForm); + end); +end; + +procedure TVTWorkerThreadIssue1001Tests.TestDestroyWhileWorkerThreadBusy; +begin + TThread.Synchronize(nil, procedure + begin + fTree.BeginUpdate; + try + fTree.SetChildCount(fTree.RootNode, 10000); + Assert.AreEqual(fTree.RootNode.ChildCount + 1, fTree.RootNode.TotalCount, 'TotalCount <> ChildCount + 1'); + //fTree.SortTree(-1, sdAscending, false); + finally + fTree.EndUpdate; + end; + FreeAndNil(fTree); + FreeAndNil(fForm); + end); +end; + +procedure TVTWorkerThreadIssue1001Tests.TreeCompareNodes( + Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; + var Result: Integer); +begin + if Random(10) > 5 then + Result:= 1 else + Result:= -1; +end; + +initialization + Randomize; + TDUnitX.RegisterTestFixture(TVTWorkerThreadIssue1001Tests); + +end. diff --git a/Tests/Vcl.ClipboardHelper.pas b/Tests/Vcl.ClipboardHelper.pas new file mode 100644 index 000000000..eaf7ea737 --- /dev/null +++ b/Tests/Vcl.ClipboardHelper.pas @@ -0,0 +1,54 @@ +unit Vcl.ClipboardHelper; + +interface + +uses + Vcl.Clipbrd, Winapi.Windows; + +type + TClipboardHelper = class helper for TClipboard + protected + function GetAsFormat(uFormat: UINT): string; + function GetAsHTML: string; + function GetAsRTF: string; + public + property AsHTML: string read GetAsHTML; + property AsRTF: string read GetAsRTF; + end; + +implementation + +uses + VirtualTrees.ClipBoard; + +{ TClipboardHelper } + +function TClipboardHelper.GetAsFormat(uFormat: UINT): string; +var + Data: THandle; +begin + Open; + Data := GetClipboardData(uFormat); + try + if Data <> 0 then + Result := string(AnsiString(PAnsiChar(GlobalLock(Data)))) + else + Result := ''; + finally + if Data <> 0 then + GlobalUnlock(Data); + Close; + end; +end; + +function TClipboardHelper.GetAsHTML: string; +begin + Result := GetAsFormat(CF_HTML); +end; + +function TClipboardHelper.GetAsRTF: string; +begin + Result := GetAsFormat(CF_VRTF); +end; + +end. diff --git a/Tests/VirtualTreeTests.pas b/Tests/VirtualTreeTests.pas index 5a4d84be5..19e8c1269 100644 --- a/Tests/VirtualTreeTests.pas +++ b/Tests/VirtualTreeTests.pas @@ -4,7 +4,7 @@ interface uses DUnitX.TestFramework, - Windows, + WinApi.Windows, VirtualTrees, VirtualTrees.Utils, Vcl.Graphics; diff --git a/Tests/VirtualTrees.MouseUtils.pas b/Tests/VirtualTrees.MouseUtils.pas new file mode 100644 index 000000000..09d9882fa --- /dev/null +++ b/Tests/VirtualTrees.MouseUtils.pas @@ -0,0 +1,186 @@ +unit VirtualTrees.MouseUtils; + +interface + +uses + VirtualTrees, System.Types; + +type + + /// + /// Created to be used only for testing + /// + TCustomVirtualStringTreeMouseHelper = class helper for TCustomVirtualStringTree + protected + const + KEYDOWN = Byte(1 shl 7); + public + function GetDisplayRectEx(ANode: PVirtualNode; AColumn: TColumnIndex): TPoint; + + procedure KeyedMouseClick(Key: Byte; ACursorPos: TPoint); overload; + procedure KeyedMouseClick(Key: Byte; ANode: PVirtualNode; AColumn: TColumnIndex = 0); overload; + + procedure MouseClick(ACursorPos: TPoint); overload; + procedure MouseClick(ANode: PVirtualNode; AColumn: TColumnIndex = 0); overload; + + procedure CtrlMouseClick(ACursorPos: TPoint); overload; + procedure CtrlMouseClick(ANode: PVirtualNode; AColumn: TColumnIndex = 0); overload; + + procedure ShiftMouseClick(ANode: PVirtualNode; AColumn: TColumnIndex = 0); overload; + end; + +implementation + +uses + Winapi.Windows, Vcl.Controls, Winapi.Messages, VirtualTrees.Types, System.Math, + System.SysUtils; + +{ TCustomVirtualStringTreeMouseHelper } + +function TCustomVirtualStringTreeMouseHelper.GetDisplayRectEx( + ANode: PVirtualNode; AColumn: TColumnIndex): TPoint; +var + R: TRect; + LRight: TDimension; +begin + if not Assigned(ANode) then + begin + Result := Point(0, 0); + Exit; + end; + + // Use the full-row rect to get a reliable Y coordinate for hit testing. + R := GetDisplayRect(ANode, NoColumn, False, False, False); + + if R.IsEmpty then + begin + Exit(Point(0, 0)); + end; + + Result.Y := R.Top + (R.Bottom - R.Top) div 2; + Header.Columns.GetColumnBounds(AColumn, Result.X, LRight); + + // If header is visible the client coordinates for hit testing are below the header. + if hoVisible in Header.Options then + Inc(Result.Y, Header.Height); +end; + +procedure TCustomVirtualStringTreeMouseHelper.MouseClick(ACursorPos: TPoint); +var + LKeyboardState: TKeyboardState; + LTree: TCustomVirtualStringTree; + LSavedCursorPos: TPoint; + LWPARAM: WPARAM; + LPos: LPARAM; +begin + // Click a new cell on the tree... + LTree := Self; + LSavedCursorPos := Mouse.CursorPos; + try + Mouse.CursorPos := ACursorPos; + LWPARAM := MK_LBUTTON; + if GetKeyboardState(LKeyboardState) then + begin + if (LKeyboardState[VK_SHIFT] and KEYDOWN <> 0) or + (LKeyboardState[VK_LSHIFT] and KEYDOWN <> 0) or + (LKeyboardState[VK_RSHIFT] and KEYDOWN <> 0) then + LWPARAM := LWPARAM or MK_SHIFT; + if (LKeyboardState[VK_CONTROL] and KEYDOWN <> 0) or + (LKeyboardState[VK_LCONTROL] and KEYDOWN <> 0) or + (LKeyboardState[VK_RCONTROL] and KEYDOWN <> 0) then + LWPARAM := LWPARAM or MK_CONTROL; + end; + LPos := MakeLParam(ACursorPos.X, ACursorPos.Y); + LTree.Perform(WM_LBUTTONDOWN, LWPARAM, LPos); + LTree.Perform(WM_LBUTTONUP, LWPARAM, LPos); + finally + Mouse.CursorPos := LSavedCursorPos; + end; +end; + +procedure TCustomVirtualStringTreeMouseHelper.KeyedMouseClick( + Key: Byte; ACursorPos: TPoint); +var + LOrigKBState, LNewKBState: TKeyboardState; +begin + GetKeyboardState(LOrigKBState); + LNewKBState := LOrigKBState; + LNewKBState[Key] := LOrigKBState[Key] or KEYDOWN; + SetKeyboardState(LNewKBState); + try + MouseClick(ACursorPos); + finally + SetKeyboardState(LOrigKBState); + end; +end; + +procedure TCustomVirtualStringTreeMouseHelper.KeyedMouseClick( + Key: Byte; ANode: PVirtualNode; AColumn: TColumnIndex = 0); +var + LOrigKBState, LNewKBState: TKeyboardState; +begin + GetKeyboardState(LOrigKBState); + LNewKBState := LOrigKBState; + LNewKBState[Key] := LOrigKBState[Key] or KEYDOWN; + SetKeyboardState(LNewKBState); + try + MouseClick(ANode, AColumn); + finally + SetKeyboardState(LOrigKBState); + end; +end; + +procedure TCustomVirtualStringTreeMouseHelper.MouseClick(ANode: PVirtualNode; + AColumn: TColumnIndex = 0 +); +var + LTree: TCustomVirtualStringTree; + LClientRect, LClientRect2: TRect; + LHitInfo: THitInfo; + LTopLeft: TPoint; + LPasses, LCount: Integer; +begin + LTree := Self; + if not Assigned(ANode) then + Exit; + + LClientRect := LTree.GetDisplayRect(ANode, AColumn, True, True, True); + LTopLeft := LClientRect.TopLeft; + if hoVisible in LTree.Header.Options then + begin + Inc(LTopLeft.Y, LTree.Header.Height); + end; + + LPasses := 0; + LCount := LTree.VisibleCount; + repeat + LTree.GetHitTestInfoAt(LTopLeft.X, LTopLeft.Y, True, LHitInfo, []); + LClientRect2 := LTree.GetDisplayRect(LHitInfo.HitNode, AColumn, True); + if LHitInfo.HitNode <> ANode then + Inc(LTopLeft.Y, LHitInfo.HitNode.NodeHeight); + Inc(LPasses); // Prevent forever loop + until (LHitInfo.HitNode = ANode) or (LPasses > LCount); + Assert((LHitInfo.HitNode = ANode) and (LHitInfo.HitColumn = AColumn)); + + MouseClick(LTopLeft); +end; + +procedure TCustomVirtualStringTreeMouseHelper.CtrlMouseClick( + ANode: PVirtualNode; AColumn: TColumnIndex); +begin + KeyedMouseClick(VK_CONTROL, ANode, AColumn); +end; + +procedure TCustomVirtualStringTreeMouseHelper.CtrlMouseClick( + ACursorPos: TPoint); +begin + KeyedMouseClick(VK_CONTROL, ACursorPos); +end; + +procedure TCustomVirtualStringTreeMouseHelper.ShiftMouseClick( + ANode: PVirtualNode; AColumn: TColumnIndex = 0); +begin + KeyedMouseClick(VK_SHIFT, ANode, AColumn); +end; + +end. diff --git a/Tests/VisibilityTest.dpr b/Tests/VisibilityTest.dpr new file mode 100644 index 000000000..2a5abd4a6 --- /dev/null +++ b/Tests/VisibilityTest.dpr @@ -0,0 +1,17 @@ +program VisibilityTest; + +uses + Vcl.Forms, + VTCellSelectionTests.VisibilityForm in 'VTCellSelectionTests.VisibilityForm.pas' {VisibilityForm}, + VirtualTrees.MouseUtils in 'VirtualTrees.MouseUtils.pas', + VTCellSelectionTests.VTSelectionTestForm in 'VTCellSelectionTests.VTSelectionTestForm.pas' {SelectionTestForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TSelectionTestForm, SelectionTestForm); + Application.CreateForm(TVisibilityForm, VisibilityForm); + Application.Run; +end. diff --git a/Tests/VisibilityTest.dproj b/Tests/VisibilityTest.dproj new file mode 100644 index 000000000..775b2e382 --- /dev/null +++ b/Tests/VisibilityTest.dproj @@ -0,0 +1,164 @@ + + + {A378499F-32AF-4362-9ED1-0859B1AED44A} + 20.3 + VCL + True + Debug + Win32 + VisibilityTest + 3 + Application + VisibilityTest.dpr + + + 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 + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + VisibilityTest + + + ExecutableExplorer;vclwinx;DataSnapServer;ProgressBarComponent;PluginCommonRTL;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;SupportedServices;appanalytics;IndyProtocols;vclx;Skia.Package.RTL;TestPackage;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;JSONRPC.Registrar;emsedge;bindcompfmx;XMLSummaryExpert;DBXFirebirdDriver;TerminalConsolePackage_CommandPromptHere_TConsole;BuildGroupsColumnFixer;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;soapmidas;vclactnband;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;TerminalFrame;AsyncProDR;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;Skia.Package.FMX;FireDACOracleDriver;fmxdae;ProgressBarDesignTime;EnableDebugVariables;FireDACMSAccDriver;EnableScrollableMenus;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;GeminiAIPlugin;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;Skia.Package.VCL;vcldb;InlineErrors;SynEditDR;VirtualTreesR;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;inetstn;TerminalEmulatorDsgn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;TerminalEmulatorPkg;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;HexViewerDesigner;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;EmulVT_Overbyte;BigNumbers;fmxobj;bindcompvclsmp;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + ExecutableExplorer;vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;JSONRPC.Registrar;emsedge;bindcompfmx;XMLSummaryExpert;DBXFirebirdDriver;BuildGroupsColumnFixer;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;soapmidas;vclactnband;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;AsyncProDR;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;EnableDebugVariables;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;GeminiAIPlugin;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;Skia.Package.VCL;vcldb;SynEditDR;VirtualTreesR;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;BigNumbers;fmxobj;bindcompvclsmp;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DEBUG;$(DCC_Define) + true + false + true + true + true + true + true + + + false + PerMonitorV2 + + + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + PerMonitorV2 + + + PerMonitorV2 + + + + MainSource + + +
VisibilityForm
+ dfm + + + +
SelectionTestForm
+ dfm + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + VisibilityTest.dpr + + + + True + True + + + 12 + + + + + diff --git a/Virtual-TreeView.dspec b/Virtual-TreeView.dspec new file mode 100644 index 000000000..2927f96c8 --- /dev/null +++ b/Virtual-TreeView.dspec @@ -0,0 +1,187 @@ +{ + "metadata": { + "id": "JAM.VirtualTreeView", + "version": "8.1.2", + "description": "Virtual TreeView VCL Component", + "authors": "Joachim Marder", + "projectUrl": "https://github.com/JAM-Software/Virtual-TreeView", + "license": "MPL-1.1, LGPL-2.0+", + "copyright": "Various, See project page", + "tags": "VCL, TreeView" + }, + "targetPlatforms": [ + { + "compiler": "10.0", + "platforms": "Win32, Win64", + "template": "default", + "variables" : { + "libsuffix" : "230", + "compiler" : "$compilerNoPoint$" + } + }, + { + "compiler": "10.1", + "platforms": "Win32, Win64", + "template": "default", + "variables" : { + "libsuffix" : "240" + } + }, + { + "compiler": "10.2", + "platforms": "Win32, Win64", + "template": "default", + "variables" : { + "libsuffix" : "250" + } + }, + { + "compiler": "10.3", + "platforms": "Win32, Win64", + "template": "default", + "variables" : { + "libsuffix" : "260" + } + }, + { + "compiler": "10.4", + "platforms": "Win32, Win64", + "template": "10.4+", + "variables" : { + "libsuffix" : "270" + } + }, + { + "compiler": "11.0", + "platforms": "Win32, Win64", + "template": "10.4+", + "variables" : { + "libsuffix" : "280" + } + } + { + "compiler": "12.0", + "platforms": "Win32, Win64", + "template": "10.4+", + "variables" : { + "libsuffix" : "290" + } + } + ], + "templates": [ + { + "comment": "all other compiler versions follow normal folder naming", + "name": "default", + "source": [ + { + "src": ".\\Source\\*.pas", + "dest": "Source" + }, + { + "src": ".\\Source\\*.res", + "dest": "Source" + }, + { + "src": ".\\Design\\*.*", + "dest": "Design" + }, + { + "src": ".\\packages\\Rad Studio $compiler$\\**", + "flatten": false, + "dest": "packages\\Rad Studio $compiler$" + } + ], + "searchPaths": [ + { + "path": "Source", + "source": true + } + ], + "build": [ + { + "id": "VirtualTreesR", + "project": ".\\Packages\\Rad Studio $compiler$\\VirtualTreesR.dproj", + "buildForDesign": true, + "buildForDesignComment" : "when true, will also build win32 if the platform is not win32, so that other packages that need this for design will work" + }, + { + "id": "VirtualTreesD", + "project": ".\\Packages\\Rad Studio $compiler$\\VirtualTreesD.dproj", + "designOnly" : true, + "designOnlyComment" : "designOnly forces compilation with win32 compiler" + } + ], + "runtime": [ + { + "buildId": "VirtualTreesR", + "src": "bin\\VirtualTreesR$libsuffix$.bpl", + "copyLocal": true + } + ], + "design": [ + { + "buildId": "VirtualTreesD", + "src": "bin\\VirtualTreesD$libsuffix$.bpl", + "install": true + } + ] + }, + { + "comment": "10.4+ versions share packages", + "name": "10.4+", + "source": [ + { + "src": ".\\Source\\*.pas", + "dest": "Source" + }, + { + "src": ".\\Source\\*.res", + "dest": "Source" + }, + { + "src": ".\\Design\\*.*", + "dest": "Design" + }, + { + "src": ".\\packages\\Rad Studio 10.4+\\**", + "flatten": false, + "dest": "packages\\Rad Studio $compiler$" + } + ], + "searchPaths": [ + { + "path": "Source", + "source": true + } + ], + "build": [ + { + "id": "VirtualTreesR", + "project": ".\\Packages\\Rad Studio $compiler$\\VirtualTreesR.dproj", + "buildForDesign": true, + "buildForDesignComment" : "when true, will also build win32 if the platform is not win32, so that other packages that need this for design will work" + }, + { + "id": "VirtualTreesD", + "project": ".\\Packages\\Rad Studio $compiler$\\VirtualTreesD.dproj", + "designOnly" : true, + "designOnlyComment" : "designOnly forces compilation with win32 compiler" + } + ], + "runtime": [ + { + "buildId": "VirtualTreesR", + "src": "bin\\VirtualTreesR$libsuffix$.bpl", + "copyLocal": true + } + ], + "design": [ + { + "buildId": "VirtualTreesD", + "src": "bin\\VirtualTreesD$libsuffix$.bpl", + "install": true + } + ] + } + ] +} diff --git a/VirtualTreesDevelopment.groupproj b/VirtualTreesDevelopment.groupproj new file mode 100644 index 000000000..59756a938 --- /dev/null +++ b/VirtualTreesDevelopment.groupproj @@ -0,0 +1,132 @@ + + + {C5F52E84-EC68-4F73-B3AD-3A9611000DFB} + + + + Packages\RAD Studio 10.4+\VirtualTreesR.dproj;Packages\RAD Studio 10.4+\VirtualTreesD.dproj + + + + + + Packages\RAD Studio 10.4+\VirtualTreesR.dproj + + + Packages\RAD Studio 10.4+\VirtualTreesR.dproj;Packages\RAD Studio 10.4+\VirtualTreesD.dproj + + + Packages\RAD Studio 10.4+\VirtualTreesR.dproj;Packages\RAD Studio 10.4+\VirtualTreesD.dproj + + + Packages\RAD Studio 10.4+\VirtualTreesR.dproj;Packages\RAD Studio 10.4+\VirtualTreesD.dproj + + + Packages\RAD Studio 10.4+\VirtualTreesR.dproj;Packages\RAD Studio 10.4+\VirtualTreesD.dproj + + + Packages\RAD Studio 10.4+\VirtualTreesR.dproj;Packages\RAD Studio 10.4+\VirtualTreesD.dproj + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +