From 48f19f547ea53032178cc88dc550b0c40983604b Mon Sep 17 00:00:00 2001 From: blikblum Date: Mon, 8 Jun 2009 18:32:59 +0000 Subject: [PATCH] * Synchronize with main VTV repository up to svn rev 181 git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@829 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../virtualtreeview-new/VirtualTrees.pas | 2298 +++++++++-------- 1 file changed, 1208 insertions(+), 1090 deletions(-) diff --git a/components/virtualtreeview-new/VirtualTrees.pas b/components/virtualtreeview-new/VirtualTrees.pas index e573e1e71..f71ca45ce 100644 --- a/components/virtualtreeview-new/VirtualTrees.pas +++ b/components/virtualtreeview-new/VirtualTrees.pas @@ -2,7 +2,7 @@ unit VirtualTrees; {$mode delphi}{$H+} -// Version 4.8.5 +// Version 4.8.6 // // 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 @@ -26,6 +26,26 @@ unit VirtualTrees; // (C) 1999-2001 digital publishing AG. All Rights Reserved. //---------------------------------------------------------------------------------------------------------------------- // +// May 2009 +// - Improvement: new TVTMiscOption toEditOnClick, toEditOnDblClick to control if editing can be started with a single +// click or a double click +// - Bug fix: the internal pointers of TBufferedAnsiString are now PAnsiChar to work correctly with Delphi 2009 +// April 2009 +// - Bug fix: TBaseVirtualTree.GetVisibleParent no longer returns the given node in case it is fully visible +// - Improvement: fixed a potential issue in TVirtualTreeColumns.TotalWidth in case it is called before +// FPositionToIndex is initialized +// - Bug fix: TBaseVirtualTree.CollectSelectedNodesLTR and TBaseVirtualTree.CollectSelectedNodesRTL handle straight +// vertical selection rectangles no longer as empty +// - Bug fix: TCheckImageKind.ckSystemDefault now works as intended +// - Improvement: made the following methods of TBaseVirtualTree virtual: PrepareCell, AddChild, BeginUpdate, +// EndUpdate and SortTree +// - Improvement: made TBaseVirtualTree.PrepareCell protected +// - Improvement: moved some members of TVTEdit and TStringEditLink from private to protected +// - Improvement: re-designed header click handling +// - Improvement: new TVTPaintOption toShowHiddenNodes to globally ignore the hidden state of nodes +// - Improvement: individual nodes can now be hidden without affecting their children +// - Improvement: re-designed Explorer theme drawing +// - Bug fix: corrected allocation problems in TBufferedAnsiString and TWideBufferedString // March 2009 // - Bug fix: fixed an issue in TVirtualTreeColumns.HandleClick that could lead to a case where no header click event // is triggered @@ -321,7 +341,7 @@ uses const {$I lclconstants.inc} - VTVersion = '4.8.5'; + VTVersion = '4.8.6'; VTTreeStreamVersion = 2; VTHeaderStreamVersion = 6; // The header needs an own stream version to indicate changes only relevant to the header. @@ -490,7 +510,8 @@ type vsClearing, // A node's children are being deleted. Don't register structure change event. 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. + vsToggling, // Set when a node is expanded/collapsed to prevent recursive calls. + vsHidden // Indicates that the node should not be painted (without effecting its children). ); TVirtualNodeStates = set of TVirtualNodeState; @@ -531,6 +552,15 @@ type ); 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 @@ -670,8 +700,9 @@ type 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 + toUseExplorerTheme, // Use the explorer theme if run under Windows Vista (or above). + toHideTreeLinesIfThemed, // Do not show tree lines if theming is used. + toShowHiddenNodes // Draw nodes even if they are hidden. ); TVTPaintOptions = set of TVTPaintOption; @@ -722,23 +753,25 @@ type // 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. + 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 ); TVTMiscOptions = set of TVTMiscOption; @@ -754,7 +787,8 @@ const DefaultAnimationOptions = []; DefaultAutoOptions = [toAutoDropExpand, toAutoTristateTracking, toAutoScrollOnExpand, toAutoDeleteMovedNodes]; DefaultSelectionOptions = []; - DefaultMiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]; + DefaultMiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, + toEditOnClick]; DefaultColumnOptions = [coAllowClick, coDraggable, coEnabled, coParentColor, coParentBidiMode, coResizable, coShowDropmark, coVisible, coAllowFocus]; @@ -878,7 +912,17 @@ type end; {$endif UseLocalMemoryManager} - // structure used when info about a certain position in the tree is needed + // 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; @@ -1289,7 +1333,7 @@ type function AdjustHoverColumn(const P: TPoint): Boolean; procedure AdjustPosition(Column: TVirtualTreeColumn; Position: Cardinal); function CanSplitterResize(P: TPoint; Column: TColumnIndex): Boolean; - procedure DoCanSplitterResize(P: TPoint; Column: TColumnIndex; var Allow: Boolean); + procedure DoCanSplitterResize(P: TPoint; Column: TColumnIndex; var Allowed: Boolean); procedure DrawButtonText(DC: HDC; Caption: UTF8String; Bounds: TRect; Enabled, Hot: Boolean; DrawFormat: Cardinal; WrapCaption: Boolean); procedure DrawXPButton(DC: HDC; const ButtonR: TRect; DrawSplitter, Down, Hover: Boolean); @@ -1535,7 +1579,7 @@ type property Columns: TVirtualTreeColumns read FColumns write SetColumns; property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight; property Font: TFont read FFont write SetFont stored IsFontStored; - property FixedAreaConstraints: TVTFixedAreaConstraints read FFixedAreaConstraints write FFixedAreaConstraints; + property FixedAreaConstraints: TVTFixedAreaConstraints read FFixedAreaConstraints write FFixedAreaConstraints; property Height: Integer read FHeight write SetHeight default 17; property Images: TCustomImageList read FImages write SetImages; property MainColumn: TColumnIndex read GetMainColumn write SetMainColumn default 0; @@ -1959,14 +2003,13 @@ type TVTSaveNodeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Stream: TStream) of object; // header/column events - TVTHeaderClickEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, - Y: Integer) of object; + TVTHeaderClickEvent = procedure(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo) of object; TVTHeaderMouseEvent = procedure(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object; TVTHeaderMouseMoveEvent = procedure(Sender: TVTHeader; Shift: TShiftState; X, Y: Integer) of object; TVTBeforeHeaderHeightTrackingEvent = procedure(Sender: TVTHeader; Shift: TShiftState) of object; TVTAfterHeaderHeightTrackingEvent = procedure(Sender: TVTHeader) of object; - TVTHeaderHeightTrackingEvent = procedure(Sender: TVTHeader; var P: TPoint; Shift: TShiftState; var Allow: Boolean) of object; - TVTHeaderHeightDblClickResizeEvent = procedure(Sender: TVTHeader; var P: TPoint; Shift: TShiftState; var Allow: Boolean) 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; @@ -1979,21 +2022,21 @@ type const Elements: THeaderPaintElements) of object; TVTBeforeAutoFitColumnsEvent = procedure(Sender: TVTHeader; var SmartAutoFitType: TSmartAutoFitType) of object; TVTBeforeAutoFitColumnEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var SmartAutoFitType: TSmartAutoFitType; - var Allow: Boolean) of object; + 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; TVTColumnWidthDblClickResizeEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; Shift: TShiftState; P: TPoint; - var Allow: Boolean) of object; + 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 Allow: Boolean) of object; + 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 Allow: Boolean) of object; + TVTCanSplitterResizeColumnEvent = procedure(Sender: TVTHeader; P: TPoint; Column: TColumnIndex; var Allowed: Boolean) of object; // move, copy and node tracking events TVTNodeMovedEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode) of object; @@ -2003,9 +2046,9 @@ type TVTNodeCopyingEvent = procedure(Sender: TBaseVirtualTree; Node, Target: PVirtualNode; var Allowed: Boolean) of object; TVTNodeHeightTrackingEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Shift: TShiftState; - var TrackPoint: TPoint; P: TPoint; var Allow: Boolean) of object; + var TrackPoint: TPoint; P: TPoint; var Allowed: Boolean) of object; TVTNodeHeightDblClickResizeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - Shift: TShiftState; P: TPoint; var Allow: Boolean) of object; + Shift: TShiftState; P: TPoint; var Allowed: Boolean) of object; // drag'n drop/OLE events TVTCreateDragManagerEvent = procedure(Sender: TBaseVirtualTree; out DragManager: IVTDragManager) of object; @@ -2136,7 +2179,9 @@ type // paint support and images FPlusBM, - FMinusBM: TBitmap; // small bitmaps used for tree buttons + FMinusBM, // small bitmaps used for tree buttons + FHotPlusBM, + FHotMinusBM: TBitmap; // small bitmaps used for hot tree buttons FImages, // normal images in the tree FStateImages: TCustomImageList; // state images in the tree FCustomCheckImages: TBitmap; // application defined check images @@ -2282,14 +2327,12 @@ type FOnAfterAutoFitColumns: TVTAfterAutoFitColumnsEvent; FOnBeforeAutoFitColumns: TVTBeforeAutoFitColumnsEvent; FOnBeforeAutoFitColumn: TVTBeforeAutoFitColumnEvent; - FOnHeaderClick, // mouse events for the header, just like those for a control - FOnHeaderCheckBoxClick: TVTHeaderClickEvent; + FOnHeaderClick: TVTHeaderClickEvent; FOnHeaderDblClick: TVTHeaderClickEvent; FOnAfterHeaderHeightTracking: TVTAfterHeaderHeightTrackingEvent; FOnBeforeHeaderHeightTracking: TVTBeforeHeaderHeightTrackingEvent; FOnHeaderHeightTracking: TVTHeaderHeightTrackingEvent; FOnHeaderHeightDblClickResize: TVTHeaderHeightDblClickResizeEvent; - FOnHeaderImageClick: TVTHeaderClickEvent; FOnHeaderMouseDown, FOnHeaderMouseUp: TVTHeaderMouseEvent; FOnHeaderMouseMove: TVTHeaderMouseMoveEvent; @@ -2372,6 +2415,7 @@ type const NewRect: TRect): Boolean; procedure ClearNodeBackground(const PaintInfo: TVTPaintInfo; UseBackground, Floating: Boolean; R: TRect); function CompareNodePositions(Node1, Node2: PVirtualNode; ConsiderChildrenAbove: Boolean = False): Integer; + function DetermineLineImageAndSelectLevel(Node: PVirtualNode; var LineImage: TLineImage): 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; @@ -2389,6 +2433,7 @@ type function GetExpanded(Node: PVirtualNode): Boolean; function GetFullyVisible(Node: PVirtualNode): Boolean; function GetHasChildren(Node: PVirtualNode): Boolean; + function GetHidden(Node: PVirtualNode): Boolean; function GetMultiline(Node: PVirtualNode): Boolean; function GetNodeHeight(Node: PVirtualNode): Cardinal; function GetNodeParent(Node: PVirtualNode): PVirtualNode; @@ -2406,7 +2451,6 @@ type function HasVisiblePreviousSibling(Node: PVirtualNode): Boolean; procedure ImageListChange(Sender: TObject); procedure InitializeFirstColumnValues(var PaintInfo: TVTPaintInfo); - function InitializeLineImageAndSelectLevel(Node: PVirtualNode; var LineImage: TLineImage): Integer; procedure InitRootNode(OldSize: Cardinal = 0); procedure InterruptValidation; function IsFirstVisibleChild(Parent, Node: PVirtualNode): Boolean; @@ -2418,7 +2462,6 @@ type function PackArrayAsm(TheArray: TNodeArray; Count: Integer): Integer; function PackArray(TheArray: TNodeArray; Count: Integer): Integer; procedure PrepareBitmaps(NeedButtons, NeedLines: Boolean); - procedure PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: Integer); procedure SetAlignment(const Value: TAlignment); procedure SetAnimationDuration(const Value: Cardinal); procedure SetBackground(const Value: TPicture); @@ -2442,6 +2485,7 @@ type procedure SetFullyVisible(Node: PVirtualNode; Value: Boolean); procedure SetHasChildren(Node: PVirtualNode; Value: Boolean); procedure SetHeader(const Value: TVTHeader); + procedure SetHidden(Node: PVirtualNode; Value: Boolean); procedure SetImages(const Value: TCustomImageList); procedure SetIndent(Value: Cardinal); procedure SetLineMode(const Value: TVTLineMode); @@ -2623,16 +2667,14 @@ type function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; virtual; function DoGetPopupMenu(Node: PVirtualNode; Column: TColumnIndex; const Position: TPoint): TPopupMenu; virtual; procedure DoGetUserClipboardFormats(var Formats: TFormatEtcArray); virtual; - procedure DoHeaderCheckBoxClick(Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual; - procedure DoHeaderClick(Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual; - procedure DoHeaderDblClick(Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual; + procedure DoHeaderClick(HitInfo: TVTHeaderHitInfo); virtual; + procedure DoHeaderDblClick(HitInfo: TVTHeaderHitInfo); virtual; procedure DoHeaderDragged(Column: TColumnIndex; OldPosition: TColumnPosition); virtual; procedure DoHeaderDraggedOut(Column: TColumnIndex; const DropPosition: TPoint); virtual; function DoHeaderDragging(Column: TColumnIndex): Boolean; virtual; procedure DoHeaderDraw(Canvas: TCanvas; Column: TVirtualTreeColumn; const R: TRect; Hover, Pressed: Boolean; DropMark: TVTDropMarkMode); virtual; procedure DoHeaderDrawQueryElements(var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); virtual; - procedure DoHeaderImageClick(Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 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; @@ -2701,7 +2743,7 @@ type procedure HandleHotTrack(X, Y: Integer); virtual; procedure HandleIncrementalSearch(CharCode: Word); virtual; procedure HandleMouseDblClick(var Message: TLMMouse; const HitInfo: THitInfo); virtual; - procedure HandleMouseDown(var Message: TLMMouse; const HitInfo: THitInfo); virtual; + procedure HandleMouseDown(var Message: TLMMouse; var HitInfo: THitInfo); virtual; procedure HandleMouseUp(var Message: TLMMouse; const HitInfo: THitInfo); virtual; function HasImage(Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex): Boolean; virtual; function HasPopupMenu(Node: PVirtualNode; Column: TColumnIndex; const Pos: TPoint): Boolean; virtual; @@ -2735,6 +2777,7 @@ type LineImage: TLineImage); virtual; procedure PaintSelectionRectangle(Target: TCanvas; WindowOrgX: Integer; const SelectionRect: TRect; TargetRect: TRect); 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; @@ -2779,7 +2822,7 @@ type 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 ckLightCheck; + 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: TBitmap read FCustomCheckImages write SetCustomCheckImages; @@ -2906,7 +2949,6 @@ type write FOnHeaderHeightTracking; property OnHeaderHeightDblClickResize: TVTHeaderHeightDblClickResizeEvent read FOnHeaderHeightDblClickResize write FOnHeaderHeightDblClickResize; - property OnHeaderImageClick: TVTHeaderClickEvent read FOnHeaderImageClick write FOnHeaderImageClick; property OnHeaderMouseDown: TVTHeaderMouseEvent read FOnHeaderMouseDown write FOnHeaderMouseDown; property OnHeaderMouseMove: TVTHeaderMouseMoveEvent read FOnHeaderMouseMove write FOnHeaderMouseMove; property OnHeaderMouseUp: TVTHeaderMouseEvent read FOnHeaderMouseUp write FOnHeaderMouseUp; @@ -2939,13 +2981,13 @@ type destructor Destroy; override; function AbsoluteIndex(Node: PVirtualNode): Cardinal; - function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; + function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; virtual; 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; + procedure BeginUpdate; virtual; procedure CancelCutOrCopy; function CancelEditNode: Boolean; procedure CancelOperation; @@ -2968,7 +3010,7 @@ type function EditNode(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; function EndEditNode: Boolean; procedure EndSynch; - procedure EndUpdate; + procedure EndUpdate; virtual; function ExecuteAction(Action: TBasicAction): Boolean; override; procedure FinishCutOrCopy; procedure FlushClipboard; @@ -2988,20 +3030,24 @@ type 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): PVirtualNode; - function GetFirstVisibleChild(Node: PVirtualNode): PVirtualNode; - function GetFirstVisibleChildNoInit(Node: PVirtualNode): PVirtualNode; - function GetFirstVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True): PVirtualNode; + function GetFirstVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeHidden: Boolean = False): PVirtualNode; + function GetFirstVisibleChild(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; + function GetFirstVisibleChildNoInit(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; + function GetFirstVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeHidden: 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): PVirtualNode; - function GetLastVisibleChild(Node: PVirtualNode): PVirtualNode; - function GetLastVisibleChildNoInit(Node: PVirtualNode): PVirtualNode; - function GetLastVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True): PVirtualNode; + function GetLastVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeHidden: Boolean = False): PVirtualNode; + function GetLastVisibleChild(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; + function GetLastVisibleChildNoInit(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; + function GetLastVisibleNoInit(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeHidden: Boolean = False): PVirtualNode; function GetMaxColumnWidth(Column: TColumnIndex; UseSmartColumnWidth: Boolean = False): Integer; function GetNext(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = False): PVirtualNode; function GetNextChecked(Node: PVirtualNode; State: TCheckState = csCheckedNormal; @@ -3015,8 +3061,8 @@ type function GetNextSibling(Node: PVirtualNode): PVirtualNode; function GetNextVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; function GetNextVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; - function GetNextVisibleSibling(Node: PVirtualNode): PVirtualNode; - function GetNextVisibleSiblingNoInit(Node: PVirtualNode): PVirtualNode; + function GetNextVisibleSibling(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; + function GetNextVisibleSiblingNoInit(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; function GetNodeAt(X, Y: Integer): PVirtualNode; overload; function GetNodeAt(X, Y: Integer; Relative: Boolean; var NodeTop: Integer): PVirtualNode; overload; function GetNodeData(Node: PVirtualNode): Pointer; @@ -3025,7 +3071,7 @@ type 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 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; @@ -3033,14 +3079,14 @@ type function GetPreviousSibling(Node: PVirtualNode): PVirtualNode; function GetPreviousVisible(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; function GetPreviousVisibleNoInit(Node: PVirtualNode; ConsiderChildrenAbove: Boolean = True): PVirtualNode; - function GetPreviousVisibleSibling(Node: PVirtualNode): PVirtualNode; - function GetPreviousVisibleSiblingNoInit(Node: PVirtualNode): PVirtualNode; + function GetPreviousVisibleSibling(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; + function GetPreviousVisibleSiblingNoInit(Node: PVirtualNode; IncludeHidden: 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: UTF8String); virtual; function GetTreeRect: TRect; - function GetVisibleParent(Node: PVirtualNode): PVirtualNode; + function GetVisibleParent(Node: PVirtualNode; IncludeHidden: 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); @@ -3049,6 +3095,8 @@ type procedure InvalidateToBottom(Node: PVirtualNode); procedure InvertSelection(VisibleOnly: Boolean); function IsEditing: Boolean; + function IsEffectivelyHidden(Node: PVirtualNode): Boolean; + function IsEffectivelyVisible(Node: PVirtualNode): Boolean; function IsMouseSelecting: Boolean; function IterateSubtree(Node: PVirtualNode; Callback: TVTGetNodeProc; Data: Pointer; Filter: TVirtualNodeStates = []; DoInit: Boolean = False; ChildNodesOnly: Boolean = False): PVirtualNode; @@ -3079,7 +3127,7 @@ type function ScrollIntoView(Column: TColumnIndex; Center: Boolean): Boolean; overload; procedure SelectAll(VisibleOnly: Boolean); procedure Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; - procedure SortTree(Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); + procedure SortTree(Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual; procedure ToggleNode(Node: PVirtualNode); function UpdateAction(Action: TBasicAction): Boolean; override; procedure UpdateHorizontalScrollBar(DoRepaint: Boolean); @@ -3114,6 +3162,7 @@ type property HasChildren[Node: PVirtualNode]: Boolean read GetHasChildren write SetHasChildren; property HotNode: PVirtualNode read FCurrentHotNode; property IsDisabled[Node: PVirtualNode]: Boolean read GetDisabled write SetDisabled; + property IsHidden[Node: PVirtualNode]: Boolean read GetHidden write SetHidden; 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; @@ -3183,8 +3232,6 @@ type TVTEdit = class(TCustomEdit) private - FRefLink: IVTEditLink; - FLink: TStringEditLink; procedure CMAutoAdjust(var Message: TLMessage); message CM_AUTOADJUST; procedure CMExit(var Message: TLMessage); message CM_EXIT; procedure CMRelease(var Message: TLMessage); message CM_RELEASE; @@ -3194,6 +3241,8 @@ type procedure WMGetDlgCode(var Message: TLMNoParams); message LM_GETDLGCODE; procedure WMKeyDown(var Message: TLMKeyDown); message LM_KEYDOWN; protected + FRefLink: IVTEditLink; + FLink: TStringEditLink; procedure AutoAdjustSize; virtual; procedure CreateParams(var Params: TCreateParams); override; public @@ -3214,15 +3263,16 @@ type TStringEditLink = class(TInterfacedObject, IVTEditLink) private FEdit: TVTEdit; // A normal custom edit control. + procedure SetEdit(const Value: TVTEdit); + 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); public - constructor Create; + constructor Create; virtual; destructor Destroy; override; function BeginEdit: Boolean; virtual; stdcall; @@ -3534,7 +3584,6 @@ type property OnHeaderDrawQueryElements; property OnHeaderHeightDblClickResize; property OnHeaderHeightTracking; - property OnHeaderImageClick; property OnHeaderMouseDown; property OnHeaderMouseMove; property OnHeaderMouseUp; @@ -3779,7 +3828,6 @@ type property OnHeaderDrawQueryElements; property OnHeaderHeightTracking; property OnHeaderHeightDblClickResize; - property OnHeaderImageClick; property OnHeaderMouseDown; property OnHeaderMouseMove; property OnHeaderMouseUp; @@ -4028,7 +4076,7 @@ type private FStart, FPosition, - FEnd: PChar; + FEnd: PAnsiChar; function GetAsString: AnsiString; public destructor Destroy; override; @@ -5748,7 +5796,7 @@ end; //----------------- TBufferedAnsiString ------------------------------------------------------------------------------------ const - AllocIncrement = 4096; + AllocIncrement = 2 shl 11; // Must be a power of 2. destructor TBufferedAnsiString.Destroy; @@ -5770,7 +5818,7 @@ end; procedure TBufferedAnsiString.Add(const S: AnsiString); var - LastLen, + NewLen, LastOffset, Len: Integer; @@ -5779,12 +5827,13 @@ begin // Make room for the new string. if FEnd - FPosition <= Len then begin + // Round up NewLen so it is always a multiple of AllocIncrement. + NewLen := FEnd - FStart + (Len + AllocIncrement - 1) and not (AllocIncrement - 1); // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. - LastLen := FEnd - FStart; LastOffset := FPosition - FStart; - ReallocMem(FStart, FEnd - FStart + AllocIncrement); + ReallocMem(FStart, NewLen); FPosition := FStart + LastOffset; - FEnd := FStart + LastLen + AllocIncrement; + FEnd := FStart + NewLen; end; Move(PAnsiChar(S)^, FPosition^, Len); Inc(FPosition, Len); @@ -5795,19 +5844,20 @@ end; procedure TBufferedAnsiString.AddNewLine; var - LastLen, + NewLen, LastOffset: Integer; begin // Make room for the CR/LF characters. if FEnd - FPosition <= 2 then begin + // Round up NewLen so it is always a multiple of AllocIncrement. + NewLen := FEnd - FStart + (2 + AllocIncrement - 1) and not (AllocIncrement - 1); // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. - LastLen := FEnd - FStart; LastOffset := FPosition - FStart; - ReallocMem(FStart, FEnd - FStart + AllocIncrement); + ReallocMem(FStart, NewLen); FPosition := FStart + LastOffset; - FEnd := FStart + LastLen + AllocIncrement; + FEnd := FStart + NewLen; end; FPosition^ := #13; Inc(FPosition); @@ -5837,7 +5887,7 @@ end; procedure TUTF8BufferedString.Add(const S: UTF8String); var - LastLen, + NewLen, LastOffset, Len: Integer; @@ -5846,14 +5896,15 @@ begin // Make room for the new string. if FEnd - FPosition <= Len then begin + // Round up NewLen so it is always a multiple of AllocIncrement. + NewLen := FEnd - FStart + (Len + AllocIncrement - 1) and not (AllocIncrement - 1); // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. - LastLen := FEnd - FStart; LastOffset := FPosition - FStart; - ReallocMem(FStart, 2 * (FEnd - FStart + AllocIncrement)); + ReallocMem(FStart, NewLen); FPosition := FStart + LastOffset; - FEnd := FStart + LastLen + AllocIncrement; + FEnd := FStart + NewLen; end; - Move(PChar(S)^, FPosition^, 2 * Len); + Move(PChar(S)^, FPosition^, Len); Inc(FPosition, Len); end; @@ -5862,19 +5913,21 @@ end; procedure TUTF8BufferedString.AddNewLine; var - LastLen, + NewLen, LastOffset: Integer; begin // Make room for the CR/LF characters. if FEnd - FPosition <= 4 then begin + //todo: see in calculation of NewLen is correct for UTF8String + // Round up NewLen so it is always a multiple of AllocIncrement. + NewLen := FEnd - FStart + (2 + AllocIncrement - 1) and not (AllocIncrement - 1); // Keep last offset to restore it correctly in the case that FStart gets a new memory block assigned. - LastLen := FEnd - FStart; LastOffset := FPosition - FStart; - ReallocMem(FStart, 2 * (FEnd - FStart + AllocIncrement)); + ReallocMem(FStart, NewLen); FPosition := FStart + LastOffset; - FEnd := FStart + LastLen + AllocIncrement; + FEnd := FStart + NewLen; end; FPosition^ := #13; Inc(FPosition); @@ -5968,18 +6021,16 @@ end; procedure TCustomVirtualTreeOptions.SetPaintOptions(const Value: TVTPaintOptions); -{$ifdef ThemeSupport} var ToBeSet, ToBeCleared: TVTPaintOptions; -{$endif} + Run: PVirtualNode; + begin if FPaintOptions <> Value then begin - {$ifdef ThemeSupport} ToBeSet := Value - FPaintOptions; ToBeCleared := FPaintOptions - Value; - {$endif} FPaintOptions := Value; with FOwner do if not (csLoading in ComponentState) and HandleAllocated then @@ -6000,6 +6051,29 @@ begin end else {$endif ThemeSupport} + if toShowHiddenNodes in ToBeSet + ToBeCleared then + begin + BeginUpdate; + InterruptValidation; + Run := GetFirst; + while Assigned(Run) do + begin + if vsHidden in Run.States then + if toShowHiddenNodes in ToBeSet then + begin + Inc(FVisibleCount); + AdjustTotalHeight(Run.Parent, Run.NodeHeight, True); + end + else + begin + AdjustTotalHeight(Run.Parent, -Run.NodeHeight, True); + Dec(FVisibleCount); + end; + Run := GetNext(Run); + end; + EndUpdate; + end + else Invalidate; end; end; @@ -8650,10 +8724,10 @@ end; //---------------------------------------------------------------------------------------------------------------------- -procedure TVirtualTreeColumns.DoCanSplitterResize(P: TPoint; Column: TColumnIndex; var Allow: Boolean); +procedure TVirtualTreeColumns.DoCanSplitterResize(P: TPoint; Column: TColumnIndex; var Allowed: Boolean); begin if Assigned(FHeader.Treeview.FOnCanSplitterResizeColumn) then - FHeader.Treeview.FOnCanSplitterResizeColumn(FHeader, P, Column, Allow); + FHeader.Treeview.FOnCanSplitterResizeColumn(FHeader, P, Column, Allowed); end; //---------------------------------------------------------------------------------------------------------------------- @@ -8923,37 +8997,54 @@ procedure TVirtualTreeColumns.HandleClick(P: TPoint; Button: TMouseButton; Force // double click). var + HitInfo: TVTHeaderHitInfo; NewClickIndex: Integer; - Shift: TShiftState; begin // 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; - Shift := FHeader.GetShiftState; - if DblClick then - Shift := Shift + [ssDouble]; + 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 FHeader.Treeview.UpdateColumnCheckState(Items[NewClickIndex]); - FHeader.Treeview.DoHeaderCheckBoxClick(NewClickIndex, Button, Shift, P.X, P.Y); - end - else - FHeader.Treeview.DoHeaderImageClick(NewClickIndex, Button, Shift, P.X, P.Y) - end - else - FHeader.Treeview.DoHeaderClick(NewClickIndex, Button, Shift, P.X, P.Y); - FHeader.Invalidate(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 + FHeader.Treeview.DoHeaderClick(HitInfo); + + if not (hhiNoWhere in HitInfo.HitPosition) then + FHeader.Invalidate(Items[NewClickIndex]); if (FClickIndex > NoColumn) and (FClickIndex <> NewClickIndex) then FHeader.Invalidate(Items[FClickIndex]); end; @@ -10037,9 +10128,8 @@ var LastColumn: TColumnIndex; begin - if Count = 0 then - Result := 0 - else + Result := 0; + if (Count > 0) and (Length(FPositionToIndex) > 0) then begin LastColumn := FPositionToIndex[Count - 1]; if not (coVisible in Items[LastColumn].FOptions) then @@ -10047,8 +10137,6 @@ begin if LastColumn > NoColumn then with Items[LastColumn] do Result := FLeft + FWidth - else - Result := 0; end; end; @@ -11005,9 +11093,7 @@ begin begin // If the click was on a splitter then resize column to smallest width. if DoColumnWidthDblClickResize(FColumns.FTrackIndex, P, GetShiftState) then - with FColumns do - AnimatedResize(FTrackIndex, Max(FColumns[FTrackIndex].MinWidth, - Treeview.GetMaxColumnWidth(FTrackIndex, coSmartResize in FColumns[FTrackIndex].Options))); + AutoFitColumns(True, smaUseColumnOption, Columns.FTrackIndex, Columns.FTrackIndex); Message.Result := 0; Result := True; end @@ -11022,11 +11108,7 @@ begin // WM_NCLBUTTONDBLCLK Button := mbLeft; end; - - FColumns.HandleClick(P, Button, True, True); - if FColumns.FClickIndex > NoColumn then - FOwner.DoHeaderDblClick(FColumns.FClickIndex, Button, GetShiftState + [ssDouble], P.X, P.Y + - Integer(FHeight)); + 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 @@ -11679,7 +11761,8 @@ begin else EndCol := Min(RangeEndCol, FColumns.Count - 1); - if StartCol > EndCol then exit; // nothing to do + if StartCol > EndCol then + Exit; // nothing to do TreeView.BeginOperation; if Assigned(TreeView.FOnBeforeAutoFitColumns) then @@ -12412,10 +12495,9 @@ begin FIndent := 18; FPlusBM := TBitmap.Create; - FPlusBM.PixelFormat := OptimalPixelFormat; + FHotPlusBM := TBitmap.Create; FMinusBM := TBitmap.Create; - FMinusBM.PixelFormat := OptimalPixelFormat; - + FHotMinusBM := TBitmap.Create; //FBorderStyle := bsSingle; FButtonStyle := bsRectangle; FButtonFillMode := fmTreeColor; @@ -12425,7 +12507,7 @@ begin // we have an own double buffer handling DoubleBuffered := False; - FCheckImageKind := ckLightCheck; + FCheckImageKind := ckSystemDefault; FImageChangeLink := TChangeLink.Create; FImageChangeLink.OnChange := ImageListChange; @@ -12524,7 +12606,9 @@ begin FNodeMemoryManager.Free; {$endif UseLocalMemoryManager} FPlusBM.Free; + FHotPlusBM.Free; FMinusBM.Free; + FHotMinusBM.Free; inherited; end; @@ -12628,7 +12712,8 @@ begin begin Run := Node; repeat - Inc(Integer(Run.TotalHeight), Difference); + if vsVisible in Run.States then + 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 @@ -12885,7 +12970,8 @@ begin // If the old rectangle is empty then we just started the drag selection. // So we just copy the new rectangle to the old and get out of here. - if IsRectEmpty(OldRect) then + if (OldRect.Top < OldRect.Bottom) or (OldRect.Right < OldRect.Left) and + ((OldRect.Left <> OldRect.Right) or (OldRect.Top <> OldRect.Bottom)) then OldRect := NewRect else begin @@ -13079,7 +13165,8 @@ begin // If the old rectangle is empty then we just started the drag selection. // So we just copy the new rectangle to the old and get out of here. - if IsRectEmpty(OldRect) then + if (OldRect.Top < OldRect.Bottom) or (OldRect.Right < OldRect.Left) and + ((OldRect.Left <> OldRect.Right) or (OldRect.Top <> OldRect.Bottom)) then OldRect := NewRect else begin @@ -13380,10 +13467,127 @@ begin end; end; -procedure TBaseVirtualTree.DragAndDrop(AllowedEffects: Integer; - DataObject: IDataObject; DragEffect: Integer); +//---------------------------------------------------------------------------------------------------------------------- + +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; + Run: PVirtualNode; + begin - ActiveX.DoDragDrop(DataObject, VTVDragManager as IDropSource, AllowedEffects, @DragEffect); + 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); + + // 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; + + 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; end; //---------------------------------------------------------------------------------------------------------------------- @@ -13557,7 +13761,7 @@ begin while Assigned(Child) do begin FixupTotalHeight(Child); - if vsVisible in Child.States then + if IsEffectivelyVisible(Child) then Inc(Node.TotalHeight, Child.TotalHeight); Child := Child.NextSibling; end; @@ -13710,6 +13914,14 @@ end; //---------------------------------------------------------------------------------------------------------------------- +function TBaseVirtualTree.GetHidden(Node: PVirtualNode): Boolean; + +begin + Result := vsHidden in Node.States; +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TBaseVirtualTree.GetMultiline(Node: PVirtualNode): Boolean; begin @@ -13997,7 +14209,7 @@ begin begin repeat Node := Node.NextSibling; - Result := vsVisible in Node.States; + Result := IsEffectivelyVisible(Node); until Result or (Node.NextSibling = nil); end; end; @@ -14017,7 +14229,7 @@ begin begin repeat Node := Node.PrevSibling; - Result := vsVisible in Node.States; + Result := IsEffectivelyVisible(Node); until Result or (Node.PrevSibling = nil); end; end; @@ -14053,129 +14265,6 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.InitializeLineImageAndSelectLevel(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; - 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); - - // 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; - - 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; -end; - -//---------------------------------------------------------------------------------------------------------------------- - procedure TBaseVirtualTree.InitRootNode(OldSize: Cardinal = 0); // Reinitializes the root node. @@ -14264,7 +14353,7 @@ var begin // Find first visible child. Run := Parent.FirstChild; - while Assigned(Run) and not (vsVisible in Run.States) do + while Assigned(Run) and not IsEffectivelyVisible(Run) do Run := Run.NextSibling; Result := Assigned(Run) and (Run = Node); @@ -14282,7 +14371,7 @@ var begin // Find last visible child. Run := Parent.LastChild; - while Assigned(Run) and not (vsVisible in Run.States) do + while Assigned(Run) and not IsEffectivelyVisible(Run) do Run := Run.PrevSibling; Result := Assigned(Run) and (Run = Node); @@ -14457,26 +14546,64 @@ var Bits: Pointer; Size: TSize; {$ifdef ThemeSupport} - Details: TThemedElementDetails; Theme: HTHEME; R: TRect; + +const + TVP_HOTGLYPH = 4; + {$endif ThemeSupport} + //--------------- local function -------------------------------------------- + + procedure FillBitmap (ABitmap: TBitmap); + begin + with ABitmap, Canvas do + begin + ABitmap.Width := Size.cx; + ABitmap.Height := Size.cy; + + {$Ifdef ThemeSupport} + if IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) then + begin + if not (coParentColor in FHeader.FColumns[FHeader.FMainColumn].FOptions) then + Brush.Color := FHeader.FColumns[FHeader.FMainColumn].Color + else + Brush.Color := Self.Color; + end + else + begin + {$EndIf ThemeSupport} + MaskHandle := 0; + Transparent := True; + TransparentColor := clFuchsia; + Brush.Color := clFuchsia; + {$Ifdef ThemeSupport} + end; + {$EndIf ThemeSupport} + + FillRect(Rect(0, 0, ABitmap.Width, ABitmap.Height)); + end; + end; + + //--------------- end local function ---------------------------------------- + begin Size.cx := 9; Size.cy := 9; {$ifdef ThemeSupport} - // Under Windows Vista the size of the glyphs differ from 9x9 when the explorer theme is used. Since the - // glyphs are also partly transparent FPlusBM and FMinusBM are not used in that case, but for the sake of - // simplicity we set their size so that the positioning code for the glyps remains the same. - if IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) then + if tsUseThemes in FStates then begin Theme := OpenThemeData(Handle, 'TREEVIEW'); - R := Rect(0, 0, 100, 100); - GetThemePartSize(Theme, FPlusBM.Canvas.Handle, TVP_GLYPH, GLPS_OPENED, @R, TS_TRUE, Size); - CloseThemeData(Theme); - end; + if IsWinVistaOrAbove and (toUseExplorerTheme in FOptions.FPaintOptions) then + begin + R := Rect(0, 0, 100, 100); + GetThemePartSize(Theme, FPlusBM.Canvas.Handle, TVP_GLYPH, GLPS_OPENED, @R, TS_TRUE, Size); + end; + end + else + Theme := 0; {$endif ThemeSupport} if NeedButtons then @@ -14484,104 +14611,96 @@ begin with FMinusBM, Canvas do begin // box is always of odd size - //The TCanvas of VCL does not has width and height. It cause a conflict here - FMinusBM.Width := Size.cx; - FMinusBM.Height := Size.cy; - //Reset mask - MaskHandle := 0; - //todo: remove when transparency is fixed in gtk - {$ifdef Windows} - Brush.Color := clFuchsia; - {$else} - Brush.Color := Self.Color; - {$endif} - FillRect(Rect(0, 0, Size.cx, Size.cy)); - if FButtonStyle = bsTriangle then + FillBitmap(FMinusBM); + FillBitmap(FHotMinusBM); + if not (IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions)) then begin - Brush.Color := clBlack; - Pen.Color := clBlack; - Polygon([Point(0, 2), Point(8, 2), Point(4, 6)]); - MaskHandle := CreateBitmapMask(Handle, Size.cx, Size.cy, clFuchsia); - end - else - begin - // Button style is rectangular. Now ButtonFillMode determines how to fill the interior. - if FButtonFillMode in [fmTreeColor, fmWindowColor, fmTransparent] then + if FButtonStyle = bsTriangle then begin - case FButtonFillMode of - fmTreeColor: - Brush.Color := Self.Color; - fmWindowColor: - Brush.Color := clWindow; - end; - Pen.Color := FColors.TreeLineColor; - Rectangle(0, 0, Size.cx, Size.cy); - Pen.Color := Self.Font.Color; - MoveTo(2, Size.cy div 2); - LineTo(Size.cx - 2 , Size.cy div 2); - if FButtonFillMode = fmTransparent then - MaskHandle := CreateBitmapMask(Handle, Size.cx, Size.cy, clFuchsia); + Brush.Color := clBlack; + Pen.Color := clBlack; + Polygon([Point(0, 2), Point(8, 2), Point(4, 6)]); end else - FMinusBM.LoadFromLazarusResource('VT_XPBUTTONMINUS'); + 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 := Self.Color; + fmWindowColor: + Brush.Color := clWindow; + end; + Pen.Color := FColors.TreeLineColor; + Rectangle(0, 0, Width, Height); + Pen.Color := Self.Font.Color; + MoveTo(2, Width div 2); + LineTo(Width - 2 , Width div 2); + end + else + FMinusBM.LoadFromLazarusResource('VT_XPBUTTONMINUS'); + FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); + end; end; end; with FPlusBM, Canvas do begin - FPlusBM.Width := Size.cx; - FPlusBM.Height := Size.cy; - //Reset mask - MaskHandle := 0; - //todo: remove when transparency is fixed in gtk - {$ifdef Windows} - Brush.Color := clFuchsia; - {$else} - Brush.Color := Self.Color; - {$endif} - FillRect(Rect(0, 0, Size.cx, Size.cy)); - if FButtonStyle = bsTriangle then + FillBitmap(FPlusBM); + FillBitmap(FHotPlusBM); + if not (IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions)) then begin - Brush.Color := clBlack; - Pen.Color := clBlack; - Polygon([Point(2, 0), Point(6, 4), Point(2, 8)]); - MaskHandle := CreateBitmapMask(Handle, Size.cx, Size.cy, clFuchsia); - end - else - begin - // Button style is rectangular. Now ButtonFillMode determines how to fill the interior. - if FButtonFillMode in [fmTreeColor, fmWindowColor, fmTransparent] then + if FButtonStyle = bsTriangle then begin - case FButtonFillMode of - fmTreeColor: - Brush.Color := Self.Color; - fmWindowColor: - Brush.Color := clWindow; - end; - - Pen.Color := FColors.TreeLineColor; - Rectangle(0, 0, Size.cx, Size.cy); - Pen.Color := Self.Font.Color; - MoveTo(2, Size.cy div 2); - LineTo(Size.cx - 2 , Size.cy div 2); - MoveTo(Size.cx div 2, 2); - LineTo(Size.cx div 2, Size.cy - 2); - if FButtonFillMode = fmTransparent then - MaskHandle := CreateBitmapMask(Handle, Size.cx, Size.cy, clFuchsia); + Brush.Color := clBlack; + Pen.Color := clBlack; + Polygon([Point(2, 0), Point(6, 4), Point(2, 8)]); end else - FPlusBM.LoadFromLazarusResource('VT_XPBUTTONPLUS'); + 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 := Self.Color; + fmWindowColor: + Brush.Color := clWindow; + end; + + Pen.Color := FColors.TreeLineColor; + Rectangle(0, 0, Width, Height); + Pen.Color := Self.Font.Color; + 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.LoadFromLazarusResource('VT_XPBUTTONPLUS'); + FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); + end; end; end; {$ifdef ThemeSupport} // Overwrite glyph images if theme is active. - if tsUseThemes in FStates then + if (tsUseThemes in FStates) and (Theme <> 0) then begin - Details := ThemeServices.GetElementDetails(ttGlyphClosed); - ThemeServices.DrawElement(FPlusBM.Canvas.Handle, Details, Rect(0, 0, 9, 9)); - Details := ThemeServices.GetElementDetails(ttGlyphOpened); - ThemeServices.DrawElement(FMinusBM.Canvas.Handle, Details, Rect(0, 0, 9, 9)); + 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 IsWinVistaOrAbove and (toUseExplorerTheme in FOptions.FPaintOptions) then + begin + DrawThemeBackground(Theme, FHotPlusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_CLOSED, R, nil); + DrawThemeBackground(Theme, FHotMinusBM.Canvas.Handle, TVP_HOTGLYPH, GLPS_OPENED, R, nil); + end + else + begin + FHotPlusBM.Canvas.Draw(0, 0, FPlusBM); + FHotMinusBM.Canvas.Draw(0, 0, FMinusBM); + end; end; {$endif ThemeSupport} end; @@ -14608,229 +14727,6 @@ 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; - {$ifdef ThemeSupport} - RowRect: TRect; - Theme: HTHEME; - - {$ifndef COMPILER_11_UP} - const - TREIS_HOTSELECTED = 6; - {$endif COMPILER_11_UP} - {$endif ThemeSupport} - - //--------------- 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; - - //--------------------------------------------------------------------------- - - {$ifdef ThemeSupport} - procedure DrawBackground(State: Integer); - begin - with PaintInfo do - if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then - DrawThemeBackground(Theme, Canvas.Handle, TVP_TREEITEM, State, RowRect, @CellRect) - else - DrawThemeBackground(Theme, Canvas.Handle, TVP_TREEITEM, State, InnerRect, nil); - end; - {$endif ThemeSupport} - - //--------------- end local functions --------------------------------------- - -begin - {$ifdef ThemeSupport} - if IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) then - begin - RowRect := Rect(0, PaintInfo.CellRect.Top, FRangeX, PaintInfo.CellRect.Bottom); - if toShowVertGridLines in FOptions.PaintOptions then - Dec(RowRect.Right); - Theme := OpenThemeData(Handle, 'TREEVIEW'); - end - else - Theme := 0; - {$endif ThemeSupport} - - with PaintInfo, Canvas do - begin - // Fill cell background if its color differs from tree background. - with FHeader.FColumns do - if poColumnColor in PaintOptions then - begin - Brush.Color := Items[Column].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 InnerRect do - if Left + NodeWidth < Right then - Right := Left + NodeWidth; - taCenter: - with InnerRect do - if (Right - Left) > NodeWidth then - begin - Left := (Left + Right - NodeWidth) div 2; - Right := Left + NodeWidth; - end; - taRightJustify: - with 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 MMXAvailable and (toUseBlendedSelection in FOptions.PaintOptions) then - AlphaBlendSelection(Brush.Color) - else - with InnerRect do - RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); - end - else - begin - //todo: remove comment when LCL is fixed - //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 - {$ifdef ThemeSupport} - if Theme <> 0 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 - {$endif ThemeSupport} - if MMXAvailable and (toUseBlendedSelection in FOptions.PaintOptions) then - AlphaBlendSelection(Brush.Color) - else - with InnerRect do - RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); - end; - end; - end; - - {$ifdef ThemeSupport} - if (Theme <> 0) 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)); - {$endif ThemeSupport} - - 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) - {$ifdef ThemeSupport} or - (not (toExtendedFocus in FOptions.FSelectionOptions) and - (toFullRowSelect in FOptions.FSelectionOptions) and - (Theme <> 0) ) - {$endif ThemeSupport} - ) then - begin - TextColorBackup := GetTextColor(Handle); - SetTextColor(Handle, $FFFFFF); - BackColorBackup := GetBkColor(Handle); - SetBkColor(Handle, 0); - - {$ifdef ThemeSupport} - if not (toExtendedFocus in FOptions.FSelectionOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and - (Theme <> 0) then - FocusRect := RowRect - else - {$endif ThemeSupport} - if toGridExtensions in FOptions.FMiscOptions then - FocusRect := CellRect - else - FocusRect := InnerRect; - - {$ifdef ThemeSupport} - if Theme <> 0 then - InflateRect(FocusRect, -1, -1); - {$endif ThemeSupport} - - LCLIntf.DrawFocusRect(Handle, FocusRect); - SetTextColor(Handle, TextColorBackup); - SetBkColor(Handle, BackColorBackup); - end; - end; - end; - - {$ifdef ThemeSupport} - if Theme <> 0 then - CloseThemeData(Theme); - {$endif ThemeSupport} -end; //---------------------------------------------------------------------------------------------------------------------- @@ -15086,7 +14982,7 @@ begin if vsExpanded in Node.States then begin AdjustTotalHeight(Node, NewHeight, True); - if FullyVisible[Node] then + if FullyVisible[Node] and not IsEffectivelyHidden(Node) then Inc(Integer(FVisibleCount), Count); end; @@ -15312,6 +15208,65 @@ end; //---------------------------------------------------------------------------------------------------------------------- +procedure TBaseVirtualTree.SetHidden(Node: PVirtualNode; Value: Boolean); + +// Sets the hidden flag of the given node according to Value. + +var + NeedUpdate: Boolean; + +begin + Assert(Assigned(Node) and (Node <> FRoot), 'Invalid parameter.'); + + if Value <> (vsHidden in Node.States) then + begin + InterruptValidation; + NeedUpdate := False; + if Value then + begin + Include(Node.States, vsHidden); + if (vsExpanded in Node.Parent.States) and not (toShowHiddenNodes in FOptions.FPaintOptions) then + AdjustTotalHeight(Node.Parent, -Integer(NodeHeight[Node]), True); + if VisiblePath[Node] then + begin + Dec(FVisibleCount); + NeedUpdate := True; + end; + + if FUpdateCount = 0 then + DetermineHiddenChildrenFlag(Node.Parent) + else + Include(FStates, tsUpdateHiddenChildrenNeeded); + end + else + begin + Exclude(Node.States, vsHidden); + if (vsExpanded in Node.Parent.States) and not (toShowHiddenNodes in FOptions.FPaintOptions) then + AdjustTotalHeight(Node.Parent, Integer(NodeHeight[Node]), True); + + if VisiblePath[Node] then + begin + Inc(FVisibleCount); + NeedUpdate := True; + 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 @@ -15463,7 +15418,7 @@ begin UpdateEditBounds; // Stay away from touching the node cache while it is being validated. - if not (tsValidating in FStates) and FullyVisible[Node] then + if not (tsValidating in FStates) and FullyVisible[Node] and not IsEffectivelyHidden(Node) then begin InvalidateCache; if FUpdateCount = 0 then @@ -15596,7 +15551,7 @@ begin if FSelectionCount = 0 then ResetRangeAnchor; end; - if FullyVisible[Node] then + if FullyVisible[Node] and not IsEffectivelyHidden(Node) then InvalidateNode(Node); end; end; @@ -15700,7 +15655,7 @@ begin if Node.Align <> Value then begin Node.Align := Value; - if FullyVisible[Node] and (FUpdateCount = 0) then + if FullyVisible[Node] and not IsEffectivelyHidden(Node) then InvalidateNode(Node); end; end; @@ -18828,7 +18783,8 @@ begin Node := Node.FirstChild; while Assigned(Node) do begin - if vsVisible in Node.States then + if (vsVisible in Node.States) and (not (vsHidden in Node.States) or + (toShowHiddenNodes in FOptions.FPaintOptions)) then Inc(Result, CountVisibleChildren(Node) + 1); Node := Node.NextSibling; end; @@ -18979,7 +18935,7 @@ begin begin // Iterate through all siblings and stop when one visible is found. Run := Node.FirstChild; - while Assigned(Run) and not (vsVisible in Run.States) do + while Assigned(Run) and not IsEffectivelyVisible(Run) do Run := Run.NextSibling; if Assigned(Run) then Exclude(Node.States, vsAllChildrenHidden) @@ -20275,42 +20231,20 @@ end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoHeaderClick(Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TBaseVirtualTree.DoHeaderClick(HitInfo: TVTHeaderHitInfo); begin if Assigned(FOnHeaderClick) then - FOnHeaderClick(FHeader, Column, Button, Shift, X, Y); + FOnHeaderClick(FHeader, HitInfo); end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.DoHeaderDblClick(Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TBaseVirtualTree.DoHeaderDblClick(HitInfo: TVTHeaderHitInfo); begin if Assigned(FOnHeaderDblClick) then - FOnHeaderDblClick(FHeader, Column, Button, Shift, X, Y); -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderImageClick(Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); - -begin - if Assigned(FOnHeaderImageClick) then - FOnHeaderImageClick(FHeader, Column, Button, Shift, X, Y) - else if Assigned(FOnHeaderClick) then - FOnHeaderClick(FHeader, Column, Button, Shift, X, Y) -end; - -//---------------------------------------------------------------------------------------------------------------------- - -procedure TBaseVirtualTree.DoHeaderCheckBoxClick(Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); - -begin - if Assigned(FOnHeaderCheckBoxClick) then - FOnHeaderCheckBoxClick(FHeader, Column, Button, Shift, X, Y); + FOnHeaderDblClick(FHeader, HitInfo); end; //---------------------------------------------------------------------------------------------------------------------- @@ -21100,6 +21034,15 @@ end; //---------------------------------------------------------------------------------------------------------------------- +procedure TBaseVirtualTree.DragAndDrop(AllowedEffects: Integer; + DataObject: IDataObject; DragEffect: Integer); + +begin + ActiveX.DoDragDrop(DataObject, DragManager as IDropSource, AllowedEffects, @DragEffect); +end; + +//---------------------------------------------------------------------------------------------------------------------- + procedure TBaseVirtualTree.DragCanceled; // Does some housekeeping for VCL drag'n drop; @@ -21752,7 +21695,7 @@ begin case FCheckImageKind of ckSystem: CreateSystemImageSet(FCheckImages, False); - ckSystemFlat: + ckSystemFlat, ckSystemDefault: CreateSystemImageSet(FCheckImages, True); else FCheckImages.TransparentColor := clDefault; @@ -22155,7 +22098,7 @@ begin if not (vsInitialized in Run.States) then Run := nil; isVisibleOnly: - if not FullyVisible[Run] then + if not FullyVisible[Run] or IsEffectivelyHidden(Run) then Run := nil; end; end; @@ -22237,8 +22180,10 @@ procedure TBaseVirtualTree.HandleMouseDblClick(var Message: TLMMouse; const HitI var NewCheckState: TCheckState; Node: PVirtualNode; + MayEdit: Boolean; begin + MayEdit := not (tsEditing in FStates) and (toEditOnDblClick in FOptions.FMiscOptions); if tsEditPending in FStates then begin KillTimer(Handle, EditTimer); @@ -22266,6 +22211,7 @@ begin begin SetNodeHeight(Node, FDefaultNodeHeight); UpdateWindow(Handle); + MayEdit := False; end; end else if hiOnItemCheckBox in HitInfo.HitPositions then @@ -22281,29 +22227,44 @@ begin FPendingCheckState := NewCheckState; FCheckNode.CheckState := PressedState[FCheckNode.CheckState]; InvalidateNode(HitInfo.HitNode); + MayEdit := False; end; end; end else begin if hiOnItemButton in HitInfo.HitPositions then - ToggleNode(HitInfo.HitNode) + 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, FEditDelay, nil); + end; end; //---------------------------------------------------------------------------------------------------------------------- -procedure TBaseVirtualTree.HandleMouseDown(var Message: TLMMouse; const HitInfo: THitInfo); +procedure TBaseVirtualTree.HandleMouseDown(var Message: TLMMouse; var HitInfo: THitInfo); // centralized mouse button down handling @@ -22347,7 +22308,11 @@ begin begin // Focus change. Don't use the SetFocus method as this does not work for MDI windows. if not Focused and CanFocus then + begin LCLIntf.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; @@ -22392,7 +22357,8 @@ begin // 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. - IsHit := not AltPressed and ((hiOnItemLabel in HitInfo.HitPositions) or (hiOnNormalIcon in HitInfo.HitPositions)); + IsHit := not AltPressed and not (toSimpleDrawSelection in FOptions.FSelectionOptions) and + ((hiOnItemLabel in HitInfo.HitPositions) or (hiOnNormalIcon in HitInfo.HitPositions)); IsCellHit := not AltPressed and not IsHit and Assigned(HitInfo.HitNode) and ([hiOnItemButton, hiOnItemCheckBox] * HitInfo.HitPositions = []) and ((toFullRowSelect in FOptions.FSelectionOptions) or @@ -22640,7 +22606,7 @@ begin begin // Is the mouse still over the same node? if (HitInfo.HitNode = FFocusedNode) and (hiOnItem in HitInfo.HitPositions) and - CanEdit(FFocusedNode, HitInfo.HitColumn) then + CanEdit(FFocusedNode, HitInfo.HitColumn) and (toEditOnClick in FOptions.FMiscOptions) then begin FEditColumn := FFocusedColumn; SetTimer(Handle, EditTimer, FEditDelay, nil); @@ -22768,7 +22734,7 @@ begin // 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]; + WasFullyVisible := FullyVisible[Node] and not IsEffectivelyHidden(Node); // Read in the new nodes. ReadNode(Stream, Version, Node); @@ -22782,7 +22748,7 @@ begin // 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] then + if not FullyVisible[Node] or IsEffectivelyHidden(Node) then begin if WasFullyVisible then Dec(FVisibleCount); @@ -23023,9 +22989,9 @@ begin AdjustTotalCount(Destination.Parent, Node.TotalCount, True); // Add the new node's height only if its parent is expanded. - if (vsExpanded in Destination.Parent.States) and (vsVisible in Node.States) then + if (vsExpanded in Destination.Parent.States) and IsEffectivelyVisible(Node) then AdjustTotalHeight(Destination.Parent, Node.TotalHeight, True); - if FullyVisible[Node] then + if FullyVisible[Node] and not IsEffectivelyHidden(Node) then Inc(FVisibleCount, CountVisibleChildren(Node) + 1); end; amInsertAfter: @@ -23053,9 +23019,9 @@ begin AdjustTotalCount(Destination.Parent, Node.TotalCount, True); // Add the new node's height only if its parent is expanded. - if vsExpanded in Destination.Parent.States then + if (vsExpanded in Destination.Parent.States) and IsEffectivelyVisible(Node) then AdjustTotalHeight(Destination.Parent, Node.TotalHeight, True); - if FullyVisible[Node] then + if FullyVisible[Node] and not IsEffectivelyHidden(Node) then Inc(FVisibleCount, CountVisibleChildren(Node) + 1); end; amAddChildFirst: @@ -23089,9 +23055,9 @@ begin Include(Destination.States, vsHasChildren); AdjustTotalCount(Destination, Node.TotalCount, True); // Add the new node's height only if its parent is expanded. - if (vsExpanded in Destination.States) and (vsVisible in Node.States) then + if (vsExpanded in Destination.Parent.States) and IsEffectivelyVisible(Node) then AdjustTotalHeight(Destination, Node.TotalHeight, True); - if FullyVisible[Node] then + if FullyVisible[Node] and not IsEffectivelyHidden(Node) then Inc(FVisibleCount, CountVisibleChildren(Node) + 1); end; amAddChildLast: @@ -23120,9 +23086,9 @@ begin Include(Destination.States, vsHasChildren); AdjustTotalCount(Destination, Node.TotalCount, True); // Add the new node's height only if its parent is expanded. - if (vsExpanded in Destination.States) and (vsVisible in Node.States) then + if (vsExpanded in Destination.Parent.States) and IsEffectivelyVisible(Node) then AdjustTotalHeight(Destination, Node.TotalHeight, True); - if FullyVisible[Node] then + if FullyVisible[Node] and not IsEffectivelyHidden(Node) then Inc(FVisibleCount, CountVisibleChildren(Node) + 1); end; else @@ -23136,7 +23102,7 @@ begin if (Mode <> amNoWhere) and (Node.Parent <> FRoot) then begin // If we have added a visible node then simply remove the all-children-hidden flag. - if vsVisible in Node.States then + if IsEffectivelyVisible(Node) then Exclude(Node.Parent.States, vsAllChildrenHidden) else // If we have added an invisible node and this is the only child node then @@ -23197,15 +23163,12 @@ begin Node.States := Node.States - [vsChecking]; Parent := Node.Parent; Dec(Parent.ChildCount); - AdjustHeight := (vsExpanded in Parent.States) and (vsVisible in Node.States); + AdjustHeight := (vsExpanded in Parent.States) and IsEffectivelyVisible(Node); if Parent.ChildCount = 0 then begin Parent.States := Parent.States - [vsAllChildrenHidden, vsHasChildren]; if (Parent <> FRoot) and (vsExpanded in Parent.States) then - begin - AdjustHeight := vsVisible in Node.States; Exclude(Parent.States, vsExpanded); - end; end; AdjustTotalCount(Parent, -Integer(Node.TotalCount), True); if AdjustHeight then @@ -23854,48 +23817,34 @@ procedure TBaseVirtualTree.PaintNodeButton(Canvas: TCanvas; Node: PVirtualNode; var Bitmap: TBitmap; XPos: Integer; - {$ifdef ThemeSupport} - Theme: HTHEME; - Part, - State: Integer; - ButtonRect: TRect; - - {$ifndef COMPILER_11_UP} - const - TVP_HOTGLYPH = 4; - {$endif COMPILER_11_UP} - {$endif ThemeSupport} + IsHot: Boolean; begin - Logger.EnterMethod([lcPaintDetails],'PaintNodeButton'); + IsHot := (toHotTrack in FOptions.FPaintOptions) and (FCurrentHotNode = Node) and FHotNodeButtonHit; + if vsExpanded in Node.States then - Bitmap := FMinusBM + begin + if IsHot then + Bitmap := FHotMinusBM + else + Bitmap := FMinusBM; + end else - Bitmap := FPlusBM; + begin + if IsHot then + Bitmap := FHotPlusBM + else + Bitmap := FPlusBM; + end; // Draw the node's plus/minus button according to the directionality. if BidiMode = bdLeftToRight then XPos := R.Left + ButtonX else XPos := R.Right - ButtonX - Bitmap.Width; - - {$ifdef ThemeSupport} - if IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) then - begin - Theme := OpenThemeData(Handle, 'TREEVIEW'); - Part := IfThen((Node = FCurrentHotNode)and FHotNodeButtonHit, TVP_HOTGLYPH, TVP_GLYPH); - State := IfThen(vsExpanded in Node.States, GLPS_OPENED, GLPS_CLOSED); - ButtonRect := Rect(XPos, R.Top + ButtonY, XPos + FPlusBM.Width, R.Top + ButtonY + FPlusBM.Height); - DrawThemeBackground(Theme, Canvas.Handle, Part, State, ButtonRect, nil); - CloseThemeData(Theme); - end - else - {$endif ThemeSupport} - // Need to draw this masked. - DirectMaskBlt(Canvas.Handle, XPos, R.Top + ButtonY, Bitmap.Width, Bitmap.Height, - Bitmap.Canvas.Handle, 0, 0, Bitmap.MaskHandle); - Logger.ExitMethod([lcPaintDetails],'PaintNodeButton'); + // Need to draw this masked. + Canvas.Draw(XPos, R.Top + ButtonY, Bitmap); end; //---------------------------------------------------------------------------------------------------------------------- @@ -24029,6 +23978,230 @@ 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; + {$ifdef ThemeSupport} + RowRect: TRect; + Theme: HTHEME; + + {$ifndef COMPILER_11_UP} + const + TREIS_HOTSELECTED = 6; + {$endif COMPILER_11_UP} + {$endif ThemeSupport} + + //--------------- 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; + + //--------------------------------------------------------------------------- + + {$ifdef ThemeSupport} + procedure DrawBackground(State: Integer); + begin + with PaintInfo do + if (toGridExtensions in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions) then + DrawThemeBackground(Theme, Canvas.Handle, TVP_TREEITEM, State, RowRect, @CellRect) + else + DrawThemeBackground(Theme, Canvas.Handle, TVP_TREEITEM, State, InnerRect, nil); + end; + {$endif ThemeSupport} + + //--------------- end local functions --------------------------------------- + +begin + {$ifdef ThemeSupport} + if IsWinVistaOrAbove and (tsUseThemes in FStates) and (toUseExplorerTheme in FOptions.FPaintOptions) then + begin + RowRect := Rect(0, PaintInfo.CellRect.Top, FRangeX, PaintInfo.CellRect.Bottom); + if toShowVertGridLines in FOptions.PaintOptions then + Dec(RowRect.Right); + Theme := OpenThemeData(Handle, 'TREEVIEW'); + end + else + Theme := 0; + {$endif ThemeSupport} + + with PaintInfo, Canvas do + begin + // Fill cell background if its color differs from tree background. + with FHeader.FColumns do + if poColumnColor in PaintOptions then + begin + Brush.Color := Items[Column].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 InnerRect do + if Left + NodeWidth < Right then + Right := Left + NodeWidth; + taCenter: + with InnerRect do + if (Right - Left) > NodeWidth then + begin + Left := (Left + Right - NodeWidth) div 2; + Right := Left + NodeWidth; + end; + taRightJustify: + with 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 MMXAvailable and (toUseBlendedSelection in FOptions.PaintOptions) then + AlphaBlendSelection(Brush.Color) + else + with 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 + {$ifdef ThemeSupport} + if Theme <> 0 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 + {$endif ThemeSupport} + if MMXAvailable and (toUseBlendedSelection in FOptions.PaintOptions) then + AlphaBlendSelection(Brush.Color) + else + with InnerRect do + RoundRect(Left, Top, Right, Bottom, FSelectionCurveRadius, FSelectionCurveRadius); + end; + end; + end; + + {$ifdef ThemeSupport} + if (Theme <> 0) 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)); + {$endif ThemeSupport} + + 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) + {$ifdef ThemeSupport} or + (not (toExtendedFocus in FOptions.FSelectionOptions) and + (toFullRowSelect in FOptions.FSelectionOptions) and + (Theme <> 0) ) + {$endif ThemeSupport} + ) then + begin + TextColorBackup := GetTextColor(Handle); + SetTextColor(Handle, $FFFFFF); + BackColorBackup := GetBkColor(Handle); + SetBkColor(Handle, 0); + + {$ifdef ThemeSupport} + if not (toExtendedFocus in FOptions.FSelectionOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and + (Theme <> 0) then + FocusRect := RowRect + else + {$endif ThemeSupport} + if toGridExtensions in FOptions.FMiscOptions then + FocusRect := CellRect + else + FocusRect := InnerRect; + + {$ifdef ThemeSupport} + if Theme <> 0 then + InflateRect(FocusRect, -1, -1); + {$endif ThemeSupport} + + Windows.DrawFocusRect(Handle, FocusRect); + SetTextColor(Handle, TextColorBackup); + SetBkColor(Handle, BackColorBackup); + end; + end; + end; + {$ifdef ThemeSupport} + if Theme <> 0 then + CloseThemeData(Theme); + {$endif ThemeSupport} +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TBaseVirtualTree.ReadChunk(Stream: TStream; Version: Integer; Node: PVirtualNode; ChunkType, ChunkSize: Integer): Boolean; @@ -25774,7 +25947,7 @@ begin Run := Node.LastChild; while Assigned(Run) do begin - if ParentVisible and (vsVisible in Run.States) then + if ParentVisible and IsEffectivelyVisible(Run) then Dec(FVisibleCount); Include(Run.States, vsDeleting); @@ -26299,6 +26472,8 @@ begin // Check whether the node is visible (determine indentation level btw.). Temp := Node; + if not IsEffectivelyVisible(Temp) then + Exit; Indent := 0; while Temp <> FRoot do begin @@ -26627,7 +26802,8 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetFirstVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True): PVirtualNode; +function TBaseVirtualTree.GetFirstVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeHidden: Boolean = False): PVirtualNode; // Returns the first visible node in the tree while optionally considering toChildrenAbove. // If necessary nodes are initialized on demand. @@ -26717,23 +26893,29 @@ begin end else Result := nil; + + if Assigned(Result) and not IncludeHidden and IsEffectivelyHidden(Result) then + Result := GetNextVisible(Result); end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetFirstVisibleChild(Node: PVirtualNode): PVirtualNode; +function TBaseVirtualTree.GetFirstVisibleChild(Node: PVirtualNode; IncludeHidden: 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) then - Result := GetNextVisibleSibling(Result); + + if Assigned(Result) and (not (vsVisible in Result.States) or (not IncludeHidden and IsEffectivelyHidden(Node))) then + Result := GetNextVisibleSibling(Result, IncludeHidden); end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetFirstVisibleChildNoInit(Node: PVirtualNode): PVirtualNode; +function TBaseVirtualTree.GetFirstVisibleChildNoInit(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; // Returns the first visible child node of Node. @@ -26741,14 +26923,14 @@ begin if Node = nil then Node := FRoot; Result := Node.FirstChild; - if Assigned(Result) and not (vsVisible in Result.States) then - Result := GetNextVisibleSiblingNoInit(Result); + if Assigned(Result) and (not (vsVisible in Result.States) or (not IncludeHidden and IsEffectivelyHidden(Node))) then + Result := GetNextVisibleSiblingNoInit(Result, IncludeHidden); end; //---------------------------------------------------------------------------------------------------------------------- function TBaseVirtualTree.GetFirstVisibleNoInit(Node: PVirtualNode = nil; - ConsiderChildrenAbove: Boolean = True): PVirtualNode; + ConsiderChildrenAbove: Boolean = True; IncludeHidden: Boolean = False): PVirtualNode; // Returns the first visible node in the tree or given subtree while optionally considering toChildrenAbove. // No initialization is performed. @@ -26820,6 +27002,9 @@ begin end else Result := nil; + + if Assigned(Result) and not IncludeHidden and IsEffectivelyHidden(Result) then + Result := GetNextVisibleNoInit(Result); end; //---------------------------------------------------------------------------------------------------------------------- @@ -27066,7 +27251,8 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetLastVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True): PVirtualNode; +function TBaseVirtualTree.GetLastVisible(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = True; + IncludeHidden: Boolean = False): PVirtualNode; // Returns the very last visible node in the tree while optionally considering toChildrenAbove. // The nodes are intialized all the way down including the result node. @@ -27075,22 +27261,22 @@ var Next: PVirtualNode; begin - Result := GetLastVisibleChild(Node); + Result := GetLastVisibleChild(Node, IncludeHidden); if not ConsiderChildrenAbove or not (toChildrenAbove in FOptions.FPaintOptions) then while Assigned(Result) do begin // Test if there is a next last visible child. If not keep the node from the last run. // Otherwise use the next last visible child. - Next := GetLastVisibleChild(Result); + Next := GetLastVisibleChild(Result, IncludeHidden); if Next = nil then Break; Result := Next; end; - end; +end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetLastVisibleChild(Node: PVirtualNode): PVirtualNode; +function TBaseVirtualTree.GetLastVisibleChild(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; // Determines the last visible child of the given node and initializes it if necessary. @@ -27103,8 +27289,8 @@ begin else Result := nil; - if Assigned(Result) and not (vsVisible in Result.States) then - Result := GetPreviousVisibleSibling(Result); + if Assigned(Result) and (not (vsVisible in Result.States) or (not IncludeHidden and IsEffectivelyHidden(Node))) then + Result := GetPreviousVisibleSibling(Result, IncludeHidden); if Assigned(Result) and not (vsInitialized in Result.States) then InitNode(Result); @@ -27112,7 +27298,7 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetLastVisibleChildNoInit(Node: PVirtualNode): PVirtualNode; +function TBaseVirtualTree.GetLastVisibleChildNoInit(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; // Determines the last visible child of the given node without initialization. @@ -27125,14 +27311,14 @@ begin else Result := nil; - if Assigned(Result) and not (vsVisible in Result.States) then - Result := GetPreviousVisibleSiblingNoInit(Result); + if Assigned(Result) and (not (vsVisible in Result.States) or (not IncludeHidden and IsEffectivelyHidden(Node))) then + Result := GetPreviousVisibleSiblingNoInit(Result, IncludeHidden); end; //---------------------------------------------------------------------------------------------------------------------- function TBaseVirtualTree.GetLastVisibleNoInit(Node: PVirtualNode = nil; - ConsiderChildrenAbove: Boolean = True): PVirtualNode; + ConsiderChildrenAbove: Boolean = True; IncludeHidden: Boolean = False): PVirtualNode; // Returns the very last visible node in the tree while optionally considering toChildrenAbove. // No initialization is performed. @@ -27141,13 +27327,13 @@ var Next: PVirtualNode; begin - Result := GetLastVisibleChildNoInit(Node); + Result := GetLastVisibleChildNoInit(Node, IncludeHidden); if not ConsiderChildrenAbove or not (toChildrenAbove in FOptions.FPaintOptions) then while Assigned(Result) do begin // Test if there is a next last visible child. If not keep the node from the last run. // Otherwise use the next last visible child. - Next := GetLastVisibleChildNoInit(Result); + Next := GetLastVisibleChildNoInit(Result, IncludeHidden); if Next = nil then Break; Result := Next; @@ -27603,82 +27789,25 @@ begin begin Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - // 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); + 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 + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then begin repeat - // Is there a next sibling? - if Assigned(Result.NextSibling) then + // If there a no siblings anymore, go up one level. + if not Assigned(Result.NextSibling) then begin - Result := Result.NextSibling; + 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 @@ -27686,25 +27815,83 @@ begin end else begin - // No sibling anymore, so use the parent's next sibling. - if Result.Parent <> FRoot then - Result := Result.Parent - else + // 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 - // There are no further nodes to examine, hence there is no further visible node. - Result := nil; - Break; + 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; - 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. @@ -27719,90 +27906,92 @@ begin begin Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - 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); - - // 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 + repeat + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then begin repeat - // Is there a next sibling? - if Assigned(Result.NextSibling) then + // If there a no siblings anymore, go up one level. + if not Assigned(Result.NextSibling) then begin - Result := Result.NextSibling; + Result := Result.Parent; + if Result = FRoot then + begin + Result := nil; + Break; + end; 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 + // 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 - // There are no further nodes to examine, hence there is no further visible node. - Result := nil; - Break; + 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; - end; + until not Assigned(Result) or IsEffectivelyVisible(Result); end; end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetNextVisibleSibling(Node: PVirtualNode): PVirtualNode; +function TBaseVirtualTree.GetNextVisibleSibling(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; // Returns the next visible sibling after Node. Initialization is done implicitly. @@ -27812,12 +28001,12 @@ begin Result := Node; repeat Result := GetNextSibling(Result); - until (Result = nil) or (vsVisible in Result.States); + until not Assigned(Result) or ((vsVisible in Result.States) and (IncludeHidden or not IsEffectivelyHidden(Result))); end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetNextVisibleSiblingNoInit(Node: PVirtualNode): PVirtualNode; +function TBaseVirtualTree.GetNextVisibleSiblingNoInit(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; // Returns the next visible sibling after Node. @@ -27827,7 +28016,7 @@ begin Result := Node; repeat Result := Result.NextSibling; - until (Result = nil) or (vsVisible in Result.States); + until not Assigned(Result) or ((vsVisible in Result.States) and (IncludeHidden or not IsEffectivelyHidden(Result))); end; //---------------------------------------------------------------------------------------------------------------------- @@ -28261,92 +28450,94 @@ begin begin Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - // 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); - 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 + 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 - 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) - else - Result := nil; - until Assigned(Marker) or (Result = nil); - if Assigned(Marker) then - Result := Marker; - - Break; - end; - until False; + Result := GetVisibleParent(Result, True); + if Result = FRoot then + Result := nil; + Marker := GetLastVisible(Result, True); + if Assigned(Marker) then + Result := Marker; 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 + if ConsiderChildrenAbove and (toChildrenAbove in FOptions.FPaintOptions) then + begin + repeat + if Assigned(Result.LastChild) and (vsExpanded in Result.States) then begin - // If there are visible child nodes then use the last one. - Marker := GetLastVisible(Result, True); + 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; - 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; + 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; + if Assigned(Result) and not (vsInitialized in Result.States) then + InitNode(Result); + end; + until not Assigned(Result) or IsEffectivelyVisible(Result); end; end; @@ -28367,91 +28558,92 @@ begin begin Assert(Result <> FRoot, 'Node must not be the hidden root node.'); - // 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); - 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 + 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 - 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) - else - Result := nil; - until Assigned(Marker) or (Result = nil); - if Assigned(Marker) then - Result := Marker; - - Break; - end; - until False; + Result := GetVisibleParent(Result, True); + if Result = FRoot then + Result := nil; + Marker := GetLastVisibleNoInit(Result, True); + if Assigned(Marker) then + Result := Marker; 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 + 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 - // If there are visible child nodes then use the last one. - Marker := GetLastVisibleNoInit(Result, True); + 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; - 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; + 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; - end; + until not Assigned(Result) or IsEffectivelyVisible(Result); end; end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetPreviousVisibleSibling(Node: PVirtualNode): PVirtualNode; +function TBaseVirtualTree.GetPreviousVisibleSibling(Node: PVirtualNode; IncludeHidden: Boolean = False): PVirtualNode; // Returns the previous visible sibling before Node. Initialization is done implicitly. @@ -28461,12 +28653,13 @@ begin Result := Node; repeat Result := GetPreviousSibling(Result); - until (Result = nil) or (vsVisible in Result.States); + until not Assigned(Result) or ((vsVisible in Result.States) and (IncludeHidden or not IsEffectivelyHidden(Result))); end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetPreviousVisibleSiblingNoInit(Node: PVirtualNode): PVirtualNode; +function TBaseVirtualTree.GetPreviousVisibleSiblingNoInit(Node: PVirtualNode; + IncludeHidden: Boolean = False): PVirtualNode; // Returns the previous visible sibling before Node. @@ -28476,7 +28669,7 @@ begin Result := Node; repeat Result := Result.PrevSibling; - until (Result = nil) or (vsVisible in Result.States); + until not Assigned(Result) or ((vsVisible in Result.States) and (IncludeHidden or not IsEffectivelyHidden(Result))); end; //---------------------------------------------------------------------------------------------------------------------- @@ -28659,16 +28852,17 @@ end; //---------------------------------------------------------------------------------------------------------------------- -function TBaseVirtualTree.GetVisibleParent(Node: PVirtualNode): PVirtualNode; +function TBaseVirtualTree.GetVisibleParent(Node: PVirtualNode; IncludeHidden: 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; - while (Result <> FRoot) and not FullyVisible[Result] do + Result := Node.Parent; + while (Result <> FRoot) and (not FullyVisible[Result] or (not IncludeHidden and IsEffectivelyHidden(Result))) do Result := Result.Parent; end; @@ -28855,7 +29049,7 @@ begin if (Node = nil) or (Node = FRoot) then Invalidate else - if [vsInitialized, vsVisible] * Node.States = [vsInitialized, vsVisible] then + if (vsInitialized in Node.States) and IsEffectivelyVisible(Node) then begin R := GetDisplayRect(Node, -1, False); if R.Top < ClientHeight then @@ -28935,6 +29129,27 @@ end; //---------------------------------------------------------------------------------------------------------------------- +function TBaseVirtualTree.IsEffectivelyHidden(Node: PVirtualNode): Boolean; + +// Checks if a node will effectively be hidden as this depends on the nodes state and the paint options. + +begin + if Assigned(Node) then + Result := (vsHidden in Node.States) and not (toShowHiddenNodes in FOptions.FPaintOptions) + else + Result := False; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function TBaseVirtualTree.IsEffectivelyVisible(Node: PVirtualNode): Boolean; + +begin + Result := (vsVisible in Node.States) and not IsEffectivelyHidden(Node); +end; + +//---------------------------------------------------------------------------------------------------------------------- + function TBaseVirtualTree.IsMouseSelecting: Boolean; begin @@ -29361,7 +29576,6 @@ var NodeLevel, ButtonX, ButtonY: Integer; - Temp, Run: PVirtualNode; LineImage: TLineImage; PaintInfo: TVTPaintInfo; // all necessary information about a node to pass to the paint routines @@ -29470,11 +29684,7 @@ begin if Assigned(PaintInfo.Node) then begin - SelectLevel := InitializeLineImageAndSelectLevel(PaintInfo.Node, LineImage); - IndentSize := Length(LineImage); - - // Precalculate horizontal position of buttons relative to the column start. - ButtonX := (IfThen(toFixedIndent in FOptions.FPaintOptions, 1, IndentSize) * Integer(FIndent)) + Round((Integer(FIndent) - FPlusBM.Width) / 2) - FIndent; + ButtonX := Round((Integer(FIndent) - FPlusBM.Width) / 2); // ----- main node paint loop while Assigned(PaintInfo.Node) do @@ -29483,6 +29693,12 @@ begin Logger.Send([lcPaintDetails],'NodeIndex',PaintInfo.Node^.Index); Logger.Watch([lcPaintDetails],'BaseOffset',BaseOffset); Logger.Watch([lcPaintDetails],'Brush.Color',PaintInfo.Canvas.Brush.Color); + // 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); + // Initialize node if not already done. if not (vsInitialized in PaintInfo.Node.States) then InitNode(PaintInfo.Node); @@ -29687,7 +29903,8 @@ 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); + 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 @@ -29799,106 +30016,7 @@ begin OffsetRect(SelectionRect, 0, -PaintInfo.Node.NodeHeight); // Advance to next visible node. - Temp := GetNextVisible(PaintInfo.Node, True); - - if Assigned(Temp) then - begin - if toChildrenAbove in FOptions.FPaintOptions then - begin - // Determine IndentSize is here, because we eventually need to change the length of - // LineImage. - IndentSize := GetNodeLevel(Temp) + 1; - if Length(LineImage) <= IndentSize then - SetLength(LineImage, IndentSize); - if not (toFixedIndent in FOptions.FPaintOptions) then - Dec(ButtonX, (Integer(GetNodeLevel(PaintInfo.Node)) - IndentSize + 1) * Integer(FIndent)); - - // Determine the correct line for the node. - if not HasVisiblePreviousSibling(Temp) then - begin - if (Temp.Parent <> FRoot) or HasVisibleNextSibling(Temp) then - LineImage[IndentSize - 1] := ltBottomRight - else - LineImage[IndentSize - 1] := ltRight; - end - else if (Temp.Parent = FRoot) and (not HasVisibleNextSibling(Temp)) then - LineImage[IndentSize - 1] := ltTopRight - else - LineImage[IndentSize - 1] := ltTopDownRight; - - // Now go up to the root to determine the rest. - Run := Temp.Parent; - NodeLevel := IndentSize - 2; - while Run <> FRoot do - begin - if HasVisiblePreviousSibling(Run) then - LineImage[NodeLevel] := ltTopDown - else - LineImage[NodeLevel] := ltNone; - Run := Run.Parent; - Dec(NodeLevel); - end; - - // Determine the select level of the node. For toChildrenAbove this is solely done here. - SelectLevel := 0; - Run := Temp; - while Run <> FRoot do - begin - if vsSelected in Run.States then - Inc(SelectLevel); - Run := Run.Parent; - end; - end - else - begin - // Adjust line bitmap (and so also indentation level). - if Temp.Parent = PaintInfo.Node then - begin - // New node is a child node. Need to adjust previous bitmap level. - if IndentSize > 0 then - if HasVisibleNextSibling(PaintInfo.Node) then - LineImage[IndentSize - 1] := ltTopDown - else - LineImage[IndentSize - 1] := ltNone; - // Enhance line type array if necessary. - Inc(IndentSize); - if Length(LineImage) <= IndentSize then - SetLength(LineImage, IndentSize + 8); - if not (toFixedIndent in FOptions.FPaintOptions) then - Inc(ButtonX, FIndent); - end - else - begin - // New node is at the same or higher tree level. - // Take back select level increase if the node was selected - if vsSelected in PaintInfo.Node.States then - Dec(SelectLevel); - if PaintInfo.Node.Parent <> Temp.Parent then - begin - // We went up one or more levels. Determine how many levels it was actually. - while PaintInfo.Node.Parent <> Temp.Parent do - begin - Dec(IndentSize); - if not (toFixedIndent in FOptions.FPaintOptions) then - Dec(ButtonX, FIndent); - PaintInfo.Node := PaintInfo.Node.Parent; - // Take back one selection level increase for every step up. - if vsSelected in PaintInfo.Node.States then - Dec(SelectLevel); - end; - end; - end; - - // Set new image in front of the new node. - if IndentSize > 0 then - if HasVisibleNextSibling(Temp) then - LineImage[IndentSize - 1] := ltTopDownRight - else - LineImage[IndentSize - 1] := ltTopRight; - end; - end; - - PaintInfo.Node := Temp; + PaintInfo.Node := GetNextVisible(PaintInfo.Node, True); Logger.ExitMethod([lcPaintDetails],'PaintNode'); end; end; @@ -31135,7 +31253,7 @@ 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 + if IsEffectivelyVisible(Child) then Inc(HeightDelta, Child.TotalHeight); Child := Child.NextSibling; until Child = nil;