You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
34493 lines
1.2 MiB
34493 lines
1.2 MiB
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
|
|
// 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),
|
|
// most code was written by Mike Lischke 2000-2009 (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.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
//
|
|
// For a list of recent changes please see file CHANGES.TXT
|
|
//
|
|
// 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)
|
|
// 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
|
|
// Beta testers:
|
|
// 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)
|
|
// Documentation:
|
|
// Markus Spoettl and toolsfactory GbR (http://www.doc-o-matic.com/, sponsoring Soft Gems development
|
|
// with a free copy of the Doc-O-Matic help authoring system), Sven H. (Step by step tutorial)
|
|
// CLX:
|
|
// Dmitri Dmitrienko (initial developer)
|
|
// Source repository:
|
|
// https://code.google.com/p/virtual-treeview/source/
|
|
// Accessability implementation:
|
|
// Marco Zehe (with help from Sebastian Modersohn)
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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
|
|
|
|
{$I VTConfig.inc}
|
|
|
|
// 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}
|
|
{$if CompilerVersion >= 21} // By Rapid D
|
|
{$IFDEF NO_EXTENDED_RTTI}
|
|
{$WEAKLINKRTTI ON}
|
|
{$RTTI EXPLICIT METHODS([]) FIELDS([]) PROPERTIES([])}
|
|
{$ENDIF}
|
|
{$ifend}
|
|
{$WARN UNSUPPORTED_CONSTRUCT OFF}
|
|
|
|
{$HPPEMIT '#include |
|
{$HPPEMIT '#include |
|
{$HPPEMIT '#include |
|
{$HPPEMIT '#include |
|
{$HPPEMIT '#pragma link "VirtualTreesR.lib"'}
|
|
|
|
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,
|
|
{$IFDEF USE_PRINT} // By Rapid D
|
|
Vcl.Printers,
|
|
{$ENDIF USE_PRINT}
|
|
System.Types, Winapi.CommCtrl, Vcl.Themes, Winapi.UxTheme,
|
|
Winapi.ShlObj, System.UITypes, System.Generics.Collections;
|
|
|
|
const
|
|
VTVersion = '6.2.0';
|
|
|
|
const
|
|
VTTreeStreamVersion = 2;
|
|
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;
|
|
|
|
// Need to use this message to release the edit link interface asynchronously.
|
|
WM_CHANGESTATE = WM_APP + 32;
|
|
|
|
// 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);
|
|
|
|
UtilityImageSize = 16; // Needed by descendants for hittests.
|
|
|
|
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;
|
|
|
|
MMXAvailable: Boolean; // necessary to know because the blend code uses MMX instructions
|
|
IsWinVistaOrAbove: Boolean;
|
|
|
|
{$MinEnumSize 1, make enumerations as small as possible}
|
|
|
|
type
|
|
// 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
|
|
);
|
|
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
|
|
);
|
|
|
|
TCheckImageKind = (
|
|
ckLightCheck, // gray cross
|
|
ckDarkCheck, // black cross
|
|
ckLightTick, // gray tick mark
|
|
ckDarkTick, // black tick mark
|
|
ckFlat, // flat images (no 3D border)
|
|
ckXP, // Windows XP style
|
|
ckCustom, // application defined check images
|
|
ckSystemFlat, // Flat system 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
|
|
);
|
|
|
|
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:
|
|
TVTAnimationOption = (
|
|
toAnimatedToggle, // Expanding and collapsing a node is animated (quick window scroll).
|
|
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.
|
|
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.
|
|
);
|
|
TVTSelectionOptions = set of TVTSelectionOption;
|
|
|
|
// 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;
|
|
|
|
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];
|
|
|
|
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;
|
|
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 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
|
|
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 |
|
procedure SetData(pUserData: Pointer); overload;
|
|
procedure SetData |
|
procedure SetData(const pUserData: IInterface); overload;
|
|
end;
|
|
|
|
|
|
// Structure used when info about a certain position in the header is needed.
|
|
TVTHeaderHitInfo = record
|
|
X,
|
|
Y: Integer;
|
|
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;
|
|
end;
|
|
|
|
// auto scroll directions
|
|
TScrollDirections = set of (
|
|
sdLeft,
|
|
sdUp,
|
|
sdRight,
|
|
sdDown
|
|
);
|
|
|
|
// 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;
|
|
|
|
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
|
|
DefaultHint: string; // used only if there is no node specific hint string available
|
|
// or a header hint is about to appear
|
|
HintText: string; // set when size of the hint window is calculated
|
|
BidiMode: TBidiMode;
|
|
Alignment: TAlignment;
|
|
LineBreakStyle: TVTToolTipLineBreakStyle;
|
|
end;
|
|
|
|
// Determines the kind of animation when a hint is activated.
|
|
THintAnimationType = (
|
|
hatNone, // no animation at all, just display hint/tooltip
|
|
hatFade, // fade in the hint/tooltip, like in Windows 2000
|
|
hatSlide, // slide in the hint/tooltip, like in Windows 98
|
|
hatSystemDefault // use what the system is using (slide for Win9x, slide/fade for Win2K+, depends on settings)
|
|
);
|
|
|
|
// The trees need an own hint window class because of Unicode output and adjusted font.
|
|
TVirtualTreeHintWindow = class(THintWindow)
|
|
private
|
|
FHintData: TVTHintData;
|
|
FBackground,
|
|
FDrawBuffer,
|
|
FTarget: TBitmap;
|
|
FTextHeight: Integer;
|
|
function AnimationCallback(Step, StepSize: Integer; Data: Pointer): Boolean;
|
|
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
|
|
function GetHintWindowDestroyed: Boolean;
|
|
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
|
|
procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
|
|
procedure WMShowWindow(var Message: TWMShowWindow); message WM_SHOWWINDOW;
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure InternalPaint(Step, StepSize: Integer);
|
|
procedure Paint; override;
|
|
|
|
property Background: TBitmap read FBackground;
|
|
property DrawBuffer: TBitmap read FDrawBuffer;
|
|
property HintData: TVTHintData read FHintData;
|
|
property HintWindowDestroyed: Boolean read GetHintWindowDestroyed;
|
|
property Target: TBitmap read FTarget;
|
|
property TextHeight: Integer read FTextHeight;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure ActivateHint(Rect: TRect; const AHint: string); override;
|
|
function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
|
|
function IsHintMsg(var Msg: TMsg): Boolean; override;
|
|
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.
|
|
);
|
|
|
|
// Class to manage header and tree drag image during a drag'n drop operation.
|
|
TVTDragImage = class
|
|
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)
|
|
protected
|
|
procedure InternalShowDragImage(ScreenDC: HDC);
|
|
procedure MakeAlphaChannel(Source, Target: TBitmap);
|
|
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 RecaptureBackground(Tree: TBaseVirtualTree; R: TRect; VisibleRegion: HRGN; CaptureNCArea,
|
|
ReshowDragImage: Boolean);
|
|
procedure ShowDragImage;
|
|
function WillMove(P: TPoint): Boolean;
|
|
|
|
property ColorKey: TColor read FColorKey write FColorKey default clWindow;
|
|
property Fade: Boolean read FFade write FFade default False;
|
|
property MoveRestriction: TVTDragMoveRestriction read FRestriction write FRestriction default dmrNone;
|
|
property PostBlendBias: TVTBias read FPostBlendBias write FPostBlendBias default 0;
|
|
property PreBlendBias: TVTBias read FPreBlendBias write FPreBlendBias default 0;
|
|
property Transparency: TVTTransparency read FTransparency write FTransparency default 128;
|
|
property Visible: Boolean read GetVisible;
|
|
end;
|
|
|
|
// tree columns implementation
|
|
TVirtualTreeColumns = class;
|
|
TVTHeader = class;
|
|
|
|
TVirtualTreeColumnStyle = (
|
|
vsText,
|
|
vsOwnerDraw
|
|
);
|
|
|
|
TVTHeaderColumnLayout = (
|
|
blGlyphLeft,
|
|
blGlyphRight,
|
|
blGlyphTop,
|
|
blGlyphBottom
|
|
);
|
|
|
|
TSortDirection = (
|
|
sdAscending,
|
|
sdDescending
|
|
);
|
|
|
|
TVirtualTreeColumn = class(TCollectionItem)
|
|
private
|
|
FText,
|
|
FHint: string;
|
|
FLeft,
|
|
FWidth: Integer;
|
|
FPosition: TColumnPosition;
|
|
FMinWidth: Integer;
|
|
FMaxWidth: Integer;
|
|
FStyle: TVirtualTreeColumnStyle;
|
|
FImageIndex: TImageIndex;
|
|
FBiDiMode: TBiDiMode;
|
|
FLayout: TVTHeaderColumnLayout;
|
|
FMargin,
|
|
FSpacing: Integer;
|
|
FOptions: TVTColumnOptions;
|
|
FTag: NativeInt;
|
|
FAlignment: TAlignment;
|
|
FCaptionAlignment: TAlignment; // Alignment of the caption.
|
|
FLastWidth: Integer;
|
|
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: Integer;
|
|
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: Integer);
|
|
procedure SetMaxWidth(Value: Integer);
|
|
procedure SetMinWidth(Value: Integer);
|
|
procedure SetOptions(Value: TVTColumnOptions);
|
|
procedure SetPosition(Value: TColumnPosition);
|
|
procedure SetSpacing(Value: Integer);
|
|
procedure SetStyle(Value: TVirtualTreeColumnStyle);
|
|
procedure SetWidth(Value: Integer);
|
|
protected
|
|
procedure ComputeHeaderLayout(DC: HDC; Client: TRect; UseHeaderGlyph, UseSortGlyph: Boolean;
|
|
var HeaderGlyphPos, SortGlyphPos: TPoint; var SortGlyphSize: TSize; var TextBounds: TRect; DrawFormat: Cardinal;
|
|
CalculateTextRect: Boolean = False);
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure GetAbsoluteBounds(var Left, Right: Integer);
|
|
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);
|
|
procedure WriteHint(Writer: TWriter);
|
|
procedure WriteText(Writer: TWriter);
|
|
property HasImage: Boolean read FHasImage;
|
|
property ImageRect: TRect read FImageRect;
|
|
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;
|
|
procedure SaveToStream(const Stream: TStream);
|
|
function UseRightToLeftReading: Boolean;
|
|
|
|
property Left: Integer read GetLeft;
|
|
property Owner: TVirtualTreeColumns read GetOwner;
|
|
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 CaptionText: string read FCaptionText stored False;
|
|
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 stored False;
|
|
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
|
|
property Layout: TVTHeaderColumnLayout read FLayout write SetLayout default blGlyphLeft;
|
|
property Margin: Integer read FMargin write SetMargin default 4;
|
|
property MaxWidth: Integer read FMaxWidth write SetMaxWidth default 10000;
|
|
property MinWidth: Integer read FMinWidth write SetMinWidth default 10;
|
|
property Options: TVTColumnOptions read FOptions write SetOptions default DefaultColumnOptions;
|
|
property Position: TColumnPosition read FPosition write SetPosition;
|
|
property Spacing: Integer 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 stored False; // Never let the VCL store the wide string, // [IPK] FText changed to GetText
|
|
// it is simply unable to write it correctly.
|
|
// We use DefineProperties here.
|
|
property Width: Integer 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: Integer; // 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: Integer);
|
|
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: Integer; Relative: Boolean = True): Integer;
|
|
function GetOwner: TPersistent; override;
|
|
procedure HandleClick(P: TPoint; Button: TMouseButton; Force, DblClick: Boolean); virtual;
|
|
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: Integer);
|
|
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: Integer);
|
|
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: Integer;
|
|
function GetVisibleColumns: TColumnsArray;
|
|
function GetVisibleFixedWidth: Integer;
|
|
function IsValidColumn(Column: TColumnIndex): Boolean;
|
|
procedure LoadFromStream(const Stream: TStream; Version: Integer);
|
|
procedure PaintHeader(DC: HDC; R: TRect; HOffset: Integer); overload; virtual;
|
|
procedure PaintHeader(TargetCanvas: TCanvas; R: TRect; const Target: TPoint;
|
|
RTLOffset: Integer = 0); overload; virtual;
|
|
procedure SaveToStream(const Stream: TStream);
|
|
function TotalWidth: Integer;
|
|
|
|
property Count: Integer read GetCount;
|
|
property ClickIndex: TColumnIndex read FClickIndex;
|
|
property DefaultWidth: Integer read FDefaultWidth write SetDefaultWidth default 50;
|
|
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: Integer;
|
|
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: Integer;
|
|
FMinHeight: Integer;
|
|
FDefaultHeight: Integer;
|
|
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: Integer; // For property SplitterHitTolerance
|
|
FSortColumn: TColumnIndex;
|
|
FSortDirection: TSortDirection;
|
|
FDragImage: TVTDragImage; // drag image management during header drag
|
|
FLastWidth: Integer; // Used to adjust spring columns. This is the width of all visible columns,
|
|
// not the header rectangle.
|
|
procedure FontChanged(Sender: TObject);
|
|
function GetMainColumn: TColumnIndex;
|
|
function GetUseColumns: Boolean;
|
|
function IsFontStored: Boolean;
|
|
procedure SetAutoSizeIndex(Value: TColumnIndex);
|
|
procedure SetBackground(Value: TColor);
|
|
procedure SetColumns(Value: TVirtualTreeColumns);
|
|
procedure SetDefaultHeight(Value: Integer);
|
|
procedure SetFont(const Value: TFont);
|
|
procedure SetHeight(Value: Integer);
|
|
procedure SetImages(const Value: TCustomImageList);
|
|
procedure SetMainColumn(Value: TColumnIndex);
|
|
procedure SetMaxHeight(Value: Integer);
|
|
procedure SetMinHeight(Value: Integer);
|
|
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.
|
|
|
|
function CanSplitterResize(P: TPoint): Boolean;
|
|
function CanWriteColumns: Boolean; virtual;
|
|
procedure ChangeScale(M, D: Integer); 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); 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);
|
|
{$IFDEF USE_VT_SAVES} // By Rapid D
|
|
procedure LoadFromStream(const Stream: TStream); virtual;
|
|
procedure SaveToStream(const Stream: TStream); virtual;
|
|
{$ENDIF USE_VT_SAVES}
|
|
function ResizeColumns(ChangeBy: Integer; RangeStartCol: TColumnIndex; RangeEndCol: TColumnIndex;
|
|
Options: TVTColumnOptions = [coVisible]): Integer;
|
|
procedure RestoreColumns;
|
|
|
|
property DragImage: TVTDragImage read FDragImage;
|
|
property States: THeaderStates read FStates;
|
|
property Treeview: TBaseVirtualTree read FOwner;
|
|
property UseColumns: Boolean read GetUseColumns;
|
|
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 False;
|
|
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.
|
|
function GetBounds: TRect; stdcall; // Called to get the current size of the edit window
|
|
// (only important if the edit resizes itself).
|
|
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).
|
|
);
|
|
|
|
// Used during owner draw of the header to indicate which drop mark for the column must be drawn.
|
|
TVTDropMarkMode = (
|
|
dmmNone,
|
|
dmmLeft,
|
|
dmmRight
|
|
);
|
|
|
|
// 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;
|
|
end;
|
|
|
|
// 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
|
|
);
|
|
|
|
// Various events must be handled at different places than they were initiated or need
|
|
// a persistent storage until they are reset.
|
|
TVirtualTreeStates = set of (
|
|
tsCancelHintAnimation, // Set when a new hint is about to show but an old hint is still being animated.
|
|
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.
|
|
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.
|
|
tsKeyCheckPending, // A check operation is under way, initiated by a key press (space key). Ignore mouse.
|
|
tsLeftButtonDown, // Set when the left mouse button is down.
|
|
tsLeftDblClick, // Set when the left mouse button was doubly clicked.
|
|
tsMouseCheckPending, // A check operation is under way, initiated by a mouse click. Ignore space key.
|
|
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
|
|
);
|
|
|
|
TChangeStates = set of (
|
|
csStopValidation, // Cache validation can be stopped (usually because a change has occured meanwhile).
|
|
csUseCache, // The tree's node caches are validated and non-empty.
|
|
csValidating, // The tree's node caches are currently validated.
|
|
csValidationNeeded // Something in the structure of the tree has changed. The cache needs validation.
|
|
);
|
|
|
|
// 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
|
|
etCustom // supported by external tools
|
|
);
|
|
|
|
TVTNodeExportEvent = function (Sender: TBaseVirtualTree; aExportType: TVTExportType; Node: PVirtualNode): Boolean 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
|
|
FOwner: TBaseVirtualTree;
|
|
FColors: array[0..16] of TColor; // [IPK] 15 -> 16
|
|
function GetColor(const Index: Integer): TColor;
|
|
procedure SetColor(const Index: Integer; const Value: TColor);
|
|
function GetBackgroundColor: TColor;
|
|
function GetHeaderFontColor: TColor;
|
|
function GetNodeFontColor: 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 7 read GetColor write SetColor default clBtnFace;
|
|
property DisabledColor: TColor index 0 read GetColor write SetColor default clBtnShadow;
|
|
property DropMarkColor: TColor index 1 read GetColor write SetColor default clHighlight;
|
|
property DropTargetColor: TColor index 2 read GetColor write SetColor default clHighLight;
|
|
property DropTargetBorderColor: TColor index 11 read GetColor write SetColor default clHighLight;
|
|
property FocusedSelectionColor: TColor index 3 read GetColor write SetColor default clHighLight;
|
|
property FocusedSelectionBorderColor: TColor index 9 read GetColor write SetColor default clHighLight;
|
|
property GridLineColor: TColor index 4 read GetColor write SetColor default clBtnFace;
|
|
property HeaderHotColor: TColor index 14 read GetColor write SetColor default clBtnShadow;
|
|
property HotColor: TColor index 8 read GetColor write SetColor default clWindowText;
|
|
property SelectionRectangleBlendColor: TColor index 12 read GetColor write SetColor default clHighlight;
|
|
property SelectionRectangleBorderColor: TColor index 13 read GetColor write SetColor default clHighlight;
|
|
property SelectionTextColor: TColor index 15 read GetColor write SetColor default clHighlightText;
|
|
property TreeLineColor: TColor index 5 read GetColor write SetColor default clBtnShadow;
|
|
property UnfocusedColor: TColor index 16 read GetColor write SetColor default clBtnFace; // [IPK] Added
|
|
property UnfocusedSelectionColor: TColor index 6 read GetColor write SetColor default clBtnFace;
|
|
property UnfocusedSelectionBorderColor: TColor index 10 read GetColor write SetColor default clBtnFace;
|
|
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: Integer; // 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, // the node cell
|
|
ContentRect: TRect; // the area of the cell used for the node's content
|
|
NodeWidth: Integer; // 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
|
|
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;
|
|
|
|
// header/column events
|
|
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;
|
|
FCanModeNext: 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
|
|
FAnimationType: THintAnimationType; // none, fade in, slide in animation (just like those animations used
|
|
// 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
|
|
FCheckNode: PVirtualNode; // node which "captures" a check event
|
|
FPendingCheckState: TCheckState; // the new state the check node will get if all went fine
|
|
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.
|
|
FMargin: Integer; // horizontal border distance
|
|
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.
|
|
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.
|
|
FSingletonNodeArray: TNodeArray; // Contains only one element for quick addition of single nodes
|
|
// to the selection.
|
|
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
|
|
{$IFDEF MSAASupport} // By Rapid D
|
|
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.
|
|
{$ENDIF MSAASupport} // By Rapid D
|
|
|
|
// export
|
|
{$IFDEF USE_VST} // By Rapid D
|
|
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
|
|
{$ENDIF USE_VST}
|
|
// 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)
|
|
{$IFDEF USE_VT_SAVES} // By Rapid D
|
|
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
|
|
{$ENDIF USE_VT_SAVES}
|
|
// header/column mouse events
|
|
FOnAfterAutoFitColumn: TVTAfterAutoFitColumnEvent;
|
|
FOnAfterAutoFitColumns: TVTAfterAutoFitColumnsEvent;
|
|
FOnBeforeAutoFitColumns: TVTBeforeAutoFitColumnsEvent;
|
|
FOnBeforeAutoFitColumn: TVTBeforeAutoFitColumnEvent;
|
|
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.
|
|
|
|
// 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 AdjustCoordinatesByIndent(var PaintInfo: TVTPaintInfo; Indent: Integer);
|
|
procedure AdjustTotalCount(Node: PVirtualNode; Value: Integer; relative: Boolean = False);
|
|
procedure AdjustTotalHeight(Node: PVirtualNode; Value: Integer; relative: Boolean = False);
|
|
function CalculateCacheEntryCount: Integer;
|
|
procedure CalculateVerticalAlignments(ShowImages, ShowStateImages: Boolean; Node: PVirtualNode; var VAlign,
|
|
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 GetCheckedCount: Integer;
|
|
function GetCheckState(Node: PVirtualNode): TCheckState;
|
|
function GetCheckType(Node: PVirtualNode): TCheckType;
|
|
function GetChildCount(Node: PVirtualNode): Cardinal;
|
|
function GetChildrenInitialized(Node: PVirtualNode): Boolean;
|
|
function GetCutCopyCount: Integer;
|
|
function GetDisabled(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;
|
|
procedure HandleClickSelection(LastFocused, NewNode: PVirtualNode; Shift: TShiftState; DragPending: 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 ReadOldOptions(Reader: TReader);
|
|
procedure SetAlignment(const Value: TAlignment);
|
|
procedure SetAnimationDuration(const Value: Cardinal);
|
|
procedure SetBackground(const Value: TPicture);
|
|
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 SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal);
|
|
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 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 StaticBackground(Source: TBitmap; Target: TCanvas; OffsetPosition: TPoint; R: TRect);
|
|
procedure StopTimer(ID: Integer);
|
|
procedure SetWindowTheme(const Theme: string);
|
|
procedure TileBackground(Source: TBitmap; Target: TCanvas; Offset: TPoint; R: TRect);
|
|
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 WMChangeState(var Message: TMessage); message WM_CHANGESTATE;
|
|
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(); virtual;
|
|
procedure AddToSelection(Node: PVirtualNode); overload; virtual;
|
|
procedure AddToSelection(const NewItems: TNodeArray; NewLength: Integer; ForceInsert: Boolean = False); overload; virtual;
|
|
procedure AdjustImageBorder(Images: TCustomImageList; BidiMode: TBidiMode; VAlign: Integer; var R: TRect;
|
|
var ImageInfo: TVTImageInfo); 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: TChangeStates);
|
|
procedure ChangeScale(M, D: Integer); override;
|
|
function CheckParentCheckState(Node: PVirtualNode; NewCheckState: TCheckState): Boolean; 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 DoGetAnimationType: THintAnimationType; 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 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 GetCheckImage(Node: PVirtualNode; ImgCheckType: TCheckType = ctNone;
|
|
ImgCheckState: TCheckState = csUncheckedNormal; ImgEnabled: Boolean = True): Integer; virtual;
|
|
class function GetCheckImageListFor(Kind: TCheckImageKind): TCustomImageList; 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;
|
|
DefaultImages: TCustomImageList); virtual;
|
|
function GetNodeImageSize(Node: PVirtualNode): TSize; virtual;
|
|
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;
|
|
function HasImage(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex): Boolean; virtual;
|
|
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; VAlignment, 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 SetFocusedNodeAndColumn(Node: PVirtualNode; Column: TColumnIndex); virtual;
|
|
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 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 default ckSystemDefault;
|
|
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 HintAnimation: THintAnimationType read FAnimationType write FAnimationType default hatSystemDefault;
|
|
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 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 OnAfterColumnWidthTracking: TVTAfterColumnWidthTrackingEvent read FOnAfterColumnWidthTracking write FOnAfterColumnWidthTracking;
|
|
property OnAfterGetMaxColumnWidth: TVTAfterGetMaxColumnWidthEvent read FOnAfterGetMaxColumnWidth write FOnAfterGetMaxColumnWidth;
|
|
property OnAfterHeaderHeightTracking: TVTAfterHeaderHeightTrackingEvent read FOnAfterHeaderHeightTracking
|
|
write FOnAfterHeaderHeightTracking;
|
|
property OnAfterItemErase: TVTAfterItemEraseEvent read FOnAfterItemErase write FOnAfterItemErase;
|
|
property OnAfterItemPaint: TVTAfterItemPaintEvent read FOnAfterItemPaint write FOnAfterItemPaint;
|
|
property OnAfterPaint: TVTPaintEvent read FOnAfterPaint write FOnAfterPaint;
|
|
property OnBeforeAutoFitColumn: TVTBeforeAutoFitColumnEvent read FOnBeforeAutoFitColumn write FOnBeforeAutoFitColumn;
|
|
property OnBeforeAutoFitColumns: TVTBeforeAutoFitColumnsEvent read FOnBeforeAutoFitColumns write FOnBeforeAutoFitColumns;
|
|
property OnBeforeCellPaint: TVTBeforeCellPaintEvent read FOnBeforeCellPaint write FOnBeforeCellPaint;
|
|
property OnBeforeColumnWidthTracking: TVTBeforeColumnWidthTrackingEvent read FOnBeforeColumnWidthTracking
|
|
write FOnBeforeColumnWidthTracking;
|
|
property OnBeforeDrawTreeLine: TVTBeforeDrawLineImageEvent read FOnBeforeDrawLineImage write FOnBeforeDrawLineImage;
|
|
property OnBeforeGetMaxColumnWidth: TVTBeforeGetMaxColumnWidthEvent read FOnBeforeGetMaxColumnWidth write FOnBeforeGetMaxColumnWidth;
|
|
property OnBeforeHeaderHeightTracking: TVTBeforeHeaderHeightTrackingEvent read FOnBeforeHeaderHeightTracking
|
|
write FOnBeforeHeaderHeightTracking;
|
|
property OnBeforeItemErase: TVTBeforeItemEraseEvent read FOnBeforeItemErase write FOnBeforeItemErase;
|
|
property OnBeforeItemPaint: TVTBeforeItemPaintEvent read FOnBeforeItemPaint write FOnBeforeItemPaint;
|
|
property OnBeforePaint: TVTPaintEvent read FOnBeforePaint write FOnBeforePaint;
|
|
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 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 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;
|
|
{$IFDEF USE_VT_SAVES} // By Rapid D
|
|
property OnLoadNode: TVTSaveNodeEvent read FOnLoadNode write FOnLoadNode;
|
|
property OnLoadTree: TVTSaveTreeEvent read FOnLoadTree write FOnLoadTree;
|
|
{$ENDIF USE_VT_SAVES}
|
|
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 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;
|
|
{$IFDEF USE_VT_SAVES} // By Rapid D
|
|
property OnSaveNode: TVTSaveNodeEvent read FOnSaveNode write FOnSaveNode;
|
|
property OnSaveTree: TVTSaveTreeEvent read FOnSaveTree write FOnSaveTree;
|
|
{$ENDIF USE_VT_SAVES}
|
|
property OnScroll: TVTScrollEvent read FOnScroll write FOnScroll;
|
|
property OnShowScrollBar: TVTScrollBarShowEvent read FOnShowScrollBar write FOnShowScrollBar;
|
|
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;
|
|
{$IFDEF USE_VST} // By Rapid D
|
|
property OnAfterColumnExport : TVTColumnExportEvent read FOnAfterColumnExport write FOnAfterColumnExport;
|
|
property OnAfterHeaderExport: TVTTreeExportEvent read FOnAfterHeaderExport write FOnAfterHeaderExport;
|
|
property OnAfterNodeExport: TVTNodeExportEvent read FOnAfterNodeExport write FOnAfterNodeExport;
|
|
property OnAfterTreeExport: TVTTreeExportEvent read FOnAfterTreeExport write FOnAfterTreeExport;
|
|
property OnBeforeColumnExport: TVTColumnExportEvent read FOnBeforeColumnExport write FOnBeforeColumnExport;
|
|
property OnBeforeHeaderExport: TVTTreeExportEvent read FOnBeforeHeaderExport write FOnBeforeHeaderExport;
|
|
property OnBeforeNodeExport: TVTNodeExportEvent read FOnBeforeNodeExport write FOnBeforeNodeExport;
|
|
property OnBeforeTreeExport: TVTTreeExportEvent read FOnBeforeTreeExport write FOnBeforeTreeExport;
|
|
property OnColumnExport : TVTColumnExportEvent read FOnColumnExport write FOnColumnExport;
|
|
property OnNodeExport: TVTNodeExportEvent read FOnNodeExport write FOnNodeExport;
|
|
{$ENDIF USE_VST}
|
|
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;
|
|
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 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 |
|
function GetSelectedData |
|
function GetInterfaceFromNodeData |
|
function GetNodeDataAt |
|
function GetFirstSelectedNodeData |
|
function GetNodeLevel(Node: PVirtualNode): Cardinal;
|
|
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;
|
|
function IterateSubtree(Node: PVirtualNode; Callback: TVTGetNodeProc; Data: Pointer; Filter: TVirtualNodeStates = [];
|
|
DoInit: Boolean = False; ChildNodesOnly: Boolean = False): PVirtualNode;
|
|
{$IFDEF USE_VT_SAVES} // By Rapid D
|
|
procedure LoadFromFile(const FileName: TFileName); virtual;
|
|
procedure LoadFromStream(Stream: TStream); virtual;
|
|
{$ENDIF USE_VT_SAVES}
|
|
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);
|
|
{$IFDEF USE_PRINT} // By Rapid D
|
|
procedure Print(Printer: TPrinter; PrintHeader: Boolean);
|
|
{$ENDIF USE_PRINT}
|
|
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 ReinitNode(Node: PVirtualNode; Recursive: Boolean); virtual;
|
|
procedure ResetNode(Node: PVirtualNode); virtual;
|
|
{$IFDEF USE_VT_SAVES} // By Rapid D
|
|
procedure SaveToFile(const FileName: TFileName);
|
|
procedure SaveToStream(Stream: TStream; Node: PVirtualNode = nil); virtual;
|
|
{$ENDIF USE_VT_SAVES}
|
|
function ScrollIntoView(Node: PVirtualNode; Center: Boolean; Horizontally: Boolean = False): Boolean; overload;
|
|
function ScrollIntoView(Column: TColumnIndex; Center: Boolean): Boolean; overload;
|
|
procedure SelectAll(VisibleOnly: Boolean);
|
|
procedure SetCheckStateForAll(aCheckState: TCheckState; pSelectedOnly: Boolean);
|
|
procedure SetNodeData(pNode: PVirtualNode; pUserData: Pointer); overload; inline;
|
|
procedure SetNodeData(pNode: PVirtualNode; const pUserData: IInterface); overload; inline;
|
|
procedure SetNodeData |
|
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;
|
|
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;
|
|
|
|
{$IFDEF MSAASupport} // By Rapid D
|
|
property Accessible: IAccessible read FAccessible write FAccessible;
|
|
property AccessibleItem: IAccessible read FAccessibleItem write FAccessibleItem;
|
|
property AccessibleName: string read FAccessibleName write FAccessibleName;
|
|
{$ENDIF MSAASupport}
|
|
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;
|
|
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
|
|
{$IFDEF USE_VST} // By Rapid D
|
|
// 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;
|
|
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;
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
public
|
|
constructor Create(Link: TStringEditLink); reintroduce;
|
|
|
|
procedure Release; virtual;
|
|
|
|
property AutoSelect;
|
|
property AutoSize;
|
|
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
|
|
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 SetDefaultText(const Value: string);
|
|
procedure SetOptions(const Value: TCustomStringTreeOptions);
|
|
procedure SetText(Node: PVirtualNode; Column: TColumnIndex; const Value: string);
|
|
procedure WriteText(Writer: TWriter);
|
|
|
|
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 WriteChunks(Stream: TStream; Node: PVirtualNode); override;
|
|
|
|
property DefaultText: string read FDefaultText write SetDefaultText stored False;
|
|
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); override;
|
|
procedure RemoveFromSelection(Node: PVirtualNode); override;
|
|
function SaveToCSVFile(const FileNameWithPath : TFileName; const IncludeHeading : Boolean) : Boolean;
|
|
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;
|
|
published
|
|
property AccessibleName;
|
|
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 CheckImageKind;
|
|
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 HintAnimation;
|
|
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 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 OnDrawText;
|
|
property OnEditCancelled;
|
|
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 OnGetCellText;
|
|
property OnGetCellIsEmpty;
|
|
property OnGetCursor;
|
|
property OnGetHeaderCursor;
|
|
property OnGetText;
|
|
property OnPaintText;
|
|
property OnGetHelpContext;
|
|
property OnGetHintKind;
|
|
property OnGetHintSize;
|
|
property OnGetImageIndex;
|
|
property OnGetImageIndexEx;
|
|
property OnGetImageText;
|
|
property OnGetHint;
|
|
property OnGetLineStyle;
|
|
property OnGetNodeDataSize;
|
|
property OnGetPopupMenu;
|
|
property OnGetUserClipboardFormats;
|
|
property OnHeaderClick;
|
|
property OnHeaderDblClick;
|
|
property OnHeaderDragged;
|
|
property OnHeaderDraggedOut;
|
|
property OnHeaderDragging;
|
|
property OnHeaderDraw;
|
|
property OnHeaderDrawQueryElements;
|
|
property OnHeaderHeightDblClickResize;
|
|
property OnHeaderHeightTracking;
|
|
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 OnMeasureTextWidth;
|
|
property OnMeasureTextHeight;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnNewText;
|
|
property OnNodeClick;
|
|
property OnNodeCopied;
|
|
property OnNodeCopying;
|
|
property OnNodeDblClick;
|
|
property OnNodeExport;
|
|
property OnNodeHeightDblClickResize;
|
|
property OnNodeHeightTracking;
|
|
property OnNodeMoved;
|
|
property OnNodeMoving;
|
|
property OnPaintBackground;
|
|
property OnPrepareButtonBitmaps;
|
|
property OnRemoveFromSelection;
|
|
property OnRenderOLEData;
|
|
property OnResetNode;
|
|
property OnResize;
|
|
property OnSaveNode;
|
|
property OnSaveTree;
|
|
property OnScroll;
|
|
property OnShortenString;
|
|
property OnShowScrollBar;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property OnStartOperation;
|
|
property OnStateChange;
|
|
property OnStructureChange;
|
|
property OnUpdating;
|
|
property OnCanResize;
|
|
property OnGesture;
|
|
property Touch;
|
|
end;
|
|
{$ENDIF USE_VST}
|
|
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;
|
|
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 CheckImageKind;
|
|
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 HintAnimation;
|
|
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 OnAfterColumnWidthTracking;
|
|
property OnAfterGetMaxColumnWidth;
|
|
property OnAfterHeaderHeightTracking;
|
|
property OnAfterItemErase;
|
|
property OnAfterItemPaint;
|
|
property OnAfterPaint;
|
|
property OnBeforeAutoFitColumn;
|
|
property OnBeforeAutoFitColumns;
|
|
property OnBeforeCellPaint;
|
|
property OnBeforeColumnWidthTracking;
|
|
property OnBeforeDrawTreeLine;
|
|
property OnBeforeGetMaxColumnWidth;
|
|
property OnBeforeHeaderHeightTracking;
|
|
property OnBeforeItemErase;
|
|
property OnBeforeItemPaint;
|
|
property OnBeforePaint;
|
|
property OnCanSplitterResizeColumn;
|
|
property OnCanSplitterResizeHeader;
|
|
property OnCanSplitterResizeNode;
|
|
property OnChange;
|
|
property OnChecked;
|
|
property OnChecking;
|
|
property OnClick;
|
|
property OnCollapsed;
|
|
property OnCollapsing;
|
|
property OnColumnClick;
|
|
property OnColumnDblClick;
|
|
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 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;
|
|
{$IFDEF USE_VT_SAVES} // By Rapid D
|
|
property OnLoadNode;
|
|
property OnLoadTree;
|
|
{$ENDIF USE_VT_SAVES}
|
|
property OnMeasureItem;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnNodeClick;
|
|
property OnNodeCopied;
|
|
property OnNodeCopying;
|
|
property OnNodeDblClick;
|
|
property OnNodeHeightTracking;
|
|
property OnNodeHeightDblClickResize;
|
|
property OnNodeMoved;
|
|
property OnNodeMoving;
|
|
property OnPaintBackground;
|
|
property OnPrepareButtonBitmaps;
|
|
property OnRemoveFromSelection;
|
|
property OnRenderOLEData;
|
|
property OnResetNode;
|
|
property OnResize;
|
|
{$IFDEF USE_VT_SAVES} // By Rapid D
|
|
property OnSaveNode;
|
|
property OnSaveTree;
|
|
{$ENDIF USE_VT_SAVES}
|
|
property OnScroll;
|
|
property OnShowScrollBar;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property OnStartOperation;
|
|
property OnStateChange;
|
|
property OnStructureChange;
|
|
property OnUpdating;
|
|
property OnCanResize;
|
|
property OnGesture;
|
|
property Touch;
|
|
property StyleElements;
|
|
{$IFDEF USE_VST} // By Rapid D
|
|
property OnAfterColumnExport;
|
|
property OnAfterHeaderExport;
|
|
property OnAfterNodeExport;
|
|
property OnAfterTreeExport;
|
|
property OnBeforeColumnExport;
|
|
property OnBeforeHeaderExport;
|
|
property OnBeforeNodeExport;
|
|
property OnBeforeTreeExport;
|
|
property OnColumnExport;
|
|
property OnNodeExport;
|
|
{$ENDIF USE_VST}
|
|
end;
|
|
|
|
|
|
|
|
// utility routines
|
|
function TreeFromNode(Node: PVirtualNode): TBaseVirtualTree;
|
|
|
|
function GetUtilityImages: TCustomImageList;
|
|
procedure ShowError(const Msg: string; HelpContext: Integer); // [IPK] Surface this to interface
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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
|
|
Vcl.ActnList,
|
|
Vcl.StdActns, // for standard action support
|
|
System.StrUtils,
|
|
VTAccessibilityFactory,
|
|
Vcl.GraphUtil, // accessibility helper class
|
|
VirtualTrees.StyleHooks,
|
|
VirtualTrees.Classes,
|
|
VirtualTrees.WorkerThread,
|
|
VirtualTrees.ClipBoard,
|
|
{$IFDEF USE_VST} // By Rapid D
|
|
VirtualTrees.Export,
|
|
{$ENDIF USE_VST}
|
|
VirtualTrees.Utils, VTHeaderPopup;
|
|
|
|
|
|
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
|
|
|
|
// Lookup to quickly convert a specific check state into its pressed counterpart and vice versa.
|
|
PressedState: array[TCheckState] of TCheckState = (
|
|
csUncheckedPressed, csUncheckedPressed, csCheckedPressed, csCheckedPressed, csMixedPressed, csMixedPressed
|
|
);
|
|
UnpressedState: array[TCheckState] of TCheckState = (
|
|
csUncheckedNormal, csUncheckedNormal, csCheckedNormal, csCheckedNormal, csMixedNormal, csMixedNormal
|
|
);
|
|
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 Mike Lischke';
|
|
|
|
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
|
|
Watcher: TCriticalSection;
|
|
LightCheckImages, // global light check images
|
|
DarkCheckImages, // global heavy check images
|
|
LightTickImages, // global light tick images
|
|
DarkTickImages, // global heavy check images
|
|
FlatImages, // global flat check images
|
|
XPImages, // global XP style check images
|
|
UtilityImages, // some small additional images (e.g for header dragging)
|
|
SystemCheckImages, // global system check images
|
|
SystemFlatCheckImages: TImageList; // global flat system check images
|
|
Initialized: Boolean = False; // True if global structures have been initialized.
|
|
NeedToUnitialize: Boolean = False; // True if the OLE subsystem could be initialized successfully.
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
//----------------- utility functions ----------------------------------------------------------------------------------
|
|
|
|
function GetUtilityImages: TCustomImageList; // [IPK]
|
|
|
|
begin
|
|
Result := UtilityImages;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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
|
|
Images,
|
|
OneImage: TBitmap;
|
|
I: Integer;
|
|
MaskColor: TColor;
|
|
Source,
|
|
Dest: TRect;
|
|
a: Integer; // By Rapid D
|
|
begin
|
|
Watcher.Enter;
|
|
try
|
|
// Since we want the image list appearing in the correct system colors, we have to remap its colors.
|
|
Images := TBitmap.Create;
|
|
OneImage := TBitmap.Create;
|
|
if ColorRemapping then
|
|
Images.Handle := CreateMappedRes(FindClassHInstance(TBaseVirtualTree), PChar(ImageName), Grays, SysGrays)
|
|
else
|
|
Images.Handle := LoadBitmap(FindClassHInstance(TBaseVirtualTree), PChar(ImageName));
|
|
|
|
try
|
|
Assert(Images.Height > 0, 'Internal image "' + ImageName + '" is missing or corrupt.');
|
|
if Images.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;
|
|
a := Images.Height; // By Rapid D
|
|
IL.SetSize(a, a); // By Rapid D
|
|
OneImage.SetSize(a, a); // By Rapid D
|
|
MaskColor := Images.Canvas.Pixels[0, 0]; // this is usually clFuchsia
|
|
Dest := Rect(0, 0, IL.Width, IL.Height);
|
|
for I := 0 to (Images.Width div Images.Height) - 1 do
|
|
begin
|
|
Source := Rect(I * IL.Width, 0, (I + 1) * IL.Width, IL.Height);
|
|
OneImage.Canvas.CopyRect(Dest, Images.Canvas, Source);
|
|
IL.AddMasked(OneImage, MaskColor);
|
|
end;
|
|
finally
|
|
Images.Free;
|
|
OneImage.Free;
|
|
end;
|
|
finally
|
|
Watcher.Leave;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure CreateSystemImageSet(var IL: TImageList; Flags: Cardinal; Flat: Boolean);
|
|
|
|
// 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;
|
|
|
|
var
|
|
BM: TBitmap;
|
|
|
|
//--------------- local functions -------------------------------------------
|
|
|
|
procedure AddNodeImages(IL: TImageList);
|
|
|
|
var
|
|
I: Integer;
|
|
OffsetX,
|
|
OffsetY: Integer;
|
|
|
|
begin
|
|
// The offsets are used to center the node images in case the sizes differ.
|
|
OffsetX := (IL.Width - DarkCheckImages.Width) div 2;
|
|
OffsetY := (IL.Height - DarkCheckImages.Height) div 2;
|
|
for I := 21 to 24 do
|
|
begin
|
|
BM.Canvas.FillRect(Rect(0, 0, BM.Width, BM.Height));
|
|
if Flat then
|
|
FlatImages.Draw(BM.Canvas, OffsetX, OffsetY, I)
|
|
else
|
|
DarkCheckImages.Draw(BM.Canvas, OffsetX, OffsetY, I);
|
|
IL.AddMasked(BM, MaskColor);
|
|
end;
|
|
end;
|
|
|
|
//---------------------------------------------------------------------------
|
|
|
|
procedure AddSystemImage(IL: TImageList; Index: Integer);
|
|
|
|
var
|
|
ButtonState: Cardinal;
|
|
ButtonType: Cardinal;
|
|
|
|
begin
|
|
BM.Canvas.FillRect(Rect(0, 0, BM.Width, BM.Height));
|
|
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(1, 2, BM.Width - 2, BM.Height - 1), DFC_BUTTON, ButtonType or ButtonState);
|
|
IL.AddMasked(BM, MaskColor);
|
|
end;
|
|
|
|
//--------------- end local functions ---------------------------------------
|
|
|
|
var
|
|
I, Width, Height: Integer;
|
|
|
|
begin
|
|
Width := GetSystemMetrics(SM_CXMENUCHECK) + 3;
|
|
Height := GetSystemMetrics(SM_CYMENUCHECK) + 3;
|
|
IL := TImageList.CreateSize(Width, Height);
|
|
with IL do
|
|
Handle := ImageList_Create(Width, Height, Flags, 0, AllocBy);
|
|
IL.Masked := True;
|
|
IL.BkColor := clWhite;
|
|
|
|
// Create a temporary bitmap, which holds the intermediate images.
|
|
BM := TBitmap.Create;
|
|
try
|
|
// Make the bitmap the same size as the image list is to avoid problems when adding.
|
|
BM.SetSize(IL.Width, IL.Height); // By Rapid D
|
|
BM.Canvas.Brush.Color := MaskColor;
|
|
BM.Canvas.Brush.Style := bsSolid;
|
|
BM.Canvas.FillRect(Rect(0, 0, BM.Width, BM.Height));
|
|
IL.AddMasked(BM, MaskColor);
|
|
|
|
// Add the 20 system checkbox and radiobutton images.
|
|
for I := 0 to 19 do
|
|
AddSystemImage(IL, I);
|
|
// Add the 4 node images from the dark check set.
|
|
AddNodeImages(IL);
|
|
|
|
finally
|
|
BM.Free;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
|
|
|
|
procedure InitializeGlobalStructures;
|
|
|
|
// initialization of stuff global to the unit
|
|
|
|
var
|
|
Flags: Cardinal;
|
|
|
|
begin
|
|
Initialized := True;
|
|
|
|
// For the drag image a fast MMX blend routine is used. We have to make sure MMX is available.
|
|
MMXAvailable := HasMMX;
|
|
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);
|
|
|
|
// Load all internal image lists and convert their colors to current desktop color scheme.
|
|
// In order to use high color images we have to create the image list handle ourselves.
|
|
Flags := ILC_COLOR32 or ILC_MASK;
|
|
LightCheckImages := TImageList.Create(nil);
|
|
with LightCheckImages do
|
|
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
|
|
ConvertImageList(LightCheckImages, 'VT_CHECK_LIGHT');
|
|
|
|
DarkCheckImages := TImageList.CreateSize(16, 16);
|
|
with DarkCheckImages do
|
|
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
|
|
ConvertImageList(DarkCheckImages, 'VT_CHECK_DARK');
|
|
|
|
LightTickImages := TImageList.CreateSize(16, 16);
|
|
with LightTickImages do
|
|
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
|
|
ConvertImageList(LightTickImages, 'VT_TICK_LIGHT');
|
|
|
|
DarkTickImages := TImageList.CreateSize(16, 16);
|
|
with DarkTickImages do
|
|
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
|
|
ConvertImageList(DarkTickImages, 'VT_TICK_DARK');
|
|
|
|
FlatImages := TImageList.CreateSize(16, 16);
|
|
with FlatImages do
|
|
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
|
|
ConvertImageList(FlatImages, 'VT_FLAT');
|
|
|
|
XPImages := TImageList.CreateSize(16, 16);
|
|
with XPImages do
|
|
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
|
|
ConvertImageList(XPImages, 'VT_XP', False);
|
|
|
|
UtilityImages := TImageList.CreateSize(UtilityImageSize, UtilityImageSize);
|
|
with UtilityImages do
|
|
Handle := ImageList_Create(UtilityImageSize, UtilityImageSize, Flags, 0, AllocBy);
|
|
ConvertImageList(UtilityImages, 'VT_UTILITIES');
|
|
|
|
CreateSystemImageSet(SystemCheckImages, Flags, False);
|
|
CreateSystemImageSet(SystemFlatCheckImages, Flags, True);
|
|
|
|
// 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.
|
|
{$IFDEF USE_VST} // By Rapid D
|
|
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);
|
|
{$ENDIF USE_VST}
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure FinalizeGlobalStructures;
|
|
|
|
var
|
|
HintWasEnabled: Boolean;
|
|
|
|
begin
|
|
LightCheckImages.Free;
|
|
LightCheckImages := nil;
|
|
DarkCheckImages.Free;
|
|
DarkCheckImages := nil;
|
|
LightTickImages.Free;
|
|
LightTickImages := nil;
|
|
DarkTickImages.Free;
|
|
DarkTickImages := nil;
|
|
FlatImages.Free;
|
|
FlatImages := nil;
|
|
XPImages.Free;
|
|
XPImages := nil;
|
|
UtilityImages.Free;
|
|
UtilityImages := nil;
|
|
SystemCheckImages.Free;
|
|
SystemCheckImages := nil;
|
|
SystemFlatCheckImages.Free;
|
|
SystemFlatCheckImages := nil;
|
|
|
|
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;
|
|
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 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 then
|
|
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 -----------------------------------------------------------------------------
|
|
|
|
var
|
|
// This variable is necessary to coordinate the complex interaction between different hints in the application
|
|
// and animated hints in our own class. Under certain conditions it can happen that our hint window is destroyed
|
|
// while it is still in the animation loop.
|
|
FHintWindowDestroyed: Boolean = True;
|
|
|
|
constructor TVirtualTreeHintWindow.Create(AOwner: TComponent);
|
|
|
|
begin
|
|
inherited;
|
|
|
|
FBackground := TBitmap.Create;
|
|
FBackground.PixelFormat := pf32Bit;
|
|
FDrawBuffer := TBitmap.Create;
|
|
FDrawBuffer.PixelFormat := pf32Bit;
|
|
FTarget := TBitmap.Create;
|
|
FTarget.PixelFormat := pf32Bit;
|
|
|
|
DoubleBuffered := False; // we do our own buffering
|
|
FHintWindowDestroyed := False;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
destructor TVirtualTreeHintWindow.Destroy;
|
|
|
|
begin
|
|
FHintWindowDestroyed := True;
|
|
|
|
FTarget.Free;
|
|
FDrawBuffer.Free;
|
|
FBackground.Free;
|
|
inherited;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVirtualTreeHintWindow.AnimationCallback(Step, StepSize: Integer; Data: Pointer): Boolean;
|
|
|
|
begin
|
|
Result := not FHintWindowDestroyed and HandleAllocated and IsWindowVisible(Handle) and
|
|
Assigned(FHintData.Tree) and not (tsCancelHintAnimation in FHintData.Tree.FStates);
|
|
if Result then
|
|
begin
|
|
InternalPaint(Step, StepSize);
|
|
// We have to allow certain messages to be processed normally for various reasons.
|
|
// This introduces another problem however if this hint window is destroyed
|
|
// while it is still in the animation loop. A global variable keeps track of
|
|
// that case. This is reliable because we can only have one (internal) hint window.
|
|
Application.ProcessMessages;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVirtualTreeHintWindow.GetHintWindowDestroyed;
|
|
|
|
// This function exists to inform descendants if the hint window has been destroyed.
|
|
|
|
begin
|
|
Result := FHintWindowDestroyed;
|
|
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.WMNCPaint(var Message: TMessage);
|
|
|
|
// The control is fully painted by own code so don't paint any borders.
|
|
|
|
begin
|
|
Message.Result := 0;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVirtualTreeHintWindow.WMShowWindow(var Message: TWMShowWindow);
|
|
|
|
// Clear hint data when the window becomes hidden.
|
|
|
|
begin
|
|
if not Message.Show then
|
|
begin
|
|
// Don't touch the last hint rectangle stored in the associated tree to avoid flickering in certain situations.
|
|
Finalize(FHintData);
|
|
ZeroMemory (@FHintData, SizeOf(FHintData));
|
|
|
|
// If the hint window destruction flag to stop any hint window animation was set by a tree
|
|
// during its destruction then reset it here to allow other tree instances to still use
|
|
// this hint window.
|
|
FHintWindowDestroyed := False;
|
|
end;
|
|
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.InternalPaint(Step, StepSize: Integer);
|
|
|
|
//--------------- local functions -------------------------------------------
|
|
|
|
procedure DoShadowBlend(DC: HDC; R: TRect; Alpha: Integer);
|
|
|
|
// Helper routine for shadow blending to shorten the parameter list in frequent calls.
|
|
|
|
begin
|
|
AlphaBlend(0, DC, R, Point(0, 0), bmConstantAlphaAndColor, Alpha, clBlack);
|
|
end;
|
|
|
|
//---------------------------------------------------------------------------
|
|
|
|
procedure DrawHintShadow(Canvas: TCanvas; ShadowSize: Integer);
|
|
|
|
var
|
|
R: TRect;
|
|
|
|
begin
|
|
// Bottom shadow.
|
|
R := Rect(ShadowSize, Height - ShadowSize, Width, Height);
|
|
DoShadowBlend(Canvas.Handle, R, 5);
|
|
Inc(R.Left);
|
|
Dec(R.Right);
|
|
Dec(R.Bottom);
|
|
DoShadowBlend(Canvas.Handle, R, 10);
|
|
Inc(R.Left);
|
|
Dec(R.Right);
|
|
Dec(R.Bottom);
|
|
DoShadowBlend(Canvas.Handle, R, 20);
|
|
Inc(R.Left);
|
|
Dec(R.Right);
|
|
Dec(R.Bottom);
|
|
DoShadowBlend(Canvas.Handle, R, 35);
|
|
Inc(R.Left);
|
|
Dec(R.Right);
|
|
Dec(R.Bottom);
|
|
DoShadowBlend(Canvas.Handle, R, 50);
|
|
// Right shadow.
|
|
R := Rect(Width - ShadowSize, ShadowSize, Width, Height - ShadowSize);
|
|
DoShadowBlend(Canvas.Handle, R, 5);
|
|
Inc(R.Top);
|
|
Dec(R.Right);
|
|
DoShadowBlend(Canvas.Handle, R, 10);
|
|
Inc(R.Top);
|
|
Dec(R.Right);
|
|
DoShadowBlend(Canvas.Handle, R, 20);
|
|
Inc(R.Top);
|
|
Dec(R.Right);
|
|
DoShadowBlend(Canvas.Handle, R, 35);
|
|
Inc(R.Top);
|
|
Dec(R.Right);
|
|
DoShadowBlend(Canvas.Handle, R, 50);
|
|
end;
|
|
|
|
//--------------- end local functions ---------------------------------------
|
|
|
|
var
|
|
R: TRect;
|
|
Y: Integer;
|
|
S: string;
|
|
DrawFormat: Cardinal;
|
|
Shadow: Integer;
|
|
HintKind: TVTHintKind;
|
|
LClipRect: TRect;
|
|
|
|
LColor: TColor;
|
|
LDetails: TThemedElementDetails;
|
|
LGradientStart: TColor;
|
|
LGradientEnd: TColor;
|
|
|
|
begin
|
|
Shadow := 0;
|
|
|
|
with FHintData, FDrawBuffer do
|
|
begin
|
|
// Do actual painting only in the very first run.
|
|
if Step = 0 then
|
|
begin
|
|
// 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 - Shadow + Self.Height) div 2;
|
|
end;
|
|
|
|
R := Rect(0, 0, Width - Shadow, Height - Shadow);
|
|
|
|
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;
|
|
|
|
|
|
if StepSize > 0 then
|
|
begin
|
|
if FHintData.Tree.DoGetAnimationType = hatFade then
|
|
begin
|
|
with FTarget do
|
|
BitBlt(Canvas.Handle, 0, 0, Width, Height, FBackground.Canvas.Handle, 0, 0, SRCCOPY);
|
|
// Main image.
|
|
AlphaBlend(FDrawBuffer.Canvas.Handle, FTarget.Canvas.Handle, Rect(0, 0, Width - Shadow, Height - Shadow),
|
|
Point(0, 0), bmConstantAlpha, MulDiv(Step, 256, FadeAnimationStepCount), 0);
|
|
|
|
if Shadow > 0 then
|
|
DrawHintShadow(FTarget.Canvas, Shadow);
|
|
BitBlt(Canvas.Handle, 0, 0, Width, Height, FTarget.Canvas.Handle, 0, 0, SRCCOPY);
|
|
end
|
|
else
|
|
begin
|
|
// Slide is done by blitting "step" lines of the lower part of the hint window
|
|
// and fill the rest with the screen background.
|
|
|
|
// 1) blit hint bitmap to the hint canvas
|
|
BitBlt(Canvas.Handle, 0, 0, Width - Shadow, Step, FDrawBuffer.Canvas.Handle, 0, Height - Step, SRCCOPY);
|
|
// 2) blit background rest to hint canvas
|
|
if Step <= Shadow then
|
|
Step := 0
|
|
else
|
|
Dec(Step, Shadow);
|
|
BitBlt(Canvas.Handle, 0, Step, Width, Height - Step, FBackground.Canvas.Handle, 0, Step, SRCCOPY);
|
|
end;
|
|
end
|
|
else
|
|
// Last step during slide or the only step without animation.
|
|
if FHintData.Tree.DoGetAnimationType <> hatFade then
|
|
begin
|
|
if Shadow > 0 then
|
|
begin
|
|
with FBackground do
|
|
BitBlt(Canvas.Handle, 0, 0, Width - Shadow, Height - Shadow, FDrawBuffer.Canvas.Handle, 0, 0, SRCCOPY);
|
|
|
|
DrawHintShadow(FBackground.Canvas, Shadow);
|
|
BitBlt(Canvas.Handle, 0, 0, Width, Height, FBackground.Canvas.Handle, 0, 0, SRCCOPY);
|
|
end
|
|
else
|
|
BitBlt(Canvas.Handle, 0, 0, Width, Height, FDrawBuffer.Canvas.Handle, 0, 0, SRCCOPY);
|
|
end;
|
|
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVirtualTreeHintWindow.Paint;
|
|
|
|
begin
|
|
InternalPaint(0, 0);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVirtualTreeHintWindow.ActivateHint(Rect: TRect; const AHint: string);
|
|
|
|
var
|
|
DC: HDC;
|
|
StopLastAnimation: Boolean;
|
|
lCursorPos: TPoint;
|
|
begin
|
|
if IsRectEmpty(Rect) or not Assigned(FHintData.Tree) or
|
|
not GetCursorPos(lCursorPos) or not PtInRect(FHintData.Tree.FLastHintRect, FHintData.Tree.ScreenToClient(lCursorPos))
|
|
then
|
|
Application.CancelHint
|
|
else
|
|
begin
|
|
// There is already an animation. Start a new one but do not continue the old one once we are finished here.
|
|
StopLastAnimation := (tsInAnimation in FHintData.Tree.FStates);
|
|
if StopLastAnimation then
|
|
FHintData.Tree.DoStateChange([], [tsInAnimation]);
|
|
|
|
SetWindowPos(Handle, 0, Rect.Left, Rect.Top, Width, Height, SWP_HIDEWINDOW or SWP_NOACTIVATE or SWP_NOZORDER);
|
|
UpdateBoundsRect(Rect);
|
|
|
|
// Make sure the whole hint is visible on the monitor. Don't forget multi-monitor systems with the
|
|
// primary monitor not being at the top-left corner.
|
|
if Rect.Top - Screen.DesktopTop + Height > Screen.DesktopHeight then
|
|
Rect.Top := Screen.DesktopHeight - Height + Screen.DesktopTop;
|
|
if Rect.Left - Screen.DesktopLeft + Width > Screen.DesktopWidth then
|
|
Rect.Left := Screen.DesktopWidth - Width + Screen.DesktopLeft;
|
|
if Rect.Bottom - Screen.DesktopTop < Screen.DesktopTop then
|
|
Rect.Bottom := Screen.DesktopTop + Screen.DesktopTop;
|
|
if Rect.Left - Screen.DesktopLeft < Screen.DesktopLeft then
|
|
Rect.Left := Screen.DesktopLeft + Screen.DesktopLeft;
|
|
|
|
// adjust sizes of bitmaps
|
|
FDrawBuffer.Height := 0;
|
|
FBackground.Height := 0;
|
|
FTarget.Height := 0;
|
|
FDrawBuffer.SetSize(Width, Height); // By Rapid D
|
|
FBackground.SetSize(Width, Height); // By Rapid D
|
|
FTarget.SetSize(Width, Height); // By Rapid D
|
|
|
|
FHintData.Tree.Update;
|
|
|
|
if not (FHintData.Tree.DoGetAnimationType in [hatNone, hatSystemDefault]) then // Added By Rapid D
|
|
begin
|
|
// capture screen
|
|
DC := GetDC(0);
|
|
try
|
|
with TWithSafeRect(Rect) do
|
|
BitBlt(FBackground.Canvas.Handle, 0, 0, Width, Height, DC, Left, Top, SRCCOPY);
|
|
finally
|
|
ReleaseDC(0, DC);
|
|
end;
|
|
end;
|
|
|
|
SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height, SWP_SHOWWINDOW or SWP_NOACTIVATE);
|
|
with FHintData.Tree do
|
|
case DoGetAnimationType of
|
|
hatNone:
|
|
InvalidateRect(Self.Handle, nil, False);
|
|
hatFade:
|
|
begin
|
|
// Make sure the window is not drawn unanimated.
|
|
ValidateRect(Self.Handle, nil);
|
|
// Empirically determined animation duration shows that fading needs about twice as much time as
|
|
// sliding to show a comparable visual effect.
|
|
Animate(FadeAnimationStepCount, 2 * FAnimationDuration, AnimationCallback, nil);
|
|
end;
|
|
hatSlide:
|
|
begin
|
|
// Make sure the window is not drawn unanimated.
|
|
ValidateRect(Self.Handle, nil);
|
|
Animate(Self.Height, FAnimationDuration, AnimationCallback, nil);
|
|
end;
|
|
end;
|
|
if not FHintWindowDestroyed and StopLastAnimation and Assigned(FHintData.Tree) then
|
|
FHintData.Tree.DoStateChange([tsCancelHintAnimation]);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVirtualTreeHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
|
|
|
|
var
|
|
TM: TTextMetric;
|
|
R: TRect;
|
|
|
|
begin
|
|
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;
|
|
{$IFDEF USE_VST} // By Rapid D
|
|
if Tree is TCustomVirtualStringTree then
|
|
with TCustomVirtualStringTree(Tree) do
|
|
DoPaintText(Node, Self.Canvas, Column, ttNormal);
|
|
{$ENDIF USE_VST}
|
|
end;
|
|
|
|
GetTextMetrics(Canvas.Handle, TM);
|
|
FTextHeight := TM.tmHeight;
|
|
LineBreakStyle := hlbDefault;
|
|
|
|
if Length(DefaultHint) > 0 then
|
|
HintText := DefaultHint
|
|
else
|
|
if Tree.HintMode = hmToolTip then
|
|
HintText := Tree.DoGetNodeToolTip(Node, Column, LineBreakStyle)
|
|
else
|
|
HintText := Tree.DoGetNodeHint(Node, Column, LineBreakStyle);
|
|
|
|
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
|
|
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.
|
|
Inc(Result.Bottom, 6);
|
|
// 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/
|
|
Inc(Result.Right, Tree.FTextMargin + FTextHeight); // 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;
|
|
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 key presses cancel the current hint.
|
|
if Result and ((Msg.Message = WM_NCMOUSEMOVE) or ((Msg.Message >= WM_KEYFIRST) and (Msg.Message <= WM_KEYLAST))) then
|
|
Result := False
|
|
else
|
|
// Work around problems with keypresses while doing hint animation.
|
|
if HandleAllocated and IsWindowVisible(Handle) and (Msg.Message >= WM_KEYFIRST) and (Msg.Message <= WM_KEYLAST) and
|
|
(tsInAnimation in FHintData.Tree.FStates) and TranslateMessage(Msg) then
|
|
DispatchMessage(Msg);
|
|
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 MMXAvailable and not (disSystemSupport in FStates) then
|
|
begin
|
|
FLastPosition := HotSpot;
|
|
|
|
FDragImage := TBitmap.Create;
|
|
FDragImage.PixelFormat := pf32Bit;
|
|
|
|
FAlphaImage := TBitmap.Create;
|
|
FAlphaImage.PixelFormat := pf32Bit;
|
|
|
|
FBackImage := TBitmap.Create;
|
|
FBackImage.PixelFormat := pf32Bit;
|
|
|
|
FDragImage.SetSize(Width, Height); // By Rapid D
|
|
FAlphaImage.SetSize(Width, Height); // By Rapid D
|
|
FBackImage.SetSize(Width, Height); // By Rapid D
|
|
|
|
// 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;
|
|
ClipCanvas(Canvas, ClipRect, VisibleRegion);
|
|
Tree.PaintTree(Canvas, R, PaintTarget, PaintOptions);
|
|
|
|
if CaptureNCArea then
|
|
begin
|
|
// 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 := FCanModeNext;
|
|
if Result then
|
|
begin
|
|
FNode := FEnumeration.GetNext(FNode);
|
|
Result := FNode <> nil;
|
|
FCanModeNext := Result;
|
|
end;
|
|
end;
|
|
|
|
//----------------- TVTVirtualNodeEnumeration --------------------------------------------------------------------------
|
|
|
|
function TVTVirtualNodeEnumeration.GetEnumerator: TVTVirtualNodeEnumerator;
|
|
|
|
begin
|
|
Result.FNode := nil;
|
|
Result.FCanModeNext := 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;
|
|
|
|
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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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;
|
|
|
|
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.
|
|
with Owner, Header.Treeview do
|
|
if not (csLoading in ComponentState) and (VisibleChanged or ColorChanged) and (UpdateCount = 0) and
|
|
HandleAllocated then
|
|
begin
|
|
Invalidate;
|
|
if VisibleChanged then
|
|
UpdateHorizontalScrollBar(False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVirtualTreeColumn.SetPosition(Value: TColumnPosition);
|
|
|
|
var
|
|
Temp: TColumnIndex;
|
|
|
|
begin
|
|
if csLoading in Owner.Header.Treeview.ComponentState 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.
|
|
TotalFixedMinWidth := IfThen(FMaxWidthPercent > 0,
|
|
Min((ClientWidth * FMaxWidthPercent) div 100, TotalFixedMinWidth),
|
|
TotalFixedMinWidth);
|
|
TotalFixedMaxWidth := IfThen(FMinWidthPercent > 0,
|
|
Max((ClientWidth * FMinWidthPercent) div 100, TotalFixedMaxWidth),
|
|
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(DC: HDC; Client: TRect; UseHeaderGlyph, UseSortGlyph: Boolean;
|
|
var HeaderGlyphPos, SortGlyphPos: TPoint; var SortGlyphSize: TSize; var TextBounds: TRect; 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 UseHeaderGlyph or UseSortGlyph) then
|
|
Exit;
|
|
|
|
CurrentAlignment := CaptionAlignment;
|
|
if FBiDiMode <> bdLeftToRight then
|
|
ChangeBiDiModeAlignment(CurrentAlignment);
|
|
|
|
// Calculate sizes of the involved items.
|
|
ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top);
|
|
with Owner, Header do
|
|
begin
|
|
if UseHeaderGlyph 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 UseSortGlyph then
|
|
begin
|
|
if tsUseExplorerTheme in FHeader.Treeview.FStates then
|
|
begin
|
|
R := Rect(0, 0, 100, 100);
|
|
Theme := OpenThemeData(FHeader.Treeview.Handle, 'HEADER');
|
|
GetThemePartSize(Theme, DC, HP_HEADERSORTARROW, HSAS_SORTEDUP, @R, TS_TRUE, SortGlyphSize);
|
|
CloseThemeData(Theme);
|
|
end
|
|
else
|
|
begin
|
|
SortGlyphSize.cx := UtilityImages.Width;
|
|
SortGlyphSize.cy := UtilityImages.Height;
|
|
end;
|
|
|
|
// In any case, the sort glyph is vertically centered.
|
|
SortGlyphPos.Y := (ClientSize.Y - SortGlyphSize.cy) div 2;
|
|
end
|
|
else
|
|
begin
|
|
SortGlyphSize.cx := 0;
|
|
SortGlyphSize.cy := 0;
|
|
end;
|
|
end;
|
|
|
|
if UseText then
|
|
begin
|
|
if not (coWrapCaption in FOptions) then
|
|
begin
|
|
FCaptionText := FText;
|
|
GetTextExtentPoint32W(DC, PWideChar(FText), Length(FText), TextSize);
|
|
Inc(TextSize.cx, 2);
|
|
TextBounds := Rect(0, 0, TextSize.cx, TextSize.cy);
|
|
end
|
|
else
|
|
begin
|
|
R := Client;
|
|
if FCaptionText = '' then
|
|
FCaptionText := WrapString(DC, FText, R, DT_RTLREADING and DrawFormat <> 0, DrawFormat);
|
|
|
|
GetStringDrawRect(DC, FCaptionText, R, DrawFormat);
|
|
TextSize.cx := Client.Right - Client.Left;
|
|
TextSize.cy := R.Bottom - R.Top;
|
|
TextBounds := 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 UseSortGlyph and not (UseText or UseHeaderGlyph) then
|
|
begin
|
|
// Center the sort glyph in the available area if nothing else is there.
|
|
SortGlyphPos := Point((ClientSize.X - SortGlyphSize.cx) div 2, (ClientSize.Y - 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 UseHeaderGlyph then
|
|
begin
|
|
HeaderGlyphPos.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
|
|
HeaderGlyphPos.Y := (ClientSize.Y - HeaderGlyphSize.Y - TextSize.cy - TextSpacing) div 2;
|
|
TextPos.Y := HeaderGlyphPos.Y + HeaderGlyphSize.Y + TextSpacing;
|
|
end
|
|
else
|
|
begin
|
|
TextPos.Y := (ClientSize.Y - HeaderGlyphSize.Y - TextSize.cy - TextSpacing) div 2;
|
|
HeaderGlyphPos.Y := TextPos.Y + TextSize.cy + TextSpacing;
|
|
end;
|
|
end;
|
|
|
|
// Each alignment needs special consideration.
|
|
case CurrentAlignment of
|
|
taLeftJustify:
|
|
begin
|
|
MinLeft := FMargin;
|
|
if UseSortGlyph and (FBiDiMode <> bdLeftToRight) then
|
|
begin
|
|
// In RTL context is the sort glyph placed on the left hand side.
|
|
SortGlyphPos.X := MinLeft;
|
|
Inc(MinLeft, 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 UseHeaderGlyph then
|
|
begin
|
|
HeaderGlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) div 2;
|
|
if HeaderGlyphPos.X < MinLeft then
|
|
HeaderGlyphPos.X := MinLeft;
|
|
MinLeft := Max(TextPos.X + TextSize.cx + TextSpacing, HeaderGlyphPos.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 UseHeaderGlyph and (Layout = blGlyphLeft) then
|
|
begin
|
|
HeaderGlyphPos.X := MinLeft;
|
|
Inc(MinLeft, HeaderGlyphSize.X + FSpacing);
|
|
end;
|
|
TextPos.X := MinLeft;
|
|
Inc(MinLeft, TextSize.cx + TextSpacing);
|
|
if UseHeaderGlyph and (Layout = blGlyphRight) then
|
|
begin
|
|
HeaderGlyphPos.X := MinLeft;
|
|
Inc(MinLeft, HeaderGlyphSize.X + FSpacing);
|
|
end;
|
|
end;
|
|
if UseSortGlyph and (FBiDiMode = bdLeftToRight) then
|
|
SortGlyphPos.X := MinLeft;
|
|
end;
|
|
taCenter:
|
|
begin
|
|
if Layout in [blGlyphTop, blGlyphBottom] then
|
|
begin
|
|
HeaderGlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) div 2;
|
|
TextPos.X := (ClientSize.X - TextSize.cx) div 2;
|
|
if UseSortGlyph then
|
|
Dec(TextPos.X, SortGlyphSize.cx div 2);
|
|
end
|
|
else
|
|
begin
|
|
MinLeft := (ClientSize.X - HeaderGlyphSize.X - TextSpacing - TextSize.cx) div 2;
|
|
if UseHeaderGlyph and (Layout = blGlyphLeft) then
|
|
begin
|
|
HeaderGlyphPos.X := MinLeft;
|
|
Inc(MinLeft, HeaderGlyphSize.X + TextSpacing);
|
|
end;
|
|
TextPos.X := MinLeft;
|
|
Inc(MinLeft, TextSize.cx + TextSpacing);
|
|
if UseHeaderGlyph and (Layout = blGlyphRight) then
|
|
HeaderGlyphPos.X := MinLeft;
|
|
end;
|
|
if UseHeaderGlyph then
|
|
begin
|
|
MinLeft := Min(HeaderGlyphPos.X, TextPos.X);
|
|
MaxRight := Max(HeaderGlyphPos.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 UseSortGlyph then
|
|
if FBiDiMode = bdLeftToRight then
|
|
begin
|
|
// Sort glyph on the right hand side.
|
|
SortGlyphPos.X := MaxRight + FSpacing;
|
|
end
|
|
else
|
|
begin
|
|
// Sort glyph on the left hand side.
|
|
SortGlyphPos.X := MinLeft - FSpacing - SortGlyphSize.cx;
|
|
end;
|
|
end;
|
|
else
|
|
// taRightJustify
|
|
MaxRight := ClientSize.X - FMargin;
|
|
if UseSortGlyph and (FBiDiMode = bdLeftToRight) then
|
|
begin
|
|
// In LTR context is the sort glyph placed on the right hand side.
|
|
Dec(MaxRight, SortGlyphSize.cx);
|
|
SortGlyphPos.X := MaxRight;
|
|
Dec(MaxRight, FSpacing);
|
|
end;
|
|
if Layout in [blGlyphTop, blGlyphBottom] then
|
|
begin
|
|
TextPos.X := MaxRight - TextSize.cx;
|
|
if UseHeaderGlyph then
|
|
begin
|
|
HeaderGlyphPos.X := (ClientSize.X - HeaderGlyphSize.X) div 2;
|
|
if HeaderGlyphPos.X + HeaderGlyphSize.X + FSpacing > MaxRight then
|
|
HeaderGlyphPos.X := MaxRight - HeaderGlyphSize.X - FSpacing;
|
|
MaxRight := Min(TextPos.X - TextSpacing, HeaderGlyphPos.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 UseHeaderGlyph and (Layout = blGlyphRight) then
|
|
begin
|
|
HeaderGlyphPos.X := MaxRight - HeaderGlyphSize.X;
|
|
MaxRight := HeaderGlyphPos.X - FSpacing;
|
|
end;
|
|
TextPos.X := MaxRight - TextSize.cx;
|
|
MaxRight := TextPos.X - TextSpacing;
|
|
if UseHeaderGlyph and (Layout = blGlyphLeft) then
|
|
begin
|
|
HeaderGlyphPos.X := MaxRight - HeaderGlyphSize.X;
|
|
MaxRight := HeaderGlyphPos.X - FSpacing;
|
|
end;
|
|
end;
|
|
if UseSortGlyph and (FBiDiMode <> bdLeftToRight) then
|
|
SortGlyphPos.X := MaxRight - 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 UseSortGlyph then
|
|
begin
|
|
if FBiDiMode = bdLeftToRight then
|
|
begin
|
|
// Sort glyph on the right hand side.
|
|
if SortGlyphPos.X + SortGlyphSize.cx > MaxRight then
|
|
SortGlyphPos.X := MaxRight - SortGlyphSize.cx;
|
|
MaxRight := SortGlyphPos.X - FSpacing;
|
|
end;
|
|
|
|
// Consider also the left side of the sort glyph regardless of the bidi mode.
|
|
if SortGlyphPos.X < MinLeft then
|
|
SortGlyphPos.X := MinLeft;
|
|
// Left border needs only adjustment if the sort glyph marks the left border.
|
|
if FBiDiMode <> bdLeftToRight then
|
|
MinLeft := SortGlyphPos.X + SortGlyphSize.cx + FSpacing;
|
|
|
|
// Finally transform sort glyph to its actual position.
|
|
Inc(SortGlyphPos.X, Client.Left);
|
|
Inc(SortGlyphPos.Y, Client.Top);
|
|
end;
|
|
if UseHeaderGlyph then
|
|
begin
|
|
if HeaderGlyphPos.X + HeaderGlyphSize.X > MaxRight then
|
|
HeaderGlyphPos.X := MaxRight - HeaderGlyphSize.X;
|
|
if Layout = blGlyphRight then
|
|
MaxRight := HeaderGlyphPos.X - FSpacing;
|
|
if HeaderGlyphPos.X < MinLeft then
|
|
HeaderGlyphPos.X := MinLeft;
|
|
if Layout = blGlyphLeft then
|
|
MinLeft := HeaderGlyphPos.X + HeaderGlyphSize.X + FSpacing;
|
|
if FCheckBox and (Owner.Header.MainColumn = Self.Index) then
|
|
Dec(HeaderGlyphPos.X, 2)
|
|
else
|
|
if Owner.Header.MainColumn <> Self.Index then
|
|
Dec(HeaderGlyphPos.X, 2);
|
|
|
|
// Finally transform header glyph to its actual position.
|
|
Inc(HeaderGlyphPos.X, Client.Left);
|
|
Inc(HeaderGlyphPos.Y, Client.Top);
|
|
end;
|
|
if UseText then
|
|
begin
|
|
if TextPos.X < MinLeft then
|
|
TextPos.X := MinLeft;
|
|
OffsetRect(TextBounds, TextPos.X, TextPos.Y);
|
|
if TextBounds.Right > MaxRight then
|
|
TextBounds.Right := MaxRight;
|
|
OffsetRect(TextBounds, Client.Left, Client.Top);
|
|
|
|
if coWrapCaption in FOptions then
|
|
begin
|
|
// Wrap the column caption if necessary.
|
|
R := TextBounds;
|
|
FCaptionText := WrapString(DC, FText, R, DT_RTLREADING and DrawFormat <> 0, DrawFormat);
|
|
GetStringDrawRect(DC, FCaptionText, R, DrawFormat);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVirtualTreeColumn.DefineProperties(Filer: TFiler);
|
|
|
|
begin
|
|
inherited;
|
|
|
|
// Must define a new name for the properties otherwise the VCL will try to load the wide string
|
|
// without asking us and screws it completely up.
|
|
Filer.DefineProperty('WideText', ReadText, WriteText, FText <> '');
|
|
Filer.DefineProperty('WideHint', ReadHint, WriteHint, FHint <> '');
|
|
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.WriteHint(Writer: TWriter);
|
|
|
|
begin
|
|
Writer.WriteString(FHint);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVirtualTreeColumn.WriteText(Writer: TWriter);
|
|
|
|
begin
|
|
Writer.WriteString(FText);
|
|
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;
|
|
|
|
// 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);
|
|
|
|
//--------------- local function --------------------------------------------
|
|
|
|
function ConvertOptions(Value: Cardinal): TVTColumnOptions;
|
|
|
|
// Converts the given raw value which represents column options for possibly older
|
|
// formats to the current format.
|
|
|
|
begin
|
|
if Version >= 3 then
|
|
Result := TVTColumnOptions(Word(Value and $FFFF))
|
|
else
|
|
if Version = 2 then
|
|
Result := TVTColumnOptions(Word(Value and $FF))
|
|
else
|
|
begin
|
|
// In version 2 coParentColor has been added. This needs an option shift for older stream formats.
|
|
// The first (lower) 4 options remain as they are.
|
|
Result := TVTColumnOptions(Word(Value) and $F);
|
|
Value := (Value and not $F) shl 1;
|
|
Result := Result + TVTColumnOptions(Word(Value and $FF));
|
|
end;
|
|
end;
|
|
|
|
//--------------- end local function ----------------------------------------
|
|
|
|
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));
|
|
Options := ConvertOptions(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 := Word(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]);
|
|
OldIndex := NewIndex;
|
|
if OldIndex > NoColumn then
|
|
FHeader.Invalidate(Items[OldIndex]);
|
|
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;
|
|
if P.X < ColumnRight then
|
|
begin
|
|
Result := FPositionToIndex[I];
|
|
Exit;
|
|
end;
|
|
ColumnLeft := ColumnRight;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVirtualTreeColumns.GetOwner: TPersistent;
|
|
|
|
begin
|
|
Result := FHeader;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; Force, DblClick: 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).
|
|
|
|
var
|
|
HitInfo: TVTHeaderHitInfo;
|
|
NewClickIndex: Integer;
|
|
begin
|
|
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.SortColumn := HitInfo.Column;
|
|
Header.SortDirection := Self[Header.SortColumn].DefaultSortDirection;
|
|
end//if
|
|
else
|
|
begin
|
|
// toggle sort direction
|
|
if Header.SortDirection = sdDescending then
|
|
Header.SortDirection := sdAscending
|
|
else
|
|
Header.SortDirection := sdDescending;
|
|
end;//else
|
|
end;//if
|
|
|
|
if (Button = mbRight) and (hoAutoColumnPopupMenu in Header.Options) then begin
|
|
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.
|
|
fColumnPopupMenu := TVTHeaderPopupMenu.Create(Header.TreeView);
|
|
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);
|
|
end;//if hoShowColumnPopupMenu
|
|
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.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.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
|
|
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;
|
|
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;
|
|
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.Width := Max(Right, R.Right - R.Left);
|
|
FHeaderBitmap.Height := 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.
|
|
|
|
const
|
|
SortGlyphs: array[TSortDirection, Boolean] of Integer = ( // ascending/descending, normal/XP style
|
|
(3, 5) {ascending}, (2, 4) {descending}
|
|
);
|
|
|
|
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
|
|
Y: Integer;
|
|
SavedDC: Integer;
|
|
ColCaptionText: string;
|
|
ColImageInfo: TVTImageInfo;
|
|
SortIndex: Integer;
|
|
SortGlyphSize: TSize;
|
|
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;
|
|
|
|
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(TargetCanvas.Handle, PaintRectangle, ShowHeaderGlyph, ShowSortGlyph, GlyphPos,
|
|
SortGlyphPos, SortGlyphSize, TextRectangle, 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];
|
|
|
|
// 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 := GetCheckImageListFor(CheckImageKind);
|
|
if not Assigned(ColImageInfo.Images) then
|
|
ColImageInfo.Images := CustomCheckImages;
|
|
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
|
|
SortIndex := SortGlyphs[FHeader.FSortDirection, tsUseThemes in FHeader.Treeview.FStates];
|
|
UtilityImages.Draw(TargetCanvas, SortGlyphPos.X, SortGlyphPos.Y, SortIndex);
|
|
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
|
|
Y := (PaintRectangle.Top + PaintRectangle.Bottom - UtilityImages.Height) div 2;
|
|
if DropMark = dmmLeft then
|
|
UtilityImages.Draw(TargetCanvas, PaintRectangle.Left, Y, 0)
|
|
else
|
|
UtilityImages.Draw(TargetCanvas, PaintRectangle.Right - 16 , Y, 1);
|
|
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;
|
|
|
|
// 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 := False;
|
|
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;
|
|
PostBlendBias := 0;
|
|
PreBlendBias := -50;
|
|
Transparency := 140;
|
|
end;
|
|
|
|
fSplitterHitTolerance := 8;
|
|
FFixedAreaConstraints := TVTFixedAreaConstraints.Create(Self);
|
|
FFixedAreaConstraints.OnChange := FixedAreaConstraintsChanged;
|
|
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;
|
|
UpdateWindow(Treeview.Handle);
|
|
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);
|
|
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
|
|
if not ParentFont then
|
|
FFont.Size := MulDiv(FFont.Size, M, D);
|
|
Self.Height := MulDiv(FHeight, 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 Integer(Treeview.FRangeX) < Treeview.ClientWidth then
|
|
Inc(SplitPoint, Treeview.ClientWidth - Integer(Treeview.FRangeX));
|
|
|
|
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 + Integer(Treeview.FRangeX);
|
|
|
|
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 := nil;
|
|
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);
|
|
|
|
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;
|
|
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;
|
|
|
|
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;
|
|
Menu: TPopupMenu;
|
|
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
|
|
FColumns.HandleClick(P, mbRight, True, False);
|
|
FOwner.DoHeaderMouseUp(mbRight, GetShiftState, P.X, P.Y + Integer(FHeight));
|
|
FColumns.FDownIndex := NoColumn;
|
|
FColumns.FTrackIndex := NoColumn;
|
|
FColumns.FCheckBoxHit := False;
|
|
|
|
Menu := FPopupMenu;
|
|
if not Assigned(Menu) then
|
|
Menu := DoGetPopupMenu(FColumns.ColumnFromPosition(Point(P.X, P.Y + Integer(FHeight))), P);
|
|
|
|
// Trigger header popup if there's one.
|
|
if Assigned(Menu) then
|
|
begin
|
|
Treeview.StopTimer(ScrollTimer);
|
|
Treeview.StopTimer(HeaderTimer);
|
|
FColumns.FHoverIndex := NoColumn;
|
|
Treeview.DoStateChange([], [tsScrollPending, tsScrolling]);
|
|
Menu.PopupComponent := Treeview;
|
|
Menu.Popup(XCursor, YCursor);
|
|
HandleMessage := True;
|
|
end;
|
|
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;
|
|
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;
|
|
// 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); // By Rapid D
|
|
|
|
// 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
|
|
Result := False;
|
|
case SmartAutoFitType of
|
|
smaAllColumns:
|
|
Result := True;
|
|
smaNoColumn:
|
|
Result := False;
|
|
smaUseColumnOption:
|
|
Result := coSmartResize in FColumns.Items[ColumnIndex].FOptions;
|
|
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);
|
|
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);
|
|
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);
|
|
|
|
// 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;
|
|
|
|
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;
|
|
|
|
// 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);
|
|
RedrawWindow(Handle, @R, 0, RDW_FRAME or RDW_INVALIDATE or RDW_VALIDATE or RDW_NOINTERNALPAINT or
|
|
RDW_NOERASE or RDW_NOCHILDREN);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
{$IFDEF USE_VT_SAVES}
|
|
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);
|
|
Treeview.DoColumnResize(NoColumn);
|
|
end;
|
|
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;
|
|
{$ENDIF USE_VT_SAVES}
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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;
|
|
|
|
//----------------- 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);
|
|
|
|
begin
|
|
FOwner := AOwner;
|
|
FColors[0] := clBtnShadow; // DisabledColor
|
|
FColors[1] := clHighlight; // DropMarkColor
|
|
FColors[2] := clHighLight; // DropTargetColor
|
|
FColors[3] := clHighLight; // FocusedSelectionColor
|
|
FColors[4] := clBtnFace; // GridLineColor
|
|
FColors[5] := clBtnShadow; // TreeLineColor
|
|
FColors[6] := clBtnFace; // UnfocusedSelectionColor
|
|
FColors[7] := clBtnFace; // BorderColor
|
|
FColors[8] := clWindowText; // HotColor
|
|
FColors[9] := clHighLight; // FocusedSelectionBorderColor
|
|
FColors[10] := clBtnFace; // UnfocusedSelectionBorderColor
|
|
FColors[11] := clHighlight; // DropTargetBorderColor
|
|
FColors[12] := clHighlight; // SelectionRectangleBlendColor
|
|
FColors[13] := clHighlight; // SelectionRectangleBorderColor
|
|
FColors[14] := clBtnShadow; // HeaderHotColor
|
|
FColors[15] := clHighlightText; // SelectionTextColor
|
|
FColors[16] := clBtnFace; // UnfocusedColor [IPK]
|
|
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: Integer): TColor;
|
|
|
|
begin
|
|
if FOwner.VclStyleEnabled then
|
|
begin
|
|
case Index of
|
|
0:
|
|
StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemDisabled), ecTextColor, Result); // DisabledColor
|
|
1, 2, 3, 6, 10, 12, 13:
|
|
Result := StyleServices.GetSystemColor(clHighlight); // 1:DropMarkColor 2:DropTargetColor 3: FocusedSelectionColor
|
|
// 6:UnfocusedSelectionColor 10:UnfocusedSelectionBorderColor
|
|
// 12:SelectionRectangleBlendColor 13:SelectionRectangleBorderColor
|
|
4:
|
|
Result := StyleServices.GetSystemColor(clBtnFace); // GridLineColor
|
|
5:
|
|
StyleServices.GetElementColor(StyleServices.GetElementDetails(ttBranch), ecBorderColor, Result); // TreeLineColor
|
|
7:
|
|
if not (seBorder in FOwner.StyleElements) then
|
|
Result := FColors[Index]
|
|
else
|
|
Result := StyleServices.GetSystemColor(clBtnFace); // BorderColor
|
|
8:
|
|
if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemHot), ecTextColor, Result) or
|
|
(Result <> clWindowText) then
|
|
Result := NodeFontColor; // HotColor
|
|
9:
|
|
StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemSelected), ecFillColor, Result);
|
|
// FocusedSelectionBorderColor
|
|
11:
|
|
Result := StyleServices.GetSystemColor(clBtnFace); // DropTargetBorderColor
|
|
14:
|
|
StyleServices.GetElementColor(StyleServices.GetElementDetails(thHeaderItemNormal), ecTextColor, Result); // HeaderHotColor
|
|
15:
|
|
if not StyleServices.GetElementColor(StyleServices.GetElementDetails(ttItemSelected), ecTextColor, Result) or
|
|
(Result <> clWindowText) then
|
|
Result := NodeFontColor; // SelectionTextColor
|
|
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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVTColors.SetColor(const Index: Integer; 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
|
|
5:
|
|
begin
|
|
FOwner.PrepareBitmaps(True, False);
|
|
FOwner.Invalidate;
|
|
end;
|
|
7:
|
|
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
|
|
if not Initialized then
|
|
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;
|
|
FAnimationType := hatSystemDefault;
|
|
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;
|
|
FCheckImages := SystemCheckImages;
|
|
|
|
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;
|
|
|
|
FDefaultPasteMode := amAddChildLast;
|
|
FMargin := 4;
|
|
FTextMargin := 4;
|
|
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;
|
|
PostBlendBias := 0;
|
|
PreBlendBias := 0;
|
|
Transparency := 200;
|
|
end;
|
|
|
|
SetLength(FSingletonNodeArray, 1);
|
|
FAnimationDuration := 200;
|
|
FSearchTimeout := 1000;
|
|
FSearchStart := ssFocusedNode;
|
|
FNodeAlignment := naProportional;
|
|
FLineStyle := lsDotted;
|
|
FIncrementalSearch := isNone;
|
|
FClipboardFormats := TClipboardFormats.Create(Self);
|
|
FOptions := GetOptionsClass.Create(Self);
|
|
|
|
AddThreadReference;
|
|
VclStyleChanged();
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
destructor TBaseVirtualTree.Destroy;
|
|
|
|
begin
|
|
InterruptValidation();
|
|
Exclude(FOptions.FMiscOptions, toReadOnly);
|
|
ReleaseThreadReference(Self);
|
|
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;
|
|
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.AdjustCoordinatesByIndent(var PaintInfo: TVTPaintInfo; Indent: Integer);
|
|
|
|
// During painting of the main column some coordinates must be adjusted due to the tree lines.
|
|
// The offset resulting from the tree lines and indentation level is given in Indent.
|
|
|
|
var
|
|
Offset: Integer;
|
|
|
|
begin
|
|
with PaintInfo do
|
|
begin
|
|
Offset := Indent * Integer(FIndent);
|
|
if BidiMode = bdLeftToRight then
|
|
begin
|
|
Inc(ContentRect.Left, Offset);
|
|
Inc(ImageInfo[iiNormal].XPos, Offset);
|
|
Inc(ImageInfo[iiState].XPos, Offset);
|
|
Inc(ImageInfo[iiCheck].XPos, Offset);
|
|
end
|
|
else
|
|
begin
|
|
Dec(ContentRect.Right, Offset);
|
|
Dec(ImageInfo[iiNormal].XPos, Offset);
|
|
Dec(ImageInfo[iiState].XPos, Offset);
|
|
Dec(ImageInfo[iiCheck].XPos, Offset);
|
|
end;
|
|
end;
|
|
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(ShowImages, ShowStateImages: Boolean; Node: PVirtualNode;
|
|
var VAlign, 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
|
|
// 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 ShowImages or ShowStateImages then
|
|
begin
|
|
if ShowImages then
|
|
VAlign := GetNodeImageSize(Node).cy
|
|
else
|
|
VAlign := FStateImages.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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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 // WL, 05.02.2004: Do not enter tsCheckPropagation more than once
|
|
DoStateChange([tsCheckPropagation]);
|
|
Inc(FCheckPropagationCount); // WL, 05.02.2004
|
|
// 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
|
|
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 Run.CheckState 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;
|
|
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
|
|
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 Run.CheckState 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 := UnpressedState[CheckState]; // 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);
|
|
|
|
Dec(FCheckPropagationCount); // WL, 05.02.2004
|
|
if FCheckPropagationCount = 0 then // WL, 05.02.2004: Allow state change event after all check operations finished
|
|
DoStateChange([], [tsCheckPropagation]);
|
|
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,
|
|
CheckOffset,
|
|
CurrentTop,
|
|
CurrentRight,
|
|
NextTop,
|
|
NextColumn,
|
|
NodeWidth,
|
|
Dummy: Integer;
|
|
MinY, MaxY: Integer;
|
|
StateImageOffset: Integer;
|
|
IsInOldRect,
|
|
IsInNewRect: Boolean;
|
|
|
|
// quick check variables for various parameters
|
|
WithCheck,
|
|
WithImages,
|
|
WithStateImages,
|
|
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;
|
|
WithCheck := (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages);
|
|
// Don't check the events here as descendant trees might have overriden the DoGetImageIndex method.
|
|
WithImages := Assigned(FImages);
|
|
WithStateImages := Assigned(FStateImages);
|
|
if WithStateImages then
|
|
StateImageOffset := FStateImages.Width + 2
|
|
else
|
|
StateImageOffset := 0;
|
|
if WithCheck then
|
|
CheckOffset := FCheckImages.Width + 2
|
|
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
|
|
Inc(NodeLeft, Integer((GetNodeLevel(Run) + 1) * FIndent) + FMargin)
|
|
else
|
|
Inc(NodeLeft, 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.
|
|
TextLeft := NodeLeft;
|
|
if WithCheck and (Run.CheckType <> ctNone) then
|
|
Inc(TextLeft, CheckOffset);
|
|
if WithImages and HasImage(Run, ikNormal, MainColumn) then
|
|
Inc(TextLeft, GetNodeImageSize(Run).cx + 2);
|
|
if WithStateImages and HasImage(Run, ikState, MainColumn) then
|
|
Inc(TextLeft, StateImageOffset);
|
|
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 < OldRect.Right);
|
|
IsInNewRect := (NextTop > NewRect.Top) and (CurrentTop < NewRect.Bottom) and
|
|
((FHeader.Columns.Count = 0) or (FHeader.Columns.TotalWidth > NewRect.Left)) and (NodeLeft < 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;
|
|
StateImageOffset: Integer;
|
|
IsInOldRect,
|
|
IsInNewRect: Boolean;
|
|
|
|
// quick check variables for various parameters
|
|
WithCheck,
|
|
WithImages,
|
|
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.
|
|
WithImages := Assigned(FImages);
|
|
WithStateImages := Assigned(FStateImages);
|
|
if WithStateImages then
|
|
StateImageOffset := FStateImages.Width + 2
|
|
else
|
|
StateImageOffset := 0;
|
|
if WithCheck then
|
|
CheckOffset := FCheckImages.Width + 2
|
|
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);
|
|
if WithImages and HasImage(Run, ikNormal, MainColumn) then
|
|
Dec(TextRight, GetNodeImageSize(Run).cx + 2);
|
|
if WithStateImages and HasImage(Run, ikState, MainColumn) then
|
|
Dec(TextRight, StateImageOffset);
|
|
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.Bitmap, Canvas, Offset, R)
|
|
else
|
|
TileBackground(FBackground.Bitmap, Canvas, Offset, R);
|
|
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 := Round(FIndent / 2);
|
|
if Reverse then
|
|
TargetX := 0
|
|
else
|
|
TargetX := FIndent;
|
|
|
|
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
|
|
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
|
|
Result := FRoot.ChildCount
|
|
else
|
|
Result := 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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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.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 |
|
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 := 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);
|
|
end;
|
|
Invalidate();
|
|
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
|
|
begin
|
|
AddToSelection(NewNode);
|
|
InvalidateNode(NewNode);
|
|
end;
|
|
// 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;
|
|
NodeRight := 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
|
|
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.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).
|
|
if Assigned(WorkerThread) then
|
|
begin
|
|
WasValidating := (tsValidating in FStates);
|
|
WorkerThread.RemoveTree(Self);
|
|
if WasValidating then
|
|
InvalidateCache();
|
|
end;
|
|
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 = -1 then
|
|
ValidateNodeDataSize(FNodeDataSize);
|
|
|
|
// Take record alignment into account.
|
|
Inc(Size, FNodeDataSize);
|
|
end;
|
|
|
|
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
|
|
Width := Size.cx;
|
|
Height := Size.cy;
|
|
|
|
if IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) or VclStyleEnabled then
|
|
begin
|
|
if (FHeader.MainColumn > NoColumn) and not (coParentColor in FHeader.FColumns[FHeader.MainColumn].Options) then
|
|
Brush.Color := FHeader.FColumns[FHeader.MainColumn].Color
|
|
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 := 11;
|
|
Size.cy := 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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
type
|
|
TOldVTOption = (voAcceptOLEDrop, voAnimatedToggle, voAutoDropExpand, voAutoExpand, voAutoScroll,
|
|
voAutoSort, voAutoSpanColumns, voAutoTristateTracking, voCheckSupport, voDisableDrawSelection, voEditable,
|
|
voExtendedFocus, voFullRowSelect, voGridExtensions, voHideFocusRect, voHideSelection, voHotTrack, voInitOnSave,
|
|
voLevelSelectConstraint, voMiddleClickSelect, voMultiSelect, voRightClickSelect, voPopupMode, voShowBackground,
|
|
voShowButtons, voShowDropmark, voShowHorzGridLines, voShowRoot, voShowTreeLines, voShowVertGridLines,
|
|
voSiblingSelectConstraint, voToggleOnDblClick);
|
|
|
|
const
|
|
OptionMap: array[TOldVTOption] of Integer = (
|
|
Ord(toAcceptOLEDrop), Ord(toAnimatedToggle), Ord(toAutoDropExpand), Ord(toAutoExpand), Ord(toAutoScroll),
|
|
Ord(toAutoSort), Ord(toAutoSpanColumns), Ord(toAutoTristateTracking), Ord(toCheckSupport), Ord(toDisableDrawSelection),
|
|
Ord(toEditable), Ord(toExtendedFocus), Ord(toFullRowSelect), Ord(toGridExtensions), Ord(toHideFocusRect),
|
|
Ord(toHideSelection), Ord(toHotTrack), Ord(toInitOnSave), Ord(toLevelSelectConstraint), Ord(toMiddleClickSelect),
|
|
Ord(toMultiSelect), Ord(toRightClickSelect), Ord(toPopupMode), Ord(toShowBackground),
|
|
Ord(toShowButtons), Ord(toShowDropmark), Ord(toShowHorzGridLines), Ord(toShowRoot), Ord(toShowTreeLines),
|
|
Ord(toShowVertGridLines), Ord(toSiblingSelectConstraint), Ord(toToggleOnDblClick)
|
|
);
|
|
|
|
procedure TBaseVirtualTree.ReadOldOptions(Reader: TReader);
|
|
|
|
// Migration helper routine to silently convert forms containing the old tree options member into the new
|
|
// sub-options structure.
|
|
|
|
var
|
|
OldOption: TOldVTOption;
|
|
EnumName: string;
|
|
|
|
begin
|
|
// If we are at design time currently then let the designer know we changed something.
|
|
UpdateDesigner;
|
|
|
|
// It should never happen at this place that there is something different than the old set.
|
|
if Reader.ReadValue = vaSet then
|
|
begin
|
|
// Remove all default values set by the constructor.
|
|
FOptions.AnimationOptions := [];
|
|
FOptions.AutoOptions := [];
|
|
FOptions.MiscOptions := [];
|
|
FOptions.PaintOptions := [];
|
|
FOptions.SelectionOptions := [];
|
|
|
|
while True do
|
|
begin
|
|
// Sets are stored with their members as simple strings. Read them one by one and map them to the new option
|
|
// in the correct sub-option set.
|
|
EnumName := Reader.ReadStr;
|
|
if EnumName = '' then
|
|
Break;
|
|
OldOption := TOldVTOption(GetEnumValue(TypeInfo(TOldVTOption), EnumName));
|
|
case OldOption of
|
|
voAcceptOLEDrop, voCheckSupport, voEditable, voGridExtensions, voInitOnSave, voToggleOnDblClick:
|
|
FOptions.MiscOptions := FOptions.FMiscOptions + [TVTMiscOption(OptionMap[OldOption])];
|
|
voAnimatedToggle:
|
|
FOptions.AnimationOptions := FOptions.FAnimationOptions + [TVTAnimationOption(OptionMap[OldOption])];
|
|
voAutoDropExpand, voAutoExpand, voAutoScroll, voAutoSort, voAutoSpanColumns, voAutoTristateTracking:
|
|
FOptions.AutoOptions := FOptions.FAutoOptions + [TVTAutoOption(OptionMap[OldOption])];
|
|
voDisableDrawSelection, voExtendedFocus, voFullRowSelect, voLevelSelectConstraint,
|
|
voMiddleClickSelect, voMultiSelect, voRightClickSelect, voSiblingSelectConstraint:
|
|
FOptions.SelectionOptions := FOptions.FSelectionOptions + [TVTSelectionOption(OptionMap[OldOption])];
|
|
voHideFocusRect, voHideSelection, voHotTrack, voPopupMode, voShowBackground, voShowButtons,
|
|
voShowDropmark, voShowHorzGridLines, voShowRoot, voShowTreeLines, voShowVertGridLines:
|
|
FOptions.PaintOptions := FOptions.FPaintOptions + [TVTPaintOption(OptionMap[OldOption])];
|
|
end;
|
|
end;
|
|
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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TBaseVirtualTree.SetBackground(const Value: TPicture);
|
|
|
|
begin
|
|
FBackground.Assign(Value);
|
|
Invalidate;
|
|
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.SetCheckImageKind(Value: TCheckImageKind);
|
|
|
|
begin
|
|
if FCheckImageKind <> Value then
|
|
begin
|
|
FCheckImageKind := Value;
|
|
FCheckImages := GetCheckImageListFor(Value);
|
|
if not Assigned(FCheckImages) then
|
|
FCheckImages := FCustomCheckImages;
|
|
if HandleAllocated and (FUpdateCount = 0) and not (csLoading in ComponentState) then
|
|
InvalidateRect(Handle, nil, False);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TBaseVirtualTree.SetCheckState(Node: PVirtualNode; Value: TCheckState);
|
|
|
|
begin
|
|
if (Node.CheckState <> Value) and not (vsDisabled in Node.States) and DoChecking(Node, Value) then
|
|
DoCheckClick(Node, Value);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TBaseVirtualTree.SetCheckStateForAll(aCheckState: TCheckState; pSelectedOnly: Boolean);
|
|
|
|
// 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, I f apssed Falsee all nodes in the control will be changed.
|
|
|
|
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
|
|
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) and
|
|
(Node.Parent.CheckState in [csUncheckedNormal, csCheckedNormal]) then
|
|
CheckState[Node] := Node.Parent.CheckState;
|
|
end;
|
|
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;
|
|
|
|
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);
|
|
|
|
ReinitNode(Node, True);
|
|
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.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
|
|
FCustomCheckImages.RegisterChanges(FCustomCheckChangeLink);
|
|
FCustomCheckImages.FreeNotification(Self);
|
|
end;
|
|
// Check if currently custom check images are active.
|
|
if FCheckImageKind = ckCustom then
|
|
FCheckImages := Value;
|
|
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;
|
|
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.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 then
|
|
AdjustTotalHeight(Node, 0, False)
|
|
else
|
|
AdjustTotalHeight(Node, -Integer(NodeHeight[Node]), True);
|
|
if FullyVisible[Node] then
|
|
begin
|
|
Dec(FVisibleCount);
|
|
NeedUpdate := True;
|
|
end;
|
|
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: ^Pointer;
|
|
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.Data;
|
|
NodeData^ := pUserData;
|
|
Include(pNode.States, vsOnFreeNodeCallRequired);
|
|
end;
|
|
|
|
procedure TBaseVirtualTree.SetNodeData |
|
|
|
// Can be used to set user data of a PVirtualNode to a class instance.
|
|
|
|
begin
|
|
SetNodeData(pNode, Pointer(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
|
|
if Assigned(Node) and (Node <> FRoot) and (Node.NodeHeight <> Value) and not (toReadOnly in FOptions.FMiscOptions) 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] and not IsEffectivelyFiltered[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.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
|
|
if not (toMultiSelect in FOptions.FSelectionOptions) then
|
|
ClearSelection;
|
|
|
|
AddToSelection(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);
|
|
if FRangeAnchor = nil then
|
|
FRangeAnchor := Node;
|
|
end
|
|
else
|
|
begin
|
|
RemoveFromSelection(Node);
|
|
if FSelectionCount = 0 then
|
|
ResetRangeAnchor;
|
|
end;
|
|
if FullyVisible[Node] and not IsEffectivelyFiltered[Node] then
|
|
InvalidateNode(Node);
|
|
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.StaticBackground(Source: TBitmap; Target: TCanvas; OffsetPosition: TPoint; R: TRect);
|
|
|
|
// 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;
|
|
|
|
begin
|
|
// clear background
|
|
Target.Brush.Color := Color;
|
|
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
|
|
// Draw portion of image which falls in canvas area.
|
|
if Source.Transparent then
|
|
begin
|
|
// Leave transparent area as destination unchanged (DST), copy non-transparent areas to canvas (SRCCOPY).
|
|
MaskBlt(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), Source.Canvas.Handle, DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top,
|
|
Source.MaskHandle, DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top, MakeROP4(DST, SRCCOPY));
|
|
end
|
|
else
|
|
begin
|
|
// 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, Source.Canvas.Handle, DrawRect.Left - PicRect.Left, DrawRect.Top - PicRect.Top,
|
|
SRCCOPY);
|
|
end;
|
|
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: TBitmap; Target: TCanvas; Offset: TPoint; R: TRect);
|
|
|
|
// 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;
|
|
|
|
begin
|
|
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,
|
|
Source.Canvas.Handle, SourceX, SourceY, SRCCOPY);
|
|
Inc(TargetX, Source.Width - SourceX);
|
|
SourceX := 0;
|
|
end;
|
|
Inc(R.Top, Source.Height - SourceY);
|
|
SourceY := 0;
|
|
end;
|
|
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
|
|
AutoScale();
|
|
PrepareBitmaps(True, False);
|
|
if HandleAllocated then
|
|
Invalidate;
|
|
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;
|
|
// Assign a dummy string otherwise the VCL will not show the hint window.
|
|
if GetHintWindowClass.InheritsFrom(TVirtualTreeHintWindow) then
|
|
HintStr := ' '
|
|
else
|
|
begin
|
|
//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 > -1) 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;
|
|
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 > -1) and not (csLButtonDown in ControlState) then
|
|
begin
|
|
FHintData.DefaultHint := FHeader.FColumns[HitInfo.HitColumn].FHint;
|
|
if FHintData.DefaultHint <> '' 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;
|
|
|
|
FHintData.DefaultHint := '';
|
|
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) + 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;
|
|
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.
|
|
FHintData.DefaultHint := '';
|
|
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
|
|
FHintData.DefaultHint := GetShortHint(Hint);
|
|
if Length(FHintData.DefaultHint) = 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.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).
|
|
|
|
var
|
|
P: TPoint;
|
|
|
|
begin
|
|
// A little workaround is needed here to make the application class using the correct hint window class.
|
|
// Once the application gets ShowHint set to true (which is the case when we want to show hints in the tree) then
|
|
// an internal hint window will be created which is not our own class (because we don't set an application wide
|
|
// hint window class but only one for the tree). Unfortunately, this default hint window class will prevent
|
|
// hints for the non-client area to show up (e.g. for the header) by calling CancelHint whenever certain messages
|
|
// arrive. By setting the hint show pause to 0 if our hint class was not used recently we make sure
|
|
// that the hint timer (in Forms.pas) is not used and our class is created immediately.
|
|
if FHintWindowDestroyed then
|
|
begin
|
|
GetCursorPos(P);
|
|
// Check if the mouse is in the header or tool tips are enabled, which must be shown without delay anyway.
|
|
if FHeader.UseColumns and (hoShowHint in FHeader.FOptions) and FHeader.InHeader(ScreenToClient(P)) or
|
|
(FHintMode = hmToolTip) then
|
|
Message.Pause^ := 0;
|
|
end
|
|
else
|
|
if 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;
|
|
|
|
ConvertImageList(LightCheckImages, 'VT_CHECK_LIGHT');
|
|
ConvertImageList(DarkCheckImages, 'VT_CHECK_DARK');
|
|
ConvertImageList(LightTickImages, 'VT_TICK_LIGHT');
|
|
ConvertImageList(DarkTickImages, 'VT_TICK_DARK');
|
|
ConvertImageList(FlatImages, 'VT_FLAT');
|
|
ConvertImageList(UtilityImages, 'VT_UTILITIES');
|
|
// XP images do not need to be converted.
|
|
// System check images do not need to be converted.
|
|
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, -1, 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.WMChangeState(var Message: TMessage);
|
|
|
|
var
|
|
EnterStates,
|
|
LeaveStates: TVirtualTreeStates;
|
|
|
|
begin
|
|
EnterStates := [];
|
|
if csStopValidation in TChangeStates(Byte(Message.WParam)) then
|
|
Include(EnterStates, tsStopValidation);
|
|
if csUseCache in TChangeStates(Byte(Message.WParam)) then
|
|
Include(EnterStates, tsUseCache);
|
|
if csValidating in TChangeStates(Byte(Message.WParam)) then
|
|
Include(EnterStates, tsValidating);
|
|
if csValidationNeeded in TChangeStates(Byte(Message.WParam)) then
|
|
Include(EnterStates, tsValidationNeeded);
|
|
|
|
LeaveStates := [];
|
|
if csStopValidation in TChangeStates(Byte(Message.LParam)) then
|
|
Include(LeaveStates, tsStopValidation);
|
|
if csUseCache in TChangeStates(Byte(Message.LParam)) then
|
|
Include(LeaveStates, tsUseCache);
|
|
if csValidating in TChangeStates(Byte(Message.LParam)) then
|
|
Include(LeaveStates, tsValidating);
|
|
if csValidationNeeded in TChangeStates(Byte(Message.LParam)) then
|
|
Include(LeaveStates, tsValidationNeeded);
|
|
|
|
DoStateChange(EnterStates, LeaveStates);
|
|
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
|
|
{$IFDEF MSAASupport} // By Rapid D
|
|
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;
|
|
{$ENDIF MSAASupport}
|
|
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;
|
|
|
|
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 (tsKeyCheckPending in FStates) and (CharCode <> VK_SPACE) then
|
|
begin
|
|
DoStateChange([], [tskeyCheckPending]);
|
|
FCheckNode.CheckState := UnpressedState[FCheckNode.CheckState];
|
|
RepaintNode(FCheckNode);
|
|
FCheckNode := nil;
|
|
end;
|
|
|
|
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;
|
|
if ActAsGrid and not (toFullRowSelect in FOptions.FSelectionOptions) then
|
|
FocusedColumn := NewColumn;
|
|
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
|
|
RemoveFromSelection(FFocusedNode);
|
|
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
|
|
RemoveFromSelection(FFocusedNode);
|
|
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 := FHeader.Columns.GetPreviousVisibleColumn(FFocusedColumn, True);
|
|
if Context > -1 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;
|
|
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 := FHeader.Columns.GetNextVisibleColumn(FFocusedColumn, True);
|
|
if Context > -1 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;
|
|
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) 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;
|
|
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;
|
|
ForceSelection := True;
|
|
end;
|
|
|
|
// Determine new selection anchor.
|
|
if Shift = [] then
|
|
begin
|
|
FRangeAnchor := FFocusedNode;
|
|
FLastSelectionLevel := GetNodeLevel(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);
|
|
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
|
|
if not (toReverseFullExpandHotKey in TreeOptions.MiscOptions) and (ssShift in Shift) then
|
|
FullExpand
|
|
else
|
|
FHeader.AutoFitColumns
|
|
else
|
|
if Assigned(FFocusedNode) and not (vsExpanded in FFocusedNode.States) then
|
|
ToggleNode(FFocusedNode);
|
|
end
|
|
else
|
|
DoStateChange([tsIncrementalSearchPending]);
|
|
VK_SUBTRACT:
|
|
if not (tsIncrementalSearching in FStates) then
|
|
begin
|
|
if ssCtrl in Shift then
|
|
if not (toReverseFullExpandHotKey in TreeOptions.MiscOptions) and (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
|
|
if (FStates * [tsKeyCheckPending, tsMouseCheckPending] = []) and
|
|
not (vsDisabled in FFocusedNode.States) then
|
|
begin
|
|
with FFocusedNode^ do
|
|
NewCheckState := DetermineNextCheckState(CheckType, CheckState);
|
|
if DoChecking(FFocusedNode, NewCheckState) then
|
|
begin
|
|
DoStateChange([tsKeyCheckPending]);
|
|
FCheckNode := FFocusedNode;
|
|
FPendingCheckState := NewCheckState;
|
|
FCheckNode.CheckState := PressedState[FCheckNode.CheckState];
|
|
RepaintNode(FCheckNode);
|
|
end;
|
|
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_SPACE:
|
|
if tsKeyCheckPending in FStates then
|
|
begin
|
|
DoStateChange([], [tskeyCheckPending]);
|
|
if FCheckNode = FFocusedNode then
|
|
DoCheckClick(FCheckNode, FPendingCheckState);
|
|
InvalidateNode(FCheckNode);
|
|
FCheckNode := nil;
|
|
end;
|
|
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]);
|
|
inherited;
|
|
|
|
// get information about the hit
|
|
GetHitTestInfoAt(Message.XPos, Message.YPos, True, HitInfo);
|
|
HandleMouseDblClick(Message, HitInfo);
|
|
DoStateChange([], [tsLeftDblClick]);
|
|
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;
|
|
if tsInAnimation in FStates then
|
|
FHintWindowDestroyed := True; // Stop any pending animation.
|
|
|
|
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
|
|
begin
|
|
if hoVisible in FHeader.FOptions then
|
|
begin
|
|
R := FHeaderRect;
|
|
FHeader.FColumns.PaintHeader(DC, R, -FEffectiveOffsetX);
|
|
end;
|
|
OriginalWMNCPaint(DC);
|
|
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);
|
|
|
|
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);
|
|
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;
|
|
|
|
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);
|
|
HandleMouseDown(Message, HitInfo);
|
|
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:
|
|
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);
|
|
|
|
var
|
|
Changed: Boolean;
|
|
|
|
begin
|
|
if not FSelectionLocked then
|
|
begin
|
|
Assert(Assigned(Node), 'Node must not be nil!');
|
|
FSingletonNodeArray[0] := Node;
|
|
Changed := InternalAddToSelection(FSingletonNodeArray, 1, False);
|
|
if Changed then
|
|
begin
|
|
InvalidateNode(Node);
|
|
Change(Node);
|
|
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.AdjustImageBorder(Images: TCustomImageList; BidiMode: TBidiMode; VAlign: Integer; var R: TRect;
|
|
var ImageInfo: TVTImageInfo);
|
|
|
|
// Depending on the width of the image list as well as the given bidi mode R must be adjusted.
|
|
|
|
begin
|
|
if BidiMode = bdLeftToRight then
|
|
begin
|
|
ImageInfo.XPos := R.Left;
|
|
Inc(R.Left, Images.Width + 2);
|
|
end
|
|
else
|
|
begin
|
|
ImageInfo.XPos := R.Right - Images.Width;
|
|
Dec(R.Right, Images.Width + 2);
|
|
end;
|
|
ImageInfo.YPos := R.Top + VAlign - Images.Height div 2;
|
|
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,
|
|
CurrentTime: Cardinal;
|
|
|
|
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 := Cardinal(Steps) - RemainingSteps;
|
|
end;
|
|
|
|
if not Application.Terminated then
|
|
Callback(0, 0, Data);
|
|
finally
|
|
DoStateChange([], [tsCancelHintAnimation, tsInAnimation]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TBaseVirtualTree.StartOperation(OperationKind: TVTOperationKind);
|
|
|
|
// Called to indicate that a long-running operation has been started.
|
|
|
|
begin
|
|
Inc(FOperationCount);
|
|
DoStartOperation(OperationKind);
|
|
if FOperationCount = 1 then
|
|
FOperationCanceled := False;
|
|
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 not (tsSynchMode in FStates) then
|
|
SetTimer(Handle, ChangeTimer, FChangeDelay, nil)
|
|
else
|
|
DoChange(Node);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TBaseVirtualTree.ChangeScale(M, D: Integer);
|
|
|
|
begin
|
|
inherited;
|
|
|
|
if (M <> D) and (toAutoChangeScale in FOptions.FAutoOptions) then
|
|
begin
|
|
SetDefaultNodeHeight(MulDiv(FDefaultNodeHeight, M, D));
|
|
Indent := MulDiv(Indent, M, D);
|
|
FHeader.ChangeScale(M, D);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TBaseVirtualTree.ChangeTreeStatesAsync(EnterStates, LeaveStates: TChangeStates);
|
|
|
|
begin
|
|
if (Self.HandleAllocated) then
|
|
SendMessage(Self.Handle, WM_CHANGESTATE, Byte(EnterStates), Byte(LeaveStates));
|
|
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 in [csCheckedNormal, csCheckedPressed] then
|
|
Inc(CheckCount);
|
|
PartialCheck := PartialCheck or (NewCheckState = csMixedNormal);
|
|
end;
|
|
end
|
|
else
|
|
if Run.CheckType in [ctCheckBox, ctTriStateCheckBox] then
|
|
begin
|
|
Inc(BoxCount);
|
|
if Run.CheckState in [csCheckedNormal, csCheckedPressed] then
|
|
Inc(CheckCount);
|
|
PartialCheck := PartialCheck or (Run.CheckState = 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 ((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]);
|
|
|
|
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.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.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);
|
|
Filer.DefineProperty('Options', ReadOldOptions, 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;
|
|
Run: PVirtualNode;
|
|
Indent,
|
|
TextWidth,
|
|
ImageOffset: Integer;
|
|
|
|
begin
|
|
MainColumnHit := HitInfo.HitColumn = FHeader.MainColumn;
|
|
Indent := 0;
|
|
|
|
// 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
|
|
Indent := FIndent
|
|
else
|
|
begin
|
|
Run := HitInfo.HitNode;
|
|
while (Run.Parent <> FRoot) do
|
|
begin
|
|
Inc(Indent, FIndent);
|
|
Run := Run.Parent;
|
|
end;
|
|
if toShowRoot in FOptions.FPaintOptions then
|
|
Inc(Indent, FIndent);
|
|
end;
|
|
end;
|
|
|
|
if (MainColumnHit and (Offset < (Indent + Margin{See issue #259}))) 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 >= Indent - Integer(FIndent) then
|
|
Include(HitInfo.HitPositions, hiOnItemButton);
|
|
if Offset >= Indent - 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 := Indent + 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
|
|
Inc(ImageOffset, FCheckImages.Width + 2);
|
|
|
|
if MainColumnHit and (Offset < ImageOffset) then
|
|
begin
|
|
HitInfo.HitPositions := [hiOnItem];
|
|
if (HitInfo.HitNode.CheckType <> ctNone) then
|
|
Include(HitInfo.HitPositions, hiOnItemCheckBox);
|
|
end
|
|
else
|
|
begin
|
|
if Assigned(FStateImages) and HasImage(HitInfo.HitNode, ikState, HitInfo.HitColumn) then
|
|
Inc(ImageOffset, FStateImages.Width + 2);
|
|
if Offset < ImageOffset then
|
|
Include(HitInfo.HitPositions, hiOnStateIcon)
|
|
else
|
|
begin
|
|
if Assigned(FImages) and HasImage(HitInfo.HitNode, ikNormal, HitInfo.HitColumn) then
|
|
Inc(ImageOffset, GetNodeImageSize(HitInfo.HitNode).cx + 2);
|
|
if Offset < ImageOffset then
|
|
Include(HitInfo.HitPositions, hiOnNormalIcon)
|
|
else
|
|
begin
|
|
// ImageOffset contains now the left 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 > Right - ImageOffset then
|
|
Include(HitInfo.HitPositions, hiOnItemLabel)
|
|
else
|
|
begin
|
|
case Alignment of
|
|
taCenter:
|
|
begin
|
|
Indent := (ImageOffset + Right - 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 := Right - TextWidth;
|
|
if Offset < Indent 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 + 2);
|
|
|
|
if MainColumnHit and (Offset > ImageOffset) then
|
|
begin
|
|
HitInfo.HitPositions := [hiOnItem];
|
|
if (HitInfo.HitNode.CheckType <> ctNone) then
|
|
Include(HitInfo.HitPositions, hiOnItemCheckBox);
|
|
end
|
|
else
|
|
begin
|
|
if Assigned(FStateImages) and HasImage(HitInfo.HitNode, ikState, HitInfo.HitColumn) then
|
|
Dec(ImageOffset, FStateImages.Width + 2);
|
|
if Offset > ImageOffset then
|
|
Include(HitInfo.HitPositions, hiOnStateIcon)
|
|
else
|
|
begin
|
|
if Assigned(FImages) and HasImage(HitInfo.HitNode, ikNormal, HitInfo.HitColumn) then
|
|
Dec(ImageOffset, GetNodeImageSize(HitInfo.HitNode).cx + 2);
|
|
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) 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,
|
|
ctCheckBox:
|
|
if CheckState = csCheckedNormal then
|
|
Result := csUncheckedNormal
|
|
else
|
|
Result := csCheckedNormal;
|
|
ctRadioButton:
|
|
Result := csCheckedNormal;
|
|
ctButton:
|
|
Result := csUncheckedNormal;
|
|
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 ((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
|
|
begin
|
|
SetUpdateState(False);
|
|
InvalidateRect(Handle, @UpdateRect, False);
|
|
end;
|
|
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;
|
|
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
|
|
DoChecked(Node);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TBaseVirtualTree.DoChecked(Node: PVirtualNode);
|
|
|
|
begin
|
|
if Assigned(FOnChecked) then
|
|
FOnChecked(Self, Node);
|
|
{$IFDEF MSAASupport} // By Rapid D
|
|
if Assigned(FAccessibleItem) then
|
|
NotifyWinEvent(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF);
|
|
{$ENDIF MSAASupport}
|
|
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 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);
|
|
{$IFDEF MSAASupport} // By Rapid D
|
|
if Assigned(FAccessibleItem) then
|
|
NotifyWinEvent(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF);
|
|
{$ENDIF MSAASupport}
|
|
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, tsMouseCheckPending]);
|
|
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]);
|
|
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);
|
|
|
|
{$IFDEF MSAASupport} // By Rapid D
|
|
if Assigned(FAccessibleItem) then
|
|
NotifyWinEvent(EVENT_OBJECT_STATECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF);
|
|
{$ENDIF MSAASupport}
|
|
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);
|
|
{$IFDEF MSAASupport} // By Rapid D
|
|
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;
|
|
{$ENDIF MSAASupport}
|
|
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);
|
|
|
|
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 = FNextNodeToSelect then
|
|
FNextNodeToSelect := Node.Parent;
|
|
if Self.UpdateCount = 0 then
|
|
begin
|
|
// Omit this stuff if the control is in a BeginUpdate/EndUpdate bracket to increase performance
|
|
// We now try
|
|
// Make sure that CurrentNode does not point to an invalid node
|
|
if (toAlwaysSelectNode in TreeOptions.SelectionOptions) and (Node = GetFirstSelected()) then
|
|
begin
|
|
if Assigned(FNextNodeToSelect) then
|
|
// Select a new node if the currently selected node gets freed
|
|
Selected[FNextNodeToSelect] := True
|
|
else
|
|
begin
|
|
FNextNodeToSelect := Self.NodeParent[GetFirstSelected()];
|
|
if Assigned(FNextNodeToSelect) then
|
|
Selected[FNextNodeToSelect] := True;
|
|
end;//else
|
|
end;//if
|
|
end;
|
|
|
|
// fire event
|
|
if Assigned(FOnFreeNode) and ([vsInitialized, vsOnFreeNodeCallRequired] * Node.States <> []) then
|
|
FOnFreeNode(Self, Node);
|
|
|
|
if vsReleaseCallOnUserDataRequired in Node.States then
|
|
GetInterfaceFromNodeData |
|
|
|
FreeMem(Node);
|
|
if Self.UpdateCount = 0 then
|
|
EnsureNodeSelected();
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
// These constants are defined in the platform SDK for W2K/XP, but not yet in Delphi.
|
|
const
|
|
SPI_GETTOOLTIPANIMATION = $1016;
|
|
SPI_GETTOOLTIPFADE = $1018;
|
|
|
|
function TBaseVirtualTree.DoGetAnimationType: THintAnimationType;
|
|
|
|
// Determines (depending on the properties settings and the system) which hint
|
|
// animation type is to be used.
|
|
|
|
var
|
|
Animation: BOOL;
|
|
|
|
begin
|
|
Result := FAnimationType;
|
|
if Result = hatSystemDefault then
|
|
begin
|
|
SystemParametersInfo(SPI_GETTOOLTIPANIMATION, 0, @Animation, 0);
|
|
if not Animation then
|
|
Result := hatNone
|
|
else
|
|
begin
|
|
SystemParametersInfo(SPI_GETTOOLTIPFADE, 0, @Animation, 0);
|
|
if Animation then
|
|
Result := hatFade
|
|
else
|
|
Result := hatSlide;
|
|
end;
|
|
end;
|
|
|
|
// Check availability of MMX if fading is requested.
|
|
if not MMXAvailable and (Result = hatFade) then
|
|
Result := hatSlide;
|
|
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.
|
|
|
|
begin
|
|
// First try the enhanced event to allow for custom image lists.
|
|
if Assigned(FOnGetImageEx) then begin
|
|
if Kind = ikState then //TODO -oMarder: Remove paramter DefaultImages() from GetImageIndex() and do this stuff only here. That way consumers of the OnGetImageEx can check the fefault imagelist.
|
|
Result := Self.StateImages
|
|
else
|
|
Result := Self.Images;
|
|
FOnGetImageEx(Self, Node, Kind, Column, Ghosted, Index, Result);
|
|
end
|
|
else begin
|
|
Result := nil;
|
|
if Assigned(FOnGetImage) then
|
|
FOnGetImage(Self, Node, Kind, Column, Ghosted, Index);
|
|
end;
|
|
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, -1, Position, AskParent, Result);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TBaseVirtualTree.DoGetUserClipboardFormats(var Formats: TFormatEtcArray);
|
|
|
|
begin
|
|
if Assigned(FOnGetUserClipboardFormats) then
|
|
FOnGetUserClipboardFormats(Self, Formats);
|
|
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 (FBackground.Graphic is TBitmap) 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);
|
|
Perform(CM_UPDATE_VCLSTYLE_SCROLLBARS,0,0);
|
|
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;
|
|
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
|
|
UpdateScrollBars(True);
|
|
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 := 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 (GetFirstSelected() = nil) and not SelectionLocked and not IsEmpty then
|
|
begin
|
|
if Assigned(FNextNodeToSelect) then
|
|
Selected[FNextNodeToSelect] := True
|
|
else if Self.Focused then
|
|
Selected[GetFirstVisible] := True;
|
|
EnsureNodeFocused();
|
|
end;//if
|
|
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 := Node.CheckState;
|
|
ImgEnabled := not (vsDisabled in Node.States) and Enabled;
|
|
IsHot := Node = FCurrentHotNode;
|
|
end
|
|
else
|
|
IsHot := False;
|
|
|
|
if ImgCheckType = ctTriStateCheckBox then
|
|
ImgCheckType := ctCheckBox;
|
|
|
|
if ImgCheckType = ctNone then
|
|
Result := -1
|
|
else
|
|
Result := CheckStateToCheckImage[ImgCheckType, ImgCheckState, ImgEnabled, IsHot];
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
class function TBaseVirtualTree.GetCheckImageListFor(Kind: TCheckImageKind): TCustomImageList;
|
|
|
|
begin
|
|
case Kind of
|
|
ckDarkCheck:
|
|
Result := DarkCheckImages;
|
|
ckLightTick:
|
|
Result := LightTickImages;
|
|
ckDarkTick:
|
|
Result := DarkTickImages;
|
|
ckLightCheck:
|
|
Result := LightCheckImages;
|
|
ckFlat:
|
|
Result := FlatImages;
|
|
ckXP:
|
|
Result := XPImages;
|
|
ckSystemDefault:
|
|
Result := SystemCheckImages;
|
|
ckSystemFlat:
|
|
Result := SystemFlatCheckImages;
|
|
else
|
|
Result := nil;
|
|
end;
|
|
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 System.Classes.
|
|
|
|
begin
|
|
Result := TVirtualTreeHintWindow;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TBaseVirtualTree.GetImageIndex(var Info: TVTPaintInfo; Kind: TVTImageKind; InfoIndex: TVTImageInfoIndex;
|
|
DefaultImages: TCustomImageList);
|
|
|
|
// 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
|
|
else
|
|
ImageInfo[InfoIndex].Images := DefaultImages;
|
|
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
|
|
if Assigned(FImages) then
|
|
begin
|
|
Result.cx := FImages.Width;
|
|
Result.cy := FImages.Height;
|
|
end
|
|
else
|
|
begin
|
|
Result.cx := 0;
|
|
Result.cy := 0;
|
|
end;
|
|
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;
|
|
NodeLeft,
|
|
CurrentWidth: Integer;
|
|
WithCheck: Boolean;
|
|
CheckOffset: Integer;
|
|
|
|
begin
|
|
Node := GetNodeAt(0, 0, True, TopPosition);
|
|
Result := 0;
|
|
if toShowRoot in FOptions.FPaintOptions then
|
|
NodeLeft := (GetNodeLevel(Node) + 1) * FIndent
|
|
else
|
|
NodeLeft := GetNodeLevel(Node) * FIndent;
|
|
|
|
if Assigned(FStateImages) then
|
|
Inc(NodeLeft, FStateImages.Width + 2);
|
|
if Assigned(FImages) then
|
|
Inc(NodeLeft, FImages.Width + 2);
|
|
WithCheck := (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages);
|
|
if WithCheck then
|
|
CheckOffset := FCheckImages.Width + 2
|
|
else
|
|
CheckOffset := 0;
|
|
|
|
while Assigned(Node) do
|
|
begin
|
|
if not (vsInitialized in Node.States) then
|
|
InitNode(Node);
|
|
|
|
if WithCheck and (Node.CheckType <> ctNone) then
|
|
Inc(NodeLeft, CheckOffset);
|
|
CurrentWidth := DoGetNodeWidth(Node, NoColumn);
|
|
Inc(CurrentWidth, DoGetNodeExtraWidth(Node, NoColumn));
|
|
if Integer(Result) < (NodeLeft + CurrentWidth) then
|
|
Result := NodeLeft + CurrentWidth;
|
|
Inc(TopPosition, NodeHeight[Node]);
|
|
if TopPosition > Height then
|
|
Break;
|
|
|
|
if WithCheck and (Node.CheckType <> ctNone) then
|
|
Dec(NodeLeft, CheckOffset);
|
|
|
|
// Get next visible node and update left node position.
|
|
NextNode := GetNextVisible(Node, True);
|
|
if NextNode = nil then
|
|
Break;
|
|
Inc(NodeLeft, CountLevelDifference(Node, NextNode) * Integer(FIndent));
|
|
Node := NextNode;
|
|
end;
|
|
|
|
Inc(Result, FMargin);
|
|
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
|
|
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
|
|
HitInfo.HitNode := nil;
|
|
if (HitInfo.HitNode <> FCurrentHotNode) or (HitInfo.HitColumn <> FCurrentHotColumn) then
|
|
begin
|
|
DoInvalidate := (toHotTrack in FOptions.PaintOptions) or (toCheckSupport in FOptions.FMiscOptions);
|
|
DoHotChange(FCurrentHotNode, HitInfo.HitNode);
|
|
if Assigned(FCurrentHotNode) and DoInvalidate then
|
|
InvalidateNode(FCurrentHotNode);
|
|
FCurrentHotNode := HitInfo.HitNode;
|
|
FCurrentHotColumn := HitInfo.HitColumn;
|
|
end;
|
|
|
|
ButtonIsHit := (hiOnItemButtonExact in HitInfo.HitPositions);
|
|
if Assigned(FCurrentHotNode) and ((FHotNodeButtonHit <> ButtonIsHit) or DoInvalidate) then
|
|
begin
|
|
FHotNodeButtonHit := ButtonIsHit;
|
|
InvalidateNode(FCurrentHotNode);
|
|
end
|
|
else
|
|
if not Assigned(FCurrentHotNode) 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
|
|
if (FStates * [tsMouseCheckPending, tsKeyCheckPending] = []) and not (vsDisabled in HitInfo.HitNode.States) then
|
|
begin
|
|
with HitInfo.HitNode^ do
|
|
NewCheckState := DetermineNextCheckState(CheckType, CheckState);
|
|
if (ssLeft in KeysToShiftState(Message.Keys)) and DoChecking(HitInfo.HitNode, NewCheckState) then
|
|
begin
|
|
DoStateChange([tsMouseCheckPending]);
|
|
FCheckNode := HitInfo.HitNode;
|
|
FPendingCheckState := NewCheckState;
|
|
FCheckNode.CheckState := PressedState[FCheckNode.CheckState];
|
|
InvalidateNode(HitInfo.HitNode);
|
|
MayEdit := False;
|
|
end;
|
|
end;
|
|
end
|
|
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.
|
|
NeedChange: 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;
|
|
|
|
begin
|
|
if [tsWheelPanning, tsWheelScrolling] * FStates <> [] then
|
|
begin
|
|
StopWheelPanning;
|
|
Exit;
|
|
end;
|
|
|
|
if tsEditPending in FStates then
|
|
begin
|
|
StopTimer(EditTimer);
|
|
DoStateChange([], [tsEditPending]);
|
|
end;
|
|
|
|
if (tsEditing in FStates) then begin
|
|
if not DoEndEdit then
|
|
exit;
|
|
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
|
|
if (FStates * [tsMouseCheckPending, tsKeyCheckPending] = []) and not (vsDisabled in HitInfo.HitNode.States) then
|
|
begin
|
|
with HitInfo.HitNode^ do
|
|
NewCheckState := DetermineNextCheckState(CheckType, CheckState);
|
|
if (ssLeft in KeysToShiftState(Message.Keys)) and DoChecking(HitInfo.HitNode, NewCheckState) then
|
|
begin
|
|
DoStateChange([tsMouseCheckPending]);
|
|
FCheckNode := HitInfo.HitNode;
|
|
FPendingCheckState := NewCheckState;
|
|
FCheckNode.CheckState := PressedState[FCheckNode.CheckState];
|
|
InvalidateNode(HitInfo.HitNode);
|
|
end;
|
|
end;
|
|
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 := GetNodeLevel(HitInfo.HitNode)
|
|
else
|
|
FLastSelectionLevel := GetNodeLevel(GetLastVisibleNoInit(nil, True));
|
|
|
|
// pending clearance
|
|
if MultiSelect and ShiftEmpty and not (hiOnItemCheckbox in HitInfo.HitPositions) and IsAnyHit and AutoDrag and
|
|
NodeSelected and not FSelectionLocked then
|
|
DoStateChange([tsClearPending]);
|
|
|
|
// 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)));
|
|
|
|
// 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;
|
|
|
|
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))) 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
|
|
NeedChange := FSelectionCount > 1;
|
|
InternalClearSelection;
|
|
InternalAddToSelection(HitInfo.HitNode, True);
|
|
if NeedChange then
|
|
begin
|
|
Invalidate;
|
|
Change(nil);
|
|
end;
|
|
end
|
|
else if not ((hiNowhere in HitInfo.HitPositions) and (toAlwaysSelectNode in Self.TreeOptions.SelectionOptions)) then // When clicking in the free space we don't want the selection to be cleared in case toAlwaysSelectNode is set
|
|
ClearSelection;
|
|
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 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
|
|
Exit;
|
|
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
|
|
InvalidateColumn(FFocusedColumn);
|
|
InvalidateColumn(Column);
|
|
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 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);
|
|
end;
|
|
|
|
if NewNode or NewColumn then
|
|
begin
|
|
ScrollIntoView(FFocusedNode, toCenterScrollIntoView in FOptions.SelectionOptions,
|
|
not (toDisableAutoscrollOnFocus in FOptions.FAutoOptions)
|
|
and not (toFullRowSelect in FOptions.SelectionOptions));
|
|
|
|
DoFocusChange(FFocusedNode, FFocusedColumn);
|
|
end;
|
|
end;
|
|
|
|
// 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]);
|
|
Invalidate;
|
|
end;
|
|
|
|
if tsClearPending in FStates then
|
|
begin
|
|
ReselectFocusedNode := Assigned(FFocusedNode) and (vsSelected in FFocusedNode.States);
|
|
ClearSelection;
|
|
if ReselectFocusedNode then
|
|
AddToSelection(FFocusedNode);
|
|
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);
|
|
InvalidateNode(HitInfo.HitNode);
|
|
end;
|
|
|
|
DoStateChange([], [tsOLEDragPending, tsOLEDragging, tsClearPending, tsDrawSelPending, tsToggleFocusedSelection,
|
|
tsScrollPending, tsScrolling]);
|
|
StopTimer(ScrollTimer);
|
|
|
|
if tsMouseCheckPending in FStates then
|
|
begin
|
|
DoStateChange([], [tsMouseCheckPending]);
|
|
// Need check for nil, issue #285
|
|
// because when mouse down on checkbox but not yet released
|
|
// and in this time list starts to rebuild by timer
|
|
// after this when mouse release FCheckNode equal nil
|
|
if Assigned (FCheckNode) then
|
|
begin
|
|
// Is the mouse still over the same node?
|
|
if (HitInfo.HitNode = FCheckNode) and (hiOnItem in HitInfo.HitPositions) then
|
|
DoCheckClick(FCheckNode, FPendingCheckState)
|
|
else
|
|
FCheckNode.CheckState := UnpressedState[FCheckNode.CheckState];
|
|
InvalidateNode(FCheckNode);
|
|
end;
|
|
FCheckNode := nil;
|
|
end;
|
|
|
|
if (FHeader.FColumns.FClickIndex > NoColumn) and (FHeader.FColumns.FClickIndex = HitInfo.HitColumn) then
|
|
DoColumnClick(HitInfo.HitColumn, KeysToShiftState(Message.Keys));
|
|
|
|
if HitInfo.HitNode <> nil then
|
|
DoNodeClick(HitInfo);
|
|
|
|
// 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;
|
|
|
|
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);
|
|
if ivsDisabled in InitStates then
|
|
Include(States, vsDisabled);
|
|
if ivsHasChildren in InitStates then
|
|
Include(States, vsHasChildren);
|
|
if ivsSelected in InitStates then
|
|
begin
|
|
FSingletonNodeArray[0] := Node;
|
|
InternalAddToSelection(FSingletonNodeArray, 1, False);
|
|
end;
|
|
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, 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
|
|
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;
|
|
|
|
begin
|
|
Assert(Assigned(Node), 'Node must not be nil!');
|
|
FSingletonNodeArray[0] := Node;
|
|
Result := InternalAddToSelection(FSingletonNodeArray, 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;
|
|
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.
|
|
|
|
// 1) Remove already selected items, mark all other as being selected.
|
|
if ForceInsert then
|
|
begin
|
|
for I := 0 to NewLength - 1 do
|
|
begin
|
|
Include(NewItems[I].States, vsSelected);
|
|
Inc(FSelectionCount);
|
|
if Assigned(FOnAddToSelection) then
|
|
FOnAddToSelection(Self, NewItems[I]);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Constrained := toLevelSelectConstraint in FOptions.FSelectionOptions;
|
|
if Constrained and (FLastSelectionLevel = -1) then
|
|
FLastSelectionLevel := GetNodeLevel(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]))
|
|
else
|
|
begin
|
|
Include(NewItems[I].States, vsSelected);
|
|
Inc(FSelectionCount);
|
|
if Assigned(FOnAddToSelection) then
|
|
FOnAddToSelection(Self, NewItems[I]);
|
|
end;
|
|
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;
|
|
|
|
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);
|
|
Exclude(FSelection[FSelectionCount].States, vsSelected);
|
|
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, vsReleaseCallOnUserDataRequired];
|
|
|
|
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
|
|
Exclude(Node.States, vsSelected);
|
|
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;
|
|
{$IFDEF MSAASupport} // By Rapid D
|
|
if Assigned(FAccessibleItem) then
|
|
NotifyWinEvent(EVENT_OBJECT_NAMECHANGE, Handle, OBJID_CLIENT, CHILDID_SELF);
|
|
{$ENDIF MSAASupport}
|
|
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) or
|
|
(Abs(FLastClickPos.Y - Y) >= FDragThreshold)) 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: TThemedElementDetails;
|
|
|
|
begin
|
|
with ImageInfo do
|
|
begin
|
|
if (tsUseThemes in FStates) and (FCheckImageKind = ckSystemDefault) then
|
|
begin
|
|
R := Rect(XPos - 1, YPos + 1, XPos + 16, YPos + 16);
|
|
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
|
|
21 : Details := StyleServices.GetElementDetails(tbPushButtonNormal);
|
|
22 : Details := StyleServices.GetElementDetails(tbPushButtonHot);
|
|
23 : Details := StyleServices.GetElementDetails(tbPushButtonPressed);
|
|
24 : Details := StyleServices.GetElementDetails(tbPushButtonDisabled);
|
|
else
|
|
Details := StyleServices.GetElementDetails(tbButtonRoot);
|
|
end;
|
|
StyleServices.DrawElement(Canvas.Handle, Details, R);
|
|
if Index in [21..24] then
|
|
UtilityImages.Draw(Canvas, XPos - 1, YPos, 4);
|
|
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;
|
|
|
|
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 begin
|
|
GetImageIndex(PaintInfo, ikOverlay, iiOverlay, Images);
|
|
// If the overlay image is the same as the normal image, don't paint it.
|
|
// Users often forgot to respect the Kind parameter and ended up opening bugs.
|
|
if PaintInfo.ImageInfo[iiOverlay].Equals(PaintInfo.ImageInfo[iiNormal]) then
|
|
PaintInfo.ImageInfo[iiOverlay].Index := -1;
|
|
end
|
|
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;
|
|
|
|
// If the user returned an index >= 15 then we cannot use the built-in overlay image drawing.
|
|
// Instead we do it manually.
|
|
if (ImageInfo[iiOverlay].Index > -1) and (ImageInfo[iiOverlay].Index < 15) then
|
|
ExtraStyle := ILD_TRANSPARENT or ILD_OVERLAYMASK and IndexToOverlayMask(ImageInfo[iiOverlay].Index + 1)
|
|
else
|
|
ExtraStyle := ILD_TRANSPARENT;
|
|
|
|
// 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 PaintInfo.ImageInfo[iiOverlay].Index >= 15 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; VAlignment, 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;
|
|
Offset := FIndent;
|
|
end
|
|
else
|
|
begin
|
|
Offset := -Integer(FIndent);
|
|
XPos := CellRect.Right + 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, VAlignment - 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], VAlignment - 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)) or
|
|
not MMXAvailable 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
|
|
if (VclStyleEnabled and (coParentColor in FHeader.FColumns[Column].FOptions)) then
|
|
Brush.Color := FColors.BackGroundColor
|
|
else
|
|
Brush.Color := Items[Column].Color;
|
|
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 MMXAvailable and (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 MMXAvailable and (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.
|
|
|
|
var
|
|
ChunkBody: TBaseChunkBody;
|
|
Run: PVirtualNode;
|
|
LastPosition: Integer;
|
|
|
|
begin
|
|
case ChunkType of
|
|
BaseChunk:
|
|
begin
|
|
// Load base chunk's body (chunk header has already been consumed).
|
|
if Version > 1 then
|
|
Stream.Read(ChunkBody, SizeOf(ChunkBody))
|
|
else
|
|
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
|
|
Include(States, vsSelected)
|
|
else
|
|
Include(States, vsVisible);
|
|
Stream.Read(Align, SizeOf(Align));
|
|
Stream.Read(CheckState, SizeOf(CheckState));
|
|
Stream.Read(CheckType, SizeOf(CheckType));
|
|
end;
|
|
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!');
|
|
if vsSelected in Node.States then
|
|
begin
|
|
Exclude(Node.States, vsSelected);
|
|
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);
|
|
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 GetNodeLevel(Node) > 0 then
|
|
FNextNodeToSelect := Node.Parent
|
|
else
|
|
FNextNodeToSelect := GetFirstChild(Node);
|
|
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 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;
|
|
Dummy: Integer;
|
|
CurrentAlignment: TAlignment;
|
|
CurrentBidiMode: TBidiMode;
|
|
|
|
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
|
|
R := GetDisplayRect(FFocusedNode, FEditColumn, True, True);
|
|
if (toGridExtensions in FOptions.FMiscOptions) then
|
|
begin
|
|
// 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
|
|
FHeader.Columns.GetColumnBounds(FEditColumn, Dummy, R.Right)
|
|
else
|
|
FHeader.Columns.GetColumnBounds(FEditColumn, R.Left, Dummy);
|
|
end;
|
|
if toShowHorzGridLines in TreeOptions.PaintOptions then
|
|
Dec(R.Bottom);
|
|
R.Bottom := R.Top + Max(R.Bottom - R.Top, FEditLink.GetBounds.Bottom - FEditLink.GetBounds.Top); // Ensure to never decrease the size of the currently active edit control. Helps to prevent issue #159
|
|
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;
|
|
|
|
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);
|
|
|
|
// 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.
|
|
Tree.FDragImage.RecaptureBackground(Self, TreeRect, VisibleTreeRegion, UpdateNCArea, ReshowDragImage);
|
|
|
|
// Calculate the screen area not covered by the drag image and which needs an update.
|
|
DragRect := Tree.FDragImage.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.
|
|
WorkerThread.AddTree(Self);
|
|
SetEvent(WorkEvent);
|
|
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 := CheckState;
|
|
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
|
|
begin
|
|
CancelEditNode;
|
|
|
|
if Parent = nil then
|
|
Parent := FRoot;
|
|
if not (vsInitialized in Parent.States) then
|
|
InitNode(Parent);
|
|
|
|
// Locally stop updates of the tree in order to avoid usage of the new node before it is correctly set up.
|
|
// If the update count was 0 on enter then there will be a correct update at the end of this method.
|
|
Inc(FUpdateCount);
|
|
try
|
|
SetChildCount(Parent, Parent.ChildCount + 1);
|
|
// Update the hidden children flag of the parent. Nodes are added as being visible by default.
|
|
Exclude(Parent.States, vsAllChildrenHidden);
|
|
finally
|
|
Dec(FUpdateCount);
|
|
end;
|
|
Result := Parent.LastChild;
|
|
//TODO: The above code implicitely triggers OnMeasureItem, but the NodeData is not set then. Consider doing this similar to InsertNode() with a combination of MakeNewNode and InternalConnectNode()
|
|
|
|
if Assigned(UserData) then
|
|
SetNodeData(Result, UserData);
|
|
|
|
InvalidateCache;
|
|
if FUpdateCount = 0 then
|
|
begin
|
|
ValidateCache;
|
|
if tsStructureChangePending in FStates then
|
|
begin
|
|
if Parent = FRoot then
|
|
StructureChange(nil, crChildAdded)
|
|
else
|
|
StructureChange(Parent, crChildAdded);
|
|
end;
|
|
|
|
if (toAutoSort in FOptions.FAutoOptions) and (FHeader.FSortColumn > InvalidColumn) then
|
|
Sort(Parent, FHeader.FSortColumn, FHeader.FSortDirection, True);
|
|
|
|
InvalidateToBottom(Parent);
|
|
UpdateScrollBars(True);
|
|
end;
|
|
end
|
|
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.HintAnimation := HintAnimation;
|
|
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 defaulz node height is set corectly.
|
|
|
|
var
|
|
lTextHeight: Cardinal;
|
|
begin
|
|
if (toAutoChangeScale in TreeOptions.AutoOptions) then
|
|
begin
|
|
Canvas.Font.Assign(Self.Font);
|
|
lTextHeight := Canvas.TextHeight('Tg');
|
|
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
|
|
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 (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;
|
|
FCheckNode := 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;
|
|
|
|
var
|
|
Node: PVirtualNode;
|
|
Dummy: Integer;
|
|
R: TRect;
|
|
Counter: Integer;
|
|
|
|
begin
|
|
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;
|
|
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);
|
|
end;
|
|
|
|
LastLeft := -FEffectiveOffsetX;
|
|
LastTop := FOffsetY;
|
|
|
|
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);
|
|
if not WasInSynchMode then
|
|
Exclude(FStates, tsSynchMode);
|
|
InvalidateToBottom(LastParent);
|
|
end
|
|
else
|
|
InternalRemoveFromSelection(Node);
|
|
end
|
|
else
|
|
InvalidateToBottom(LastParent);
|
|
|
|
if tsHint in FStates then
|
|
begin
|
|
Application.CancelHint;
|
|
DoStateChange([], [tsHint]);
|
|
end;
|
|
|
|
if not ParentClearing then
|
|
InterruptValidation;
|
|
|
|
DeleteChildren(Node);
|
|
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.DeleteSelectedNodes;
|
|
|
|
// Deletes all currently selected nodes (including their child nodes).
|
|
|
|
var
|
|
Nodes: TNodeArray;
|
|
I: Integer;
|
|
LevelChange: Boolean;
|
|
|
|
begin
|
|
Nodes := nil;
|
|
if (FSelectionCount > 0) and not (toReadOnly in FOptions.FMiscOptions) then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Nodes := GetSortedSelection(True);
|
|
for I := High(Nodes) downto 1 do
|
|
begin
|
|
LevelChange := Nodes[I].Parent <> Nodes[I - 1].Parent;
|
|
DeleteNode(Nodes[I], LevelChange, False);
|
|
end;
|
|
DeleteNode(Nodes[0]);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
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;
|
|
Offset: Cardinal;
|
|
CacheIsAvailable: Boolean;
|
|
Indent,
|
|
TextWidth: Integer;
|
|
MainColumnHit: Boolean;
|
|
CurrentBidiMode: TBidiMode;
|
|
CurrentAlignment: TAlignment;
|
|
MaxUnclippedHeight: Integer;
|
|
TM: TTextMetric;
|
|
ExtraVerticalMargin: Integer;
|
|
|
|
begin
|
|
Assert(Assigned(Node), 'Node must not be nil.');
|
|
Assert(Node <> FRoot, 'Node must not be the hidden root node.');
|
|
|
|
MainColumnHit := (Column + 1) in [0, FHeader.MainColumn + 1];
|
|
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;
|
|
Temp := Node;
|
|
Indent := 0;
|
|
if not (toFixedIndent in FOptions.FPaintOptions) then
|
|
begin
|
|
while Temp <> FRoot do
|
|
begin
|
|
if not (vsVisible in Temp.States) or not (vsExpanded in Temp.Parent.States) then
|
|
Exit;
|
|
Temp := Temp.Parent;
|
|
if MainColumnHit and (Temp <> FRoot) then
|
|
Inc(Indent, FIndent);
|
|
end;
|
|
end;//if not toFixedIndent
|
|
|
|
// Here we know the node is visible.
|
|
Offset := 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, Offset);
|
|
CacheIsAvailable := Assigned(Temp);
|
|
while Assigned(Temp) and (Temp <> Node) do
|
|
begin
|
|
Inc(Offset, 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(Offset, NodeHeight[Temp]);
|
|
until False;
|
|
end;
|
|
|
|
Result := Rect(0, Offset, Max(FRangeX, ClientWidth), Offset + 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
|
|
// Start with the offset of the text in the column and consider the indentation level too.
|
|
Offset := FMargin + Indent;
|
|
// 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;
|
|
|
|
if MainColumnHit then
|
|
begin
|
|
if toShowRoot in FOptions.FPaintOptions then
|
|
Inc(Offset, FIndent);
|
|
if (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and (Node.CheckType <> ctNone) then
|
|
Inc(Offset, FCheckImages.Width + 2);
|
|
end;
|
|
// Consider associated images.
|
|
if Assigned(FStateImages) and HasImage(Node, ikState, Column) then
|
|
Inc(Offset, FStateImages.Width + 2);
|
|
if Assigned(FImages) and HasImage(Node, ikNormal, Column) then
|
|
Inc(Offset, GetNodeImageSize(Node).cx + 2);
|
|
|
|
// 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, Offset);
|
|
// Left-to-right reading does not need any special adjustment of the alignment.
|
|
end
|
|
else
|
|
begin
|
|
Dec(Result.Right, Offset);
|
|
|
|
// 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[Node])) 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[Node])) 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[Node])) 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[Node])) 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.
|
|
|
|
begin
|
|
Result := GetLastNoInit(Node, ConsiderChildrenAbove);
|
|
while Assigned(Result) and (Result <> Node) do
|
|
begin
|
|
if FullyVisible[Result] and
|
|
(IncludeFiltered or not IsEffectivelyFiltered[Result]) then
|
|
Break;
|
|
Result := GetPreviousNoInit(Result, ConsiderChildrenAbove);
|
|
end;
|
|
|
|
if (Result = Node) then // i.e. there is no visible node
|
|
Result := nil;
|
|
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;
|
|
NodeLeft,
|
|
TextLeft,
|
|
CurrentWidth: Integer;
|
|
AssumeImage: Boolean;
|
|
WithCheck,
|
|
WithStateImages: Boolean;
|
|
CheckOffset,
|
|
StateImageOffset: Integer;
|
|
|
|
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);
|
|
|
|
WithStateImages := Assigned(FStateImages);
|
|
if WithStateImages then
|
|
StateImageOffset := FStateImages.Width + 2
|
|
else
|
|
StateImageOffset := 0;
|
|
if Assigned(FCheckImages) then
|
|
CheckOffset := FCheckImages.Width + 2
|
|
else
|
|
CheckOffset := 0;
|
|
|
|
if UseSmartColumnWidth then // Get first visible node which is in view.
|
|
Run := GetTopNode
|
|
else
|
|
Run := GetFirstVisible(nil, True);
|
|
|
|
if Column = FHeader.MainColumn then
|
|
begin
|
|
if toFixedIndent in FOptions.FPaintOptions then
|
|
NodeLeft := FIndent
|
|
else
|
|
begin
|
|
if toShowRoot in FOptions.FPaintOptions then
|
|
NodeLeft := Integer((GetNodeLevel(Run) + 1) * FIndent)
|
|
else
|
|
NodeLeft := Integer(GetNodeLevel(Run) * FIndent);
|
|
end;
|
|
|
|
WithCheck := (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages);
|
|
end
|
|
else
|
|
begin
|
|
NodeLeft := 0;
|
|
WithCheck := False;
|
|
end;
|
|
|
|
// Consider node margin at the left of the nodes.
|
|
Inc(NodeLeft, FMargin);
|
|
|
|
// Decide where to stop.
|
|
if UseSmartColumnWidth then
|
|
LastNode := GetNextVisible(BottomNode)
|
|
else
|
|
LastNode := nil;
|
|
|
|
AssumeImage := False;
|
|
while Assigned(Run) and not OperationCanceled do
|
|
begin
|
|
TextLeft := NodeLeft;
|
|
if WithCheck and (Run.CheckType <> ctNone) then
|
|
Inc(TextLeft, CheckOffset);
|
|
if Assigned(FImages) and (AssumeImage or HasImage(Run, ikNormal, Column)) then
|
|
begin
|
|
TextLeft := TextLeft + GetNodeImageSize(Run).cx + 2;
|
|
AssumeImage := True;// From now on, assume that the nodes do ave an image
|
|
end;
|
|
if WithStateImages and HasImage(Run, ikState, Column) then
|
|
Inc(TextLeft, StateImageOffset);
|
|
|
|
CurrentWidth := DoGetNodeWidth(Run, Column);
|
|
Inc(CurrentWidth, DoGetNodeExtraWidth(Run, Column));
|
|
Inc(CurrentWidth, DoGetCellContentMargin(Run, Column).X);
|
|
|
|
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;
|
|
if (Column = Header.MainColumn) and not (toFixedIndent in FOptions.FPaintOptions) then
|
|
Inc(NodeLeft, CountLevelDifference(Run, NextNode) * Integer(FIndent));
|
|
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 (Result.CheckState <> 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 |
|
|
|
// 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 |
|
begin
|
|
if Assigned(pNode) then
|
|
Result := T(Self.GetNodeData(pNode)^)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TBaseVirtualTree.GetNodeDataAt |
|
|
|
// 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);
|
|
|
|
if not Assigned(lNode) then
|
|
Exit(nil);
|
|
|
|
Result := Self.GetNodeData |
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TBaseVirtualTree.GetFirstSelectedNodeData |
|
|
|
// Returns of the first selected node associated data converted to the type given in the generic part of the function.
|
|
|
|
begin
|
|
Result := T(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 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 (Result.CheckState <> 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.
|
|
if vsVisible in Result.PrevSibling.States then
|
|
begin
|
|
Result := Result.PrevSibling;
|
|
Break;
|
|
end;
|
|
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 := '';
|
|
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
|
|
// 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
|
|
case Mode of
|
|
amInsertBefore,
|
|
amInsertAfter:
|
|
// 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.
|
|
Sort(Node.Parent, FHeader.FSortColumn, FHeader.FSortDirection, True);
|
|
amAddChildFirst,
|
|
amAddChildLast:
|
|
Sort(Node, FHeader.FSortColumn, FHeader.FSortDirection, True);
|
|
end;
|
|
|
|
UpdateScrollBars(True);
|
|
if Mode = amInsertBefore then
|
|
InvalidateToBottom(Result)
|
|
else
|
|
InvalidateToBottom(Node);
|
|
end;
|
|
StructureChange(Result, crNodeAdded);
|
|
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
|
|
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, -1, 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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
{$IFDEF USE_VT_SAVES} // By Rapid D
|
|
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;
|
|
{$ENDIF USE_VT_SAVES}
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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,
|
|
ShowImages,
|
|
ShowStateImages,
|
|
ShowCheckImages,
|
|
UseColumns,
|
|
IsMainColumn: Boolean;
|
|
|
|
VAlign,
|
|
IndentSize,
|
|
ButtonX,
|
|
ButtonY: Integer;
|
|
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 MMXAvailable and ((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 (FBackground.Graphic is TBitmap) and
|
|
(poBackground in PaintOptions);
|
|
ShowImages := Assigned(FImages);
|
|
ShowStateImages := Assigned(FStateImages);
|
|
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
|
|
ButtonX := Round((Integer(FIndent) - FPlusBM.Width) / 2) + 1;
|
|
|
|
// ----- main node paint loop
|
|
while Assigned(PaintInfo.Node) do
|
|
begin
|
|
// Determine LineImage, SelectionLevel and IndentSize
|
|
SelectLevel := DetermineLineImageAndSelectLevel(PaintInfo.Node, LineImage);
|
|
IndentSize := Length(LineImage);
|
|
if not (toFixedIndent in FOptions.FPaintOptions) then
|
|
ButtonX := (IndentSize - 1) * Integer(FIndent) + Round((Integer(FIndent) - FPlusBM.Width) / 2) + 1;
|
|
|
|
// 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;
|
|
|
|
CalculateVerticalAlignments(ShowImages, ShowStateImages, PaintInfo.Node, VAlign, ButtonY);
|
|
|
|
// 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;
|
|
|
|
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) 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);
|
|
// Not the entire cell is covered by text. Hence we need a running rectangle to follow up.
|
|
ContentRect := CellRect;
|
|
// Set up the distance from column border (margin).
|
|
if BidiMode <> bdLeftToRight then
|
|
Dec(ContentRect.Right, FMargin)
|
|
else
|
|
Inc(ContentRect.Left, FMargin);
|
|
|
|
if ShowCheckImages and IsMainColumn then
|
|
begin
|
|
ImageInfo[iiCheck].Index := GetCheckImage(Node);
|
|
if ImageInfo[iiCheck].Index > -1 then
|
|
begin
|
|
AdjustImageBorder(FCheckImages, BidiMode, VAlign, ContentRect, ImageInfo[iiCheck]);
|
|
ImageInfo[iiCheck].Ghosted := False;
|
|
end;
|
|
end
|
|
else
|
|
ImageInfo[iiCheck].Index := -1;
|
|
if ShowStateImages then
|
|
begin
|
|
GetImageIndex(PaintInfo, ikState, iiState, FStateImages);
|
|
if ImageInfo[iiState].Index > -1 then
|
|
AdjustImageBorder(FStateImages, BidiMode, VAlign, ContentRect, ImageInfo[iiState]);
|
|
end
|
|
else
|
|
ImageInfo[iiState].Index := -1;
|
|
if ShowImages then
|
|
begin
|
|
GetImageIndex(PaintInfo, ImageKind[vsSelected in Node.States], iiNormal, FImages);
|
|
if ImageInfo[iiNormal].Index > -1 then
|
|
AdjustImageBorder(ImageInfo[iiNormal].Images, BidiMode, VAlign, ContentRect, ImageInfo[iiNormal]);
|
|
end
|
|
else
|
|
ImageInfo[iiNormal].Index := -1;
|
|
|
|
// Take the space for the tree lines into account.
|
|
if IsMainColumn then
|
|
AdjustCoordinatesByIndent(PaintInfo, IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize));
|
|
|
|
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, VAlign, 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)) then
|
|
PaintNodeButton(Canvas, Node, Column, CellRect, ButtonX, ButtonY, BidiMode);
|
|
|
|
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;
|
|
|
|
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); // By Rapid D
|
|
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.Bitmap, PaintInfo.Canvas, Target, TargetRect)
|
|
else
|
|
TileBackground(FBackground.Bitmap, PaintInfo.Canvas, Target, TargetRect);
|
|
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;
|
|
|
|
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;
|
|
Width := TreeRect.Right - TreeRect.Left;
|
|
Height := 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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
{$IFDEF USE_PRINT} // By Rapid D
|
|
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.Width := vPageWidth;
|
|
PrinterImage.Height := 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;
|
|
{$ENDIF USE_PRINT}
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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, -1, 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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
{$IFDEF USE_VT_SAVES} // By Rapid D
|
|
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;
|
|
{$ENDIF USE_VT_SAVES}
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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) 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;
|
|
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
|
|
ScrolledHorizontally := ScrollIntoView(FFocusedColumn, Center);
|
|
|
|
end;
|
|
|
|
Result := ScrolledVertically or ScrolledHorizontally;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TBaseVirtualTree.ScrollIntoView(Column: TColumnIndex; Center: Boolean): 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;
|
|
|
|
begin
|
|
Result := False;
|
|
|
|
if not FHeader.UseColumns then
|
|
Exit;
|
|
if not FHeader.Columns.IsValidColumn(Column) then
|
|
Exit; // Just in case.
|
|
|
|
ColumnLeft := Header.Columns.Items[Column].Left;
|
|
ColumnRight := ColumnLeft + Header.Columns.Items[Column].Width;
|
|
|
|
NewOffset := FEffectiveOffsetX;
|
|
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
|
|
else if not (coFixed in Header.Columns[Column].Options) then
|
|
begin
|
|
if ColumnRight > ClientWidth then
|
|
NewOffset := FEffectiveOffsetX + (ColumnRight - ClientWidth)
|
|
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
|
|
Result := True;
|
|
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;
|
|
|
|
while Assigned(Run) do
|
|
begin
|
|
if not(vsSelected in Run.States) then
|
|
InternalCacheNode(Run);
|
|
Run := NextFunction(Run);
|
|
end;
|
|
if FTempNodeCount > 0 then
|
|
AddToSelection(FTempNodeCache, FTempNodeCount);
|
|
ClearTempCache;
|
|
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
|
|
UpdateRanges;
|
|
end;
|
|
|
|
finally
|
|
Exclude(Node.States, vsToggling);
|
|
if not TogglingTree then
|
|
DoStateChange([], [tsToggling]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TBaseVirtualTree.UpdateHorizontalRange;
|
|
|
|
begin
|
|
if FHeader.UseColumns then
|
|
FRangeX := FHeader.FColumns.TotalWidth
|
|
else
|
|
FRangeX := 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);
|
|
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;
|
|
|
|
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 ---------------------------------------------------------------------------
|
|
{$IFDEF USE_VST} // By Rapid D
|
|
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
|
|
StringOptions := Self.StringOptions;
|
|
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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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;
|
|
begin
|
|
Tree := FLink.FTree;
|
|
case Message.CharCode of
|
|
VK_ESCAPE:
|
|
begin
|
|
Tree.DoCancelEdit;
|
|
Tree.SetFocus;
|
|
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);
|
|
FLink.FTree.DoEndEdit;
|
|
Tree.SetFocus;
|
|
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;
|
|
Tree.FocusedNode := NextNode;
|
|
if Tree.CanEdit(Tree.FocusedNode, Tree.FocusedColumn) then
|
|
Tree.DoEdit;
|
|
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
|
|
DC: HDC;
|
|
Size: TSize;
|
|
LastFont: THandle;
|
|
|
|
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);
|
|
|
|
DC := GetDC(Handle);
|
|
LastFont := SelectObject(DC, Font.Handle);
|
|
try
|
|
// Read needed space for the current text.
|
|
GetTextExtentPoint32(DC, PChar(Text+'yG'), Length(Text)+2, Size);
|
|
Inc(Size.cx, 2 * FLink.FTree.FTextMargin);
|
|
Inc(Size.cy, 2 * FLink.FTree.FTextMargin);
|
|
Height := Max(Size.cy, Height); // Ensure a minimum height so that the edit field's content and cursor are displayed correctly. See #159
|
|
// 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 + Height))
|
|
else
|
|
FLink.SetBounds(Rect(Left, Top, Left + Size.cx, Top + Height));
|
|
finally
|
|
SelectObject(DC, LastFont);
|
|
ReleaseDC(Handle, DC);
|
|
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;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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;
|
|
FEdit.AutoSize := False;
|
|
end;
|
|
FTree := Tree as TCustomVirtualStringTree;
|
|
FNode := Node;
|
|
FColumn := Column;
|
|
// Initial size, font and text of the node.
|
|
FTree.GetTextInfo(Node, Column, FEdit.Font, FTextBounds, Text);
|
|
FEdit.Font.Color := clWindowText;
|
|
FEdit.Parent := Tree;
|
|
FEdit.RecreateWnd;
|
|
FEdit.HandleNeeded;
|
|
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);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TStringEditLink.ProcessMessage(var Message: TMessage);
|
|
|
|
begin
|
|
FEdit.WindowProc(Message);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TStringEditLink.SetBounds(R: TRect);
|
|
|
|
// Sets the outer bounds of the edit control and the actual edit area in the control.
|
|
|
|
var
|
|
lOffset: Integer;
|
|
|
|
begin
|
|
if not FStopping then
|
|
begin
|
|
// 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;
|
|
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
|
|
OffsetRect(R, 0, FTextBounds.Top - FEdit.Top);
|
|
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;
|
|
end;
|
|
|
|
//----------------- TCustomVirtualString -------------------------------------------------------------------------------
|
|
|
|
constructor TCustomVirtualStringTree.Create(AOwner: TComponent);
|
|
|
|
begin
|
|
inherited;
|
|
FPreviouslySelected := nil;
|
|
FDefaultText := 'Node';
|
|
FInternalDataOffset := AllocateInternalDataArea(SizeOf(Cardinal));
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.GetRenderStartValues(Source: TVSTTextSourceType; var Node: PVirtualNode;
|
|
var NextNodeProc: TGetNextNodeProc);
|
|
|
|
begin
|
|
case Source of
|
|
tstInitialized:
|
|
begin
|
|
Node := GetFirstInitialized;
|
|
NextNodeProc := GetNextInitialized;
|
|
end;
|
|
tstSelected:
|
|
begin
|
|
Node := GetFirstSelected;
|
|
NextNodeProc := GetNextSelected;
|
|
end;
|
|
tstCutCopySet:
|
|
begin
|
|
Node := GetFirstCutCopy;
|
|
NextNodeProc := GetNextCutCopy;
|
|
end;
|
|
tstVisible:
|
|
begin
|
|
Node := GetFirstVisible(nil, True);
|
|
NextNodeProc := GetNextVisible;
|
|
end;
|
|
tstChecked:
|
|
begin
|
|
Node := GetFirstChecked;
|
|
NextNodeProc := GetNextChecked;
|
|
end;
|
|
else // tstAll
|
|
Node := GetFirst;
|
|
NextNodeProc := GetNext;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.GetDataFromGrid(const AStrings: TStringList;
|
|
const IncludeHeading: Boolean);
|
|
var
|
|
LColIndex : Integer;
|
|
LStartIndex : Integer;
|
|
LAddString : string;
|
|
LCellText : string;
|
|
LChildNode : PVirtualNode;
|
|
begin
|
|
{ Start from the First column. }
|
|
LStartIndex := 0;
|
|
|
|
{ Do it for Header first }
|
|
if IncludeHeading then
|
|
begin
|
|
LAddString := EmptyStr;
|
|
for LColIndex := LStartIndex to Pred(Header.Columns.Count) do
|
|
begin
|
|
if (LColIndex > LStartIndex) then
|
|
LAddString := LAddString + ',';
|
|
LAddString := LAddString + AnsiQuotedStr(Header.Columns.Items[LColIndex].Text, '"');
|
|
end;//for
|
|
AStrings.Add(LAddString);
|
|
end;//if
|
|
|
|
{ Loop thru the virtual tree for Data }
|
|
LChildNode := GetFirst;
|
|
while Assigned(LChildNode) do
|
|
begin
|
|
LAddString := EmptyStr;
|
|
|
|
{ Read for each column and then populate the text }
|
|
for LColIndex := LStartIndex to Pred(Header.Columns.Count) do
|
|
begin
|
|
LCellText := Text[LChildNode, LColIndex];
|
|
if (LCellText = EmptyStr) then
|
|
LCellText := ' ';
|
|
if (LColIndex > LStartIndex) then
|
|
LAddString := LAddString + ',';
|
|
LAddString := LAddString + AnsiQuotedStr(LCellText, '"');
|
|
end;//for - Header.Columns.Count
|
|
|
|
AStrings.Add(LAddString);
|
|
LChildNode := LChildNode.NextSibling;
|
|
end;//while Assigned(LChildNode);
|
|
end;
|
|
|
|
function TCustomVirtualStringTree.GetImageText(Node: PVirtualNode;
|
|
Kind: TVTImageKind; Column: TColumnIndex): string;
|
|
begin
|
|
Assert(Assigned(Node), 'Node must not be nil.');
|
|
|
|
if not (vsInitialized in Node.States) then
|
|
InitNode(Node);
|
|
Result := '';
|
|
|
|
DoGetImageText(Node, Kind, Column, Result);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.GetOptions: TCustomStringTreeOptions;
|
|
|
|
begin
|
|
Result := FOptions as TCustomStringTreeOptions;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.GetStaticText(Node: PVirtualNode; Column: TColumnIndex): string;
|
|
|
|
var
|
|
lEventArgs: TVSTGetCellTextEventArgs;
|
|
|
|
begin
|
|
Assert(Assigned(Node), 'Node must not be nil.');
|
|
lEventArgs := TVSTGetCellTextEventArgs.Create(Node, Column);
|
|
DoGetText(lEventArgs);
|
|
Exit(lEventArgs.StaticText);
|
|
end;
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.GetText(Node: PVirtualNode; Column: TColumnIndex): string;
|
|
|
|
var
|
|
lEventArgs: TVSTGetCellTextEventArgs;
|
|
|
|
begin
|
|
Assert(Assigned(Node), 'Node must not be nil.');
|
|
lEventArgs := TVSTGetCellTextEventArgs.Create(Node, Column);
|
|
lEventArgs.CellText := FDefaultText;
|
|
DoGetText(lEventArgs);
|
|
Exit(lEventArgs.CellText)
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.InitializeTextProperties(var PaintInfo: TVTPaintInfo);
|
|
|
|
// Initializes default values for customization in PaintNormalText.
|
|
|
|
begin
|
|
with PaintInfo do
|
|
begin
|
|
// Set default font values first.
|
|
Canvas.Font := Font;
|
|
if Enabled then // Es werden sonst nur die Farben verwendet von Font die an Canvas.Font übergeben wurden
|
|
Canvas.Font.Color := FColors.NodeFontColor
|
|
else
|
|
Canvas.Font.Color := FColors.DisabledColor;
|
|
|
|
if (toHotTrack in FOptions.FPaintOptions) and (Node = FCurrentHotNode) then
|
|
begin
|
|
if not (tsUseExplorerTheme in FStates) then
|
|
begin
|
|
Canvas.Font.Style := Canvas.Font.Style + [fsUnderline];
|
|
Canvas.Font.Color := FColors.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
|
|
begin
|
|
if Node = FDropTargetNode then
|
|
begin
|
|
if ((FLastDropMode = dmOnNode) or (vsSelected in Node.States)) and not
|
|
(tsUseExplorerTheme in FStates) then
|
|
Canvas.Font.Color := FColors.SelectionTextColor;
|
|
end
|
|
else
|
|
if vsSelected in Node.States then
|
|
begin
|
|
if (Focused or (toPopupMode in FOptions.FPaintOptions)) and not
|
|
(tsUseExplorerTheme in FStates) then
|
|
Canvas.Font.Color := FColors.SelectionTextColor;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.PaintNormalText(var PaintInfo: TVTPaintInfo; TextOutFlags: Integer;
|
|
Text: string);
|
|
|
|
// This method is responsible for painting the given text to target canvas (under consideration of the given rectangles).
|
|
// The text drawn here is considered as the normal text in a node.
|
|
// Note: NodeWidth is the actual width of the text to be drawn. This does not necessarily correspond to the width of
|
|
// the node rectangle. The clipping rectangle comprises the entire node (including tree lines, buttons etc.).
|
|
|
|
var
|
|
TripleWidth: Integer;
|
|
R: TRect;
|
|
DrawFormat: Cardinal;
|
|
Size: TSize;
|
|
Height: Integer;
|
|
|
|
begin
|
|
InitializeTextProperties(PaintInfo);
|
|
with PaintInfo do
|
|
begin
|
|
R := ContentRect;
|
|
Canvas.TextFlags := 0;
|
|
InflateRect(R, -FTextMargin, 0);
|
|
|
|
// 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
|
|
// DrawTextW is only available on NT/2000/XP and up. Hence there is only partial multiline support
|
|
// for 9x/Me.
|
|
if vsMultiline in Node.States then
|
|
begin
|
|
DoPaintText(Node, Canvas, Column, ttNormal);
|
|
Height := ComputeNodeHeight(Canvas, Node, Column);
|
|
// Disabled node color overrides all other variants.
|
|
if (vsDisabled in Node.States) or not Enabled then
|
|
Canvas.Font.Color := FColors.DisabledColor;
|
|
|
|
// The edit control flag will ensure that no partial line is displayed, that is, only lines
|
|
// which are (vertically) fully visible are drawn.
|
|
DrawFormat := DT_NOPREFIX or DT_WORDBREAK or DT_END_ELLIPSIS or DT_EDITCONTROL or AlignmentToDrawFlag[Alignment];
|
|
if BidiMode <> bdLeftToRight then
|
|
DrawFormat := DrawFormat or DT_RTLREADING;
|
|
|
|
// 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);
|
|
end
|
|
else
|
|
begin
|
|
FFontChanged := False;
|
|
TripleWidth := FEllipsisWidth;
|
|
DoPaintText(Node, Canvas, Column, ttNormal);
|
|
if FFontChanged then
|
|
begin
|
|
// 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;
|
|
|
|
// Disabled node color overrides all other variants.
|
|
if (vsDisabled in Node.States) or not Enabled then
|
|
Canvas.Font.Color := FColors.DisabledColor;
|
|
|
|
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 > -1) and ((NodeWidth - 2 * FTextMargin) > R.Right - R.Left) then
|
|
begin
|
|
Text := DoShortenString(Canvas, Node, Column, Text, R.Right - R.Left, TripleWidth);
|
|
if Alignment = taRightJustify then
|
|
DrawFormat := DrawFormat or DT_RIGHT
|
|
else
|
|
DrawFormat := DrawFormat or DT_LEFT;
|
|
end
|
|
else
|
|
DrawFormat := DrawFormat or AlignmentToDrawFlag[Alignment];
|
|
end;
|
|
|
|
if Canvas.TextFlags and ETO_OPAQUE = 0 then
|
|
SetBkMode(Canvas.Handle, TRANSPARENT)
|
|
else
|
|
SetBkMode(Canvas.Handle, OPAQUE);
|
|
|
|
DoTextDrawing(PaintInfo, Text, R, DrawFormat);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.PaintStaticText(const PaintInfo: TVTPaintInfo; TextOutFlags: Integer;
|
|
const Text: string);
|
|
|
|
// This method retrives and draws the static text bound to a particular node.
|
|
|
|
var
|
|
R: TRect;
|
|
DrawFormat: Cardinal;
|
|
|
|
begin
|
|
with PaintInfo do
|
|
begin
|
|
Canvas.Font := Font;
|
|
if toFullRowSelect in FOptions.FSelectionOptions then
|
|
begin
|
|
if Node = FDropTargetNode then
|
|
begin
|
|
if (FLastDropMode = dmOnNode) or (vsSelected in Node.States) then
|
|
Canvas.Font.Color := FColors.SelectionTextColor
|
|
else
|
|
Canvas.Font.Color := FColors.NodeFontColor;
|
|
end
|
|
else
|
|
if vsSelected in Node.States then
|
|
begin
|
|
if Focused or (toPopupMode in FOptions.FPaintOptions) then
|
|
Canvas.Font.Color := FColors.SelectionTextColor
|
|
else
|
|
Canvas.Font.Color := FColors.NodeFontColor;
|
|
end;
|
|
end;
|
|
|
|
DrawFormat := DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE;
|
|
Canvas.TextFlags := 0;
|
|
DoPaintText(Node, Canvas, Column, ttStatic);
|
|
|
|
// Disabled node color overrides all other variants.
|
|
if (vsDisabled in Node.States) or not Enabled then
|
|
Canvas.Font.Color := FColors.DisabledColor;
|
|
|
|
R := ContentRect;
|
|
if Alignment = taRightJustify then
|
|
Dec(R.Right, NodeWidth + FTextMargin)
|
|
else
|
|
Inc(R.Left, NodeWidth + FTextMargin);
|
|
|
|
if Canvas.TextFlags and ETO_OPAQUE = 0 then
|
|
SetBkMode(Canvas.Handle, TRANSPARENT)
|
|
else
|
|
SetBkMode(Canvas.Handle, OPAQUE);
|
|
Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), R, DrawFormat);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.ReadText(Reader: TReader);
|
|
|
|
begin
|
|
case Reader.NextValue of
|
|
vaLString, vaString:
|
|
SetDefaultText(Reader.ReadString);
|
|
else
|
|
SetDefaultText(Reader.ReadString);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.SaveToCSVFile(
|
|
const FileNameWithPath: TFileName; const IncludeHeading: Boolean): Boolean;
|
|
var
|
|
LResultList : TStringList;
|
|
begin
|
|
Result := False;
|
|
if (FileNameWithPath = '') then
|
|
Exit;
|
|
|
|
LResultList := TStringList.Create;
|
|
try
|
|
{ Get the data from grid. }
|
|
GetDataFromGrid(LResultList, IncludeHeading);
|
|
{ Save File to Disk }
|
|
LResultList.SaveToFile(FileNameWithPath);
|
|
Result := True;
|
|
finally
|
|
FreeAndNil(LResultList);
|
|
end;//try-finally
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.SetDefaultText(const Value: string);
|
|
|
|
begin
|
|
if FDefaultText <> Value then
|
|
begin
|
|
FDefaultText := Value;
|
|
if not (csLoading in ComponentState) then
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.SetOptions(const Value: TCustomStringTreeOptions);
|
|
|
|
begin
|
|
FOptions.Assign(Value);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.SetText(Node: PVirtualNode; Column: TColumnIndex; const Value: string);
|
|
|
|
begin
|
|
DoNewText(Node, Column, Value);
|
|
InvalidateNode(Node);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.WriteText(Writer: TWriter);
|
|
|
|
begin
|
|
Writer.WriteString(FDefaultText);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.WMSetFont(var Msg: TWMSetFont);
|
|
|
|
// Whenever a new font is applied to the tree some default values are determined to avoid frequent
|
|
// determination of the same value.
|
|
|
|
var
|
|
MemDC: HDC;
|
|
Run: PVirtualNode;
|
|
TM: TTextMetric;
|
|
Size: TSize;
|
|
Data: PInteger;
|
|
|
|
begin
|
|
inherited;
|
|
|
|
MemDC := CreateCompatibleDC(0);
|
|
try
|
|
SelectObject(MemDC, Msg.Font);
|
|
GetTextMetrics(MemDC, TM);
|
|
FTextHeight := TM.tmHeight;
|
|
|
|
GetTextExtentPoint32W(MemDC, '...', 3, Size);
|
|
FEllipsisWidth := Size.cx;
|
|
finally
|
|
DeleteDC(MemDC);
|
|
end;
|
|
|
|
// Have to reset all node widths.
|
|
Run := FRoot.FirstChild;
|
|
while Assigned(Run) do
|
|
begin
|
|
Data := InternalData(Run);
|
|
if Assigned(Data) then
|
|
Data^ := 0;
|
|
Run := GetNextNoInit(Run);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.AddChild(Parent: PVirtualNode; UserData: Pointer): PVirtualNode;
|
|
var
|
|
NewNodeText: string;
|
|
begin
|
|
Result := inherited AddChild(Parent, UserData);
|
|
// Restore the prviously restored node if the caption of this node is knwon and no other node was selected
|
|
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);
|
|
if FPreviouslySelected.IndexOf(NewNodeText) >= 0 then
|
|
begin
|
|
// Select this node and make sure that the parent node is expanded
|
|
Include(FStates, tsPreviouslySelectedLocked);
|
|
try
|
|
Self.Selected[Result] := True;
|
|
finally
|
|
Exclude(FStates, tsPreviouslySelectedLocked);
|
|
end;
|
|
// if a there is a selected node now, then make sure that it is visible
|
|
if (Self.GetFirstSelected <> nil) and (UpdateCount = 0) then
|
|
Self.ScrollIntoView(Self.GetFirstSelected, True);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.AdjustPaintCellRect(var PaintInfo: TVTPaintInfo; var NextNonEmpty: TColumnIndex);
|
|
|
|
// In the case a node spans several columns (if enabled) we need to determine how many columns.
|
|
// 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
|
|
begin
|
|
// Start with the directly following column.
|
|
NextNonEmpty := GetNextVisibleColumn(Column);
|
|
|
|
// Auto spanning columns can only be used for left-to-right directionality because the tree is drawn
|
|
// from left to right. For RTL directionality it would be necessary to draw it from right to left.
|
|
// While this could be managed, it becomes impossible when directionality is mixed.
|
|
repeat
|
|
if (NextNonEmpty = InvalidColumn) or not ColumnIsEmpty(Node, NextNonEmpty) or
|
|
(Items[NextNonEmpty].BidiMode <> bdLeftToRight) then
|
|
Break;
|
|
Inc(CellRect.Right, Items[NextNonEmpty].Width);
|
|
NextNonEmpty := GetNextVisibleColumn(NextNonEmpty);
|
|
until False;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.CalculateStaticTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const Text: string): Integer;
|
|
|
|
begin
|
|
Result := 0;
|
|
if (Length(Text) > 0) and (Alignment <> taCenter) and not (vsMultiline in Node.States) then
|
|
begin
|
|
DoPaintText(Node, Canvas, Column, ttStatic);
|
|
|
|
Inc(Result, DoTextMeasuring(Canvas, Node, Column, Text).cx);
|
|
Inc(Result, FTextMargin);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.CalculateTextWidth(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
|
|
const Text: string): Integer;
|
|
|
|
// Determines the width of the given text.
|
|
|
|
begin
|
|
Result := 2 * FTextMargin;
|
|
if Length(Text) > 0 then
|
|
begin
|
|
Canvas.Font := Font;
|
|
DoPaintText(Node, Canvas, Column, ttNormal);
|
|
|
|
Inc(Result, DoTextMeasuring(Canvas, Node, Column, Text).cx);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean;
|
|
|
|
// For hit tests it is necessary to consider cases where columns are empty and automatic column spanning is enabled.
|
|
// This method simply checks the given column's text and if this is empty then the column is considered as being empty.
|
|
|
|
begin
|
|
Result := Length(Text[Node, Column]) = 0;
|
|
// If there is no text then let the ancestor decide if the column is to be considered as being empty
|
|
// (e.g. by asking the application). If there is text then the column is never be considered as being empty.
|
|
if Result then
|
|
Result := inherited ColumnIsEmpty(Node, Column);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.DefineProperties(Filer: TFiler);
|
|
|
|
begin
|
|
inherited;
|
|
|
|
// Delphi still cannot handle wide strings properly while streaming
|
|
Filer.DefineProperty('WideDefaultText', ReadText, WriteText, FDefaultText <> 'Node');
|
|
Filer.DefineProperty('StringOptions', ReadOldStringOptions, nil, False);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
destructor TCustomVirtualStringTree.Destroy;
|
|
begin
|
|
FreeAndNil(FPreviouslySelected);
|
|
inherited;
|
|
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.
|
|
if Result = nil then
|
|
Result := TStringEditLink.Create;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex;
|
|
var LineBreakStyle: TVTTooltipLineBreakStyle): string;
|
|
|
|
begin
|
|
Result := inherited DoGetNodeHint(Node, Column, LineBreakStyle);
|
|
if Assigned(FOnGetHint) then
|
|
FOnGetHint(Self, Node, Column, LineBreakStyle, Result);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.DoGetNodeTooltip(Node: PVirtualNode; Column: TColumnIndex;
|
|
var LineBreakStyle: TVTTooltipLineBreakStyle): string;
|
|
|
|
begin
|
|
Result := inherited DoGetNodeToolTip(Node, Column, LineBreakStyle);
|
|
if Assigned(FOnGetHint) then
|
|
FOnGetHint(Self, Node, Column, LineBreakStyle, Result)
|
|
else
|
|
Result := Text[Node, Column];
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.DoGetNodeExtraWidth(Node: PVirtualNode; Column: TColumnIndex;
|
|
Canvas: TCanvas = nil): Integer;
|
|
|
|
begin
|
|
if not (toShowStaticText in TreeOptions.FStringOptions) then
|
|
Exit(0);
|
|
if Canvas = nil then
|
|
Canvas := Self.Canvas;
|
|
Result := CalculateStaticTextWidth(Canvas, Node, Column, StaticText[Node, Column]);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer;
|
|
|
|
// 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;
|
|
|
|
begin
|
|
if (Column > NoColumn) and (vsMultiline in Node.States) then
|
|
Result := FHeader.Columns[Column].Width
|
|
else
|
|
begin
|
|
if Canvas = nil then
|
|
Canvas := Self.Canvas;
|
|
|
|
if Column = FHeader.MainColumn then
|
|
begin
|
|
// Primary column or no columns.
|
|
Data := InternalData(Node);
|
|
if Assigned(Data) then
|
|
begin
|
|
Result := Data^;
|
|
if Result = 0 then
|
|
begin
|
|
Data^ := CalculateTextWidth(Canvas, Node, Column, Text[Node, Column]);
|
|
Result := Data^;
|
|
end;
|
|
end
|
|
else
|
|
Result := 0;
|
|
end
|
|
else
|
|
// any other column
|
|
Result := CalculateTextWidth(Canvas, Node, Column, Text[Node, Column]);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.DoGetText(var pEventArgs: TVSTGetCellTextEventArgs);
|
|
|
|
begin
|
|
if not (vsInitialized in pEventArgs.Node.States) then
|
|
InitNode(pEventArgs.Node);
|
|
if Assigned(OnGetCellText) then
|
|
begin
|
|
OnGetCellText(Self, pEventArgs);
|
|
end
|
|
else if Assigned(FOnGetText) then begin
|
|
FOnGetText(Self, pEventArgs.Node, pEventArgs.Column, TVSTTextType.ttNormal, pEventArgs.CellText);
|
|
FOnGetText(Self, pEventArgs.Node, pEventArgs.Column, TVSTTextType.ttStatic, pEventArgs.StaticText);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.DoIncrementalSearch(Node: PVirtualNode; const Text: string): Integer;
|
|
|
|
// Since the string tree has access to node text it can do incremental search on its own. Use the event to
|
|
// override the default behavior.
|
|
|
|
begin
|
|
Result := 0;
|
|
if Assigned(FOnIncrementalSearch) then
|
|
FOnIncrementalSearch(Self, Node, Text, Result)
|
|
else
|
|
// Default behavior is to match the search string with the start of the node text.
|
|
if Pos(Text, GetText(Node, FocusedColumn)) <> 1 then
|
|
Result := 1;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.DoNewText(Node: PVirtualNode; Column: TColumnIndex; const Text: string);
|
|
|
|
begin
|
|
if Assigned(FOnNewText) then
|
|
FOnNewText(Self, Node, Column, Text);
|
|
|
|
// The width might have changed, so update the scrollbar.
|
|
if FUpdateCount = 0 then
|
|
UpdateHorizontalScrollBar(True);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.DoPaintNode(var PaintInfo: TVTPaintInfo);
|
|
|
|
// Main output routine to print the text of the given node using the space provided in PaintInfo.ContentRect.
|
|
|
|
var
|
|
lEventArgs: TVSTGetCellTextEventArgs;
|
|
TextOutFlags: Integer;
|
|
|
|
begin
|
|
// Set a new OnChange event for the canvas' font so we know if the application changes it in the callbacks.
|
|
// This long winded procedure is necessary because font changes (as well as brush and pen changes) are
|
|
// unfortunately not announced via the Canvas.OnChange event.
|
|
RedirectFontChangeEvent(PaintInfo.Canvas);
|
|
try
|
|
|
|
// Determine main text direction as well as other text properties.
|
|
TextOutFlags := ETO_CLIPPED or RTLFlag[PaintInfo.BidiMode <> bdLeftToRight];
|
|
lEventArgs := TVSTGetCellTextEventArgs.Create(PaintInfo.Node, PaintInfo.Column);
|
|
DoGetText(lEventArgs);
|
|
|
|
// Paint the normal text first...
|
|
if not lEventArgs.CellText.IsEmpty then
|
|
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);
|
|
finally
|
|
RestoreFontChangeEvent(PaintInfo.Canvas);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
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;
|
|
|
|
var
|
|
Done: Boolean;
|
|
|
|
begin
|
|
Done := False;
|
|
if Assigned(FOnShortenString) then
|
|
FOnShortenString(Self, Canvas, Node, Column, S, Width, Result, Done);
|
|
if not Done then
|
|
Result := ShortenString(Canvas.Handle, S, Width, EllipsisWidth);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.DoTextDrawing(var PaintInfo: TVTPaintInfo; const Text: string; CellRect: TRect;
|
|
DrawFormat: Cardinal);
|
|
|
|
var
|
|
DefaultDraw: Boolean;
|
|
|
|
begin
|
|
DefaultDraw := True;
|
|
if Assigned(FOnDrawText) then
|
|
FOnDrawText(Self, PaintInfo.Canvas, PaintInfo.Node, PaintInfo.Column, Text, CellRect, DefaultDraw);
|
|
if DefaultDraw then
|
|
Winapi.Windows.DrawTextW(PaintInfo.Canvas.Handle, PWideChar(Text), Length(Text), CellRect, DrawFormat);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.DoTextMeasuring(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
|
|
const Text: string): TSize;
|
|
|
|
var
|
|
R: TRect;
|
|
DrawFormat: Integer;
|
|
|
|
begin
|
|
GetTextExtentPoint32W(Canvas.Handle, PWideChar(Text), Length(Text), Result);
|
|
if vsMultiLine in Node.States then
|
|
begin
|
|
DrawFormat := DT_CALCRECT or DT_NOPREFIX or DT_WORDBREAK or DT_END_ELLIPSIS or DT_EDITCONTROL or AlignmentToDrawFlag[Alignment];
|
|
if BidiMode <> bdLeftToRight then
|
|
DrawFormat := DrawFormat or DT_RTLREADING;
|
|
|
|
R := Rect(0, 0, Result.cx, MaxInt);
|
|
Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), R, DrawFormat);
|
|
Result.cx := R.Right - R.Left;
|
|
end;
|
|
if Assigned(FOnMeasureTextWidth) then
|
|
FOnMeasureTextWidth(Self, Canvas, Node, Column, Text, Result.cx);
|
|
if Assigned(FOnMeasureTextHeight) then
|
|
FOnMeasureTextHeight(Self, Canvas, Node, Column, Text, Result.cy);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.GetOptionsClass: TTreeOptionsClass;
|
|
|
|
begin
|
|
Result := TCustomStringTreeOptions;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.InternalData(Node: PVirtualNode): Pointer;
|
|
|
|
begin
|
|
if (Node = FRoot) or (Node = nil) or (FInternalDataOffset = 0) then
|
|
Result := nil
|
|
else
|
|
Result := PByte(Node) + Self.NodeDataSize + FInternalDataOffset;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.MainColumnChanged;
|
|
|
|
var
|
|
Run: PVirtualNode;
|
|
Data: PInteger;
|
|
|
|
begin
|
|
inherited;
|
|
|
|
// Have to reset all node widths.
|
|
Run := FRoot.FirstChild;
|
|
while Assigned(Run) do
|
|
begin
|
|
Data := InternalData(Run);
|
|
if Assigned(Data) then
|
|
Data^ := 0;
|
|
Run := GetNextNoInit(Run);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType,
|
|
ChunkSize: Integer): Boolean;
|
|
|
|
// read in the caption chunk if there is one
|
|
|
|
var
|
|
NewText: string;
|
|
|
|
begin
|
|
case ChunkType of
|
|
CaptionChunk:
|
|
begin
|
|
NewText := '';
|
|
if ChunkSize > 0 then
|
|
begin
|
|
SetLength(NewText, ChunkSize div 2);
|
|
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;
|
|
Result := True;
|
|
end;
|
|
else
|
|
Result := inherited ReadChunk(Stream, Version, Node, ChunkType, ChunkSize);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
type
|
|
TOldVTStringOption = (soSaveCaptions, soShowStaticText);
|
|
|
|
procedure TCustomVirtualStringTree.ReadOldStringOptions(Reader: TReader);
|
|
|
|
// Migration helper routine to silently convert forms containing the old tree options member into the new
|
|
// sub-options structure.
|
|
|
|
var
|
|
OldOption: TOldVTStringOption;
|
|
EnumName: string;
|
|
|
|
begin
|
|
// If we are at design time currently then let the designer know we changed something.
|
|
UpdateDesigner;
|
|
|
|
// It should never happen at this place that there is something different than the old set.
|
|
if Reader.ReadValue = vaSet then
|
|
with TreeOptions do
|
|
begin
|
|
// Remove all default values set by the constructor.
|
|
StringOptions := [];
|
|
|
|
while True do
|
|
begin
|
|
// Sets are stored with their members as simple strings. Read them one by one and map them to the new option
|
|
// in the correct sub-option set.
|
|
EnumName := Reader.ReadStr;
|
|
if EnumName = '' then
|
|
Break;
|
|
OldOption := TOldVTStringOption(GetEnumValue(TypeInfo(TOldVTStringOption), EnumName));
|
|
case OldOption of
|
|
soSaveCaptions:
|
|
StringOptions := FStringOptions + [toSaveCaptions];
|
|
soShowStaticText:
|
|
StringOptions := FStringOptions + [toShowStaticText];
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.RenderOLEData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium;
|
|
ForClipboard: Boolean): HResult;
|
|
|
|
// Returns string expressions of all currently selected nodes in the Medium structure.
|
|
|
|
begin
|
|
Result := inherited RenderOLEData(FormatEtcIn, Medium, ForClipboard);
|
|
if Failed(Result) then
|
|
try
|
|
if ForClipboard then
|
|
Medium.hGlobal := ContentToClipboard(FormatEtcIn.cfFormat, tstCutCopySet)
|
|
else
|
|
Medium.hGlobal := ContentToClipboard(FormatEtcIn.cfFormat, tstSelected);
|
|
|
|
// Fill rest of the Medium structure if rendering went fine.
|
|
if Medium.hGlobal <> 0 then
|
|
begin
|
|
Medium.tymed := TYMED_HGLOBAL;
|
|
Medium.unkForRelease := nil;
|
|
|
|
Result := S_OK;
|
|
end;
|
|
except
|
|
Result := E_FAIL;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.WriteChunks(Stream: TStream; Node: PVirtualNode);
|
|
|
|
// Adds another sibling chunk for Node storing the label if the node is initialized.
|
|
// Note: If the application stores a node's caption in the node's data member (which will be quite common) and needs to
|
|
// store more node specific data then it should use the OnSaveNode event rather than the caption autosave function
|
|
// (take out soSaveCaption from StringOptions). Otherwise the caption is unnecessarily stored twice.
|
|
|
|
var
|
|
Header: TChunkHeader;
|
|
S: string;
|
|
Len: Integer;
|
|
|
|
begin
|
|
inherited;
|
|
if (toSaveCaptions in TreeOptions.FStringOptions) and (Node <> FRoot) and
|
|
(vsInitialized in Node.States) then
|
|
with Stream do
|
|
begin
|
|
// Read the node's caption (primary column only).
|
|
S := Text[Node, FHeader.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));
|
|
Write(PWideChar(S)^, Len);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.ComputeNodeHeight(Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
|
|
S: string): Integer;
|
|
|
|
// Default node height calculation for multi line nodes. This method can be used by the application to delegate the
|
|
// computation to the string tree.
|
|
// Canvas is used to compute that value by using its current font settings.
|
|
// Node and Column describe the cell to be used for the computation.
|
|
// S is the string for which the height must be computed. If this string is empty the cell text is used instead.
|
|
|
|
var
|
|
DrawFormat: Cardinal;
|
|
BidiMode: TBidiMode;
|
|
Alignment: TAlignment;
|
|
PaintInfo: TVTPaintInfo;
|
|
Dummy: TColumnIndex;
|
|
LineImage: TLineImage;
|
|
begin
|
|
if Length(S) = 0 then
|
|
S := Text[Node, Column];
|
|
|
|
if Column <= NoColumn then
|
|
begin
|
|
BidiMode := Self.BidiMode;
|
|
Alignment := Self.Alignment;
|
|
end
|
|
else
|
|
begin
|
|
BidiMode := Header.Columns[Column].BidiMode;
|
|
Alignment := Header.Columns[Column].Alignment;
|
|
end;
|
|
|
|
if BidiMode <> bdLeftToRight then
|
|
ChangeBidiModeAlignment(Alignment);
|
|
|
|
if vsMultiline in Node.States then
|
|
DrawFormat := DT_NOPREFIX or DT_TOP or DT_WORDBREAK or DT_EDITCONTROL
|
|
else
|
|
DrawFormat := DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE;
|
|
DrawFormat := DrawFormat or DT_CALCRECT;
|
|
|
|
// Allow for autospanning.
|
|
PaintInfo.Node := Node;
|
|
PaintInfo.BidiMode := BidiMode;
|
|
PaintInfo.Column := Column;
|
|
PaintInfo.CellRect := Rect(0, 0, 0, 0);
|
|
if Column > NoColumn then
|
|
begin
|
|
PaintInfo.CellRect.Right := FHeader.Columns[Column].Width - FTextMargin;
|
|
PaintInfo.CellRect.Left := FTextMargin + FMargin;
|
|
if Column = Header.MainColumn then
|
|
begin
|
|
if toFixedIndent in FOptions.FPaintOptions then
|
|
SetLength(LineImage, 1)
|
|
else
|
|
DetermineLineImageAndSelectLevel(Node, LineImage);
|
|
Inc(PaintInfo.CellRect.Left, Length(LineImage) * Integer(Indent));
|
|
end;
|
|
end
|
|
else
|
|
PaintInfo.CellRect.Right := ClientWidth;
|
|
AdjustPaintCellRect(PaintInfo, Dummy);
|
|
|
|
if BidiMode <> bdLeftToRight then
|
|
DrawFormat := DrawFormat or DT_RIGHT or DT_RTLREADING
|
|
else
|
|
DrawFormat := DrawFormat or DT_LEFT;
|
|
Winapi.Windows.DrawTextW(Canvas.Handle, PWideChar(S), Length(S), PaintInfo.CellRect, DrawFormat);
|
|
Result := PaintInfo.CellRect.Bottom - PaintInfo.CellRect.Top;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.ContentToClipboard(Format: Word; Source: TVSTTextSourceType): HGLOBAL;
|
|
|
|
// This method constructs a shareable memory object filled with string data in the required format. Supported are:
|
|
// CF_TEXT - plain ANSI text (Unicode text is converted using the user's current locale)
|
|
// CF_UNICODETEXT - plain Unicode text
|
|
// CF_CSV - comma separated plain ANSI text
|
|
// CF_VRTF + CF_RTFNOOBS - rich text (plain ANSI)
|
|
// CF_HTML - HTML text encoded using UTF-8
|
|
//
|
|
// Result is the handle to a globally allocated memory block which can directly be used for clipboard and drag'n drop
|
|
// transfers. The caller is responsible for freeing the memory. If for some reason the content could not be rendered
|
|
// the Result is 0.
|
|
|
|
begin
|
|
Result := VirtualTrees.Export.ContentToClipboard(Self, Format, Source);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.ContentToHTML(Source: TVSTTextSourceType; const Caption: string = ''): String;
|
|
|
|
// 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.
|
|
|
|
begin
|
|
Result := VirtualTrees.Export.ContentToHTML(Self, Source, Caption);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.CanExportNode(Node: PVirtualNode): Boolean;
|
|
|
|
begin
|
|
case FOptions.ExportMode of
|
|
emChecked:
|
|
Result := Node.CheckState = csCheckedNormal;
|
|
emUnchecked:
|
|
Result := Node.CheckState = 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
|
|
Result := Selected[Node];
|
|
else
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.AddToSelection(Node: PVirtualNode);
|
|
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
|
|
UpdateNextNodeToSelect(Node);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.RemoveFromSelection(Node: PVirtualNode);
|
|
var
|
|
lSelectedNodeCaption: string;
|
|
lIndex: Integer;
|
|
begin
|
|
inherited;
|
|
if (toRestoreSelection in TreeOptions.SelectionOptions) and Assigned(FPreviouslySelected) and not Self.Selected[Node] then
|
|
begin
|
|
if Self.SelectedCount = 0 then
|
|
FPreviouslySelected.Clear()
|
|
else
|
|
begin
|
|
Self.OnGetText(Self, Node, 0, ttNormal, lSelectedNodeCaption);
|
|
if FPreviouslySelected.Find(lSelectedNodeCaption, lIndex) then
|
|
FPreviouslySelected.Delete(lIndex);
|
|
end;//else
|
|
end;//if
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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.
|
|
|
|
begin
|
|
Result := VirtualTrees.Export.ContentToRTF(Self, Source);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.ContentToCustom(Source: TVSTTextSourceType);
|
|
|
|
// Generic export procedure which polls the application at every stage of the export.
|
|
|
|
begin
|
|
VirtualTrees.Export.ContentToCustom(Self, Source);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.ContentToText(Source: TVSTTextSourceType; Separator: Char): String;
|
|
|
|
begin
|
|
Result := ContentToText(Source, string(Separator));
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
function TCustomVirtualStringTree.ContentToUnicode(Source: TVSTTextSourceType; Separator: Char): string;
|
|
|
|
begin
|
|
Result := Self.ContentToText(Source, string(Separator));
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.ContentToText(Source: TVSTTextSourceType; const Separator: string): string;
|
|
|
|
// Renders the current tree content (depending on Source) as Unicode text.
|
|
// If an entry contains the separator char then it is wrapped with double quotation marks.
|
|
|
|
begin
|
|
Result := VirtualTrees.Export.ContentToUnicodeString(Self, Source, Separator);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.GetTextInfo(Node: PVirtualNode; Column: TColumnIndex; const AFont: TFont; var R: TRect;
|
|
var Text: string);
|
|
|
|
// Returns the font, the text and its bounding rectangle to the caller. R is returned as the closest
|
|
// bounding rectangle around Text.
|
|
|
|
var
|
|
NewHeight: Integer;
|
|
TM: TTextMetric;
|
|
|
|
begin
|
|
// Get default font and initialize the other parameters.
|
|
inherited GetTextInfo(Node, Column, AFont, R, Text);
|
|
|
|
Canvas.Font := AFont;
|
|
|
|
FFontChanged := False;
|
|
RedirectFontChangeEvent(Canvas);
|
|
DoPaintText(Node, Canvas, Column, ttNormal);
|
|
if FFontChanged then
|
|
begin
|
|
AFont.Assign(Canvas.Font);
|
|
GetTextMetrics(Canvas.Handle, TM);
|
|
NewHeight := TM.tmHeight;
|
|
end
|
|
else // Otherwise the correct font is already there and we only need to set the correct height.
|
|
NewHeight := FTextHeight;
|
|
RestoreFontChangeEvent(Canvas);
|
|
|
|
// Alignment to the actual text.
|
|
Text := Self.Text[Node, Column];
|
|
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);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.InvalidateNode(Node: PVirtualNode): TRect;
|
|
|
|
var
|
|
Data: PInteger;
|
|
|
|
begin
|
|
Result := inherited InvalidateNode(Node);
|
|
// Reset node width so changed text attributes are applied correctly.
|
|
if Assigned(Node) then
|
|
begin
|
|
Data := InternalData(Node);
|
|
if Assigned(Data) then
|
|
Data^ := 0;
|
|
// Reset height measured flag too to cause a re-issue of the OnMeasureItem event.
|
|
Exclude(Node.States, vsHeightMeasured);
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TCustomVirtualStringTree.Path(Node: PVirtualNode; Column: TColumnIndex; Delimiter: Char): string;
|
|
|
|
// Constructs a string containing the node and all its parents. The last character in the returned path is always the
|
|
// given delimiter.
|
|
|
|
begin
|
|
if (Node = nil) or (Node = FRoot) then
|
|
Result := Delimiter
|
|
else
|
|
begin
|
|
Result := '';
|
|
while Node <> FRoot do
|
|
begin
|
|
Result := Text[Node, Column] + Delimiter + Result;
|
|
Node := Node.Parent;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TCustomVirtualStringTree.ReinitNode(Node: PVirtualNode; Recursive: Boolean);
|
|
|
|
var
|
|
Data: PInteger;
|
|
|
|
begin
|
|
inherited;
|
|
// Reset node width so changed text attributes are applied correctly.
|
|
if Assigned(Node) and (Node <> FRoot) then
|
|
begin
|
|
Data := InternalData(Node);
|
|
if Assigned(Data) then
|
|
Data^ := 0;
|
|
// vsHeightMeasured is already removed in the base tree.
|
|
end;
|
|
end;
|
|
|
|
//----------------- TVirtualStringTree ---------------------------------------------------------------------------------
|
|
|
|
|
|
function TVirtualStringTree.GetOptions: TStringTreeOptions;
|
|
|
|
begin
|
|
Result := FOptions as TStringTreeOptions;
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure TVirtualStringTree.SetOptions(const Value: TStringTreeOptions);
|
|
|
|
begin
|
|
FOptions.Assign(Value);
|
|
end;
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
function TVirtualStringTree.GetOptionsClass: TTreeOptionsClass;
|
|
|
|
begin
|
|
Result := TStringTreeOptions;
|
|
end;
|
|
{$ENDIF USE_VST}
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
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;
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
{ 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 |
|
|
|
// 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: ^Pointer;
|
|
begin
|
|
NodeData := @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 |
|
|
|
begin
|
|
SetData(Pointer(pUserData));
|
|
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 }
|
|
{$IFDEF USE_VST} // By Rapid D
|
|
constructor TVSTGetCellTextEventArgs.Create(pNode: PVirtualNode; pColumn: TColumnIndex; pExportType: TVTExportType);
|
|
begin
|
|
Self.Node := pNode;
|
|
Self.Column := pColumn;
|
|
Self.ExportType := pExportType;
|
|
end;
|
|
{$ENDIF USE_VST}
|
|
initialization
|
|
// This watcher is used whenever a global structure could be modified by more than one thread.
|
|
Watcher := TCriticalSection.Create;
|
|
|
|
finalization
|
|
if Initialized then
|
|
FinalizeGlobalStructures;
|
|
|
|
Watcher.Free;
|
|
Watcher := nil;
|
|
|
|
end.
|