VirtualTreeView: Enable hints (taken from blikblum repository, based on patch by trexet)

components/virtualtreeview/laz.virtualtrees.pas

@@ -891,11 +891,14 @@ type
     {$ENDIF}
   end;
 
+  TVTHintKind = (vhkText, vhkOwnerDraw);
+
   PVTHintData = ^TVTHintData;
   TVTHintData = record
     Tree: TBaseVirtualTree;
     Node: PVirtualNode;
     Column: TColumnIndex;
+    Kind: TVTHintKind;
     HintRect: TRect;            // used for draw trees only, string trees get the size from the hint string
     DefaultHint: String;    // used only if there is no node specific hint string available
                                 // or a header hint is about to appear
@@ -1942,9 +1945,10 @@ type
   // operations
   TVTOperationEvent = procedure(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind) of object;
 
-  TVTHintKind = (vhkText, vhkOwnerDraw);
   TVTHintKindEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Kind: TVTHintKind) of object;
   TVTDrawHintEvent = procedure(Sender: TBaseVirtualTree; HintCanvas: TCanvas; Node: PVirtualNode; R: TRect; Column: TColumnIndex) of object;
+  TVTGetHintEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
+    var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String) of object;
   TVTGetHintSizeEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect) of object;
 
   // miscellaneous
@@ -2119,6 +2123,7 @@ type
     FLastChangedNode,                            // used for delayed change event
     FCurrentHotNode: PVirtualNode;               // Node over which the mouse is hovering.
     FCurrentHotColumn: TColumnIndex;             // Column over which the mouse is hovering.
+    FCurrentHintNode: PVirtualNode;              // Node which has shown the hint.
     FHotNodeButtonHit: Boolean;                  // Indicates wether the mouse is hovering over the hot node's button.
     FLastSelRect,
     FNewSelRect: TRect;                          // used while doing draw selection
@@ -2399,10 +2404,13 @@ type
 
     // search, sort
     FOnCompareNodes: TVTCompareEvent;            // used during sort
+    FOnIncrementalSearch: TVTIncrementalSearchEvent; // triggered on every key press (not key down)
+
+    // hints
     FOnDrawHint: TVTDrawHintEvent;
+    FOnGetHint: TVTGetHintEvent;                 // used to retrieve the hint text to be displayed for a specific node
     FOnGetHintSize: TVTGetHintSizeEvent;
     FOnGetHintKind: TVTHintKindEvent;
-    FOnIncrementalSearch: TVTIncrementalSearchEvent; // triggered on every key press (not key down)
     FOnMouseEnter: TNotifyEvent;
     FOnMouseLeave: TNotifyEvent;
 
@@ -3013,6 +3021,7 @@ type
     property OnGetCursor: TVTGetCursorEvent read FOnGetCursor write FOnGetCursor;
     property OnGetHeaderCursor: TVTGetHeaderCursorEvent read FOnGetHeaderCursor write FOnGetHeaderCursor;
     property OnGetHelpContext: TVTHelpContextEvent read FOnGetHelpContext write FOnGetHelpContext;
+    property OnGetHint: TVTGetHintEvent read FOnGetHint write FOnGetHint;
     property OnGetHintSize: TVTGetHintSizeEvent read FOnGetHintSize write
         FOnGetHintSize;
     property OnGetHintKind: TVTHintKindEvent read FOnGetHintKind write
@@ -3467,8 +3476,6 @@ type
     TextType: TVSTTextType) of object;
   TVSTGetTextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
     TextType: TVSTTextType; var CellText: String) of object;
-  TVSTGetHintEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
-    var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String) of object;
   // New text can only be set for variable caption.
   TVSTNewTextEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
     const NewText: String) of object;
@@ -3517,7 +3524,6 @@ type
     FOnPaintText: TVTPaintText;                    // triggered before either normal or fixed text is painted to allow
                                                    // even finer customization (kind of sub cell painting)
     FOnGetText: TVSTGetTextEvent;                  // used to retrieve the string to be displayed for a specific node
-    FOnGetHint: TVSTGetHintEvent;                  // used to retrieve the hint to be displayed for a specific node
     FOnNewText: TVSTNewTextEvent;                  // used to notify the application about an edited node caption
     FOnShortenString: TVSTShortenStringEvent;      // used to allow the application a customized string shortage
     FOnMeasureTextWidth: TVTMeasureTextEvent;      // used to adjust the width of the cells
@@ -3575,7 +3581,6 @@ type
     property EllipsisWidth: Integer read FEllipsisWidth;
     property TreeOptions: TCustomStringTreeOptions read GetOptions write SetOptions;
 
-    property OnGetHint: TVSTGetHintEvent read FOnGetHint write FOnGetHint;
     property OnGetText: TVSTGetTextEvent read FOnGetText write FOnGetText;
     property OnNewText: TVSTNewTextEvent read FOnNewText write FOnNewText;
     property OnPaintText: TVTPaintText read FOnPaintText write FOnPaintText;
@@ -3881,6 +3886,7 @@ type
   protected
     function DoGetCellContentMargin(Node: PVirtualNode; Column: TColumnIndex;
       CellContentMarginType: TVTCellContentMarginType = ccmtAllSides; Canvas: TCanvas = nil): TPoint; override;
+    function DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle): String; override;
     function DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer; override;
     procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override;
     function GetDefaultHintKind: TVTHintKind; override;
@@ -4056,6 +4062,7 @@ type
     property OnGetCursor;
     property OnGetHeaderCursor;
     property OnGetHelpContext;
+    property OnGetHint;
     property OnGetHintKind;
     property OnGetHintSize;
     property OnGetImageIndex;
@@ -6101,7 +6108,7 @@ procedure TVirtualTreeHintWindow.Paint;
 begin
   with FHintData do
   begin
-    if (Tree is TCustomVirtualDrawTree) and Assigned(Node) then
+    if (Tree is TCustomVirtualDrawTree) and Assigned(Node) and (Kind = vhkOwnerDraw) then
     begin
       // The draw tree has by default no hint text so let it draw the hint itself.
       // HintBorderWidth is a private constant in hint code and is set to two
@@ -6127,9 +6134,9 @@ begin
     FHintData := PVTHintData(AData)^;
     with FHintData do
     begin
-      // The draw tree gets its hint size by the application (but only if not a header hint is about to show).
+      // The draw tree gets its hint size by the application (but only if not a header or vhkText hint is about to show).
       // This size has already been determined in CMHintShow.
-      if (Tree is TCustomVirtualDrawTree) and Assigned(Node) then
+      if (Tree is TCustomVirtualDrawTree) and Assigned(Node) and (FHintData.Kind = vhkOwnerDraw) then
         Result := HintRect
       else
       begin
@@ -16089,7 +16096,6 @@ var
   ParentForm: TCustomForm;
   BottomRightCellContentMargin: TPoint;
   DummyLineBreakStyle: TVTTooltipLineBreakStyle;
-  HintKind: TVTHintKind;
 begin
   with Message do
   begin
@@ -16157,9 +16163,9 @@ begin
             begin
               // An owner-draw tree should only display a hint when at least
               // its OnGetHintSize event handler is assigned.
-              DoGetHintKind(HitInfo.HitNode, HitInfo.HitColumn, {%H-}HintKind);
+              DoGetHintKind(HitInfo.HitNode, HitInfo.HitColumn, FHintData.Kind);
               FHintData.HintRect := Rect(0, 0, 0, 0);
-              if (HintKind = vhkOwnerDraw) then
+              if (FHintData.Kind = vhkOwnerDraw) then
               begin
                 DoGetHintSize(HitInfo.HitNode, HitInfo.HitColumn, FHintData.HintRect);
                 ShowOwnHint := not IsRectEmpty(FHintData.HintRect);
@@ -16414,6 +16420,9 @@ begin
       end;
     end;
 
+    // Mouse stays in same position, so reset area which the mouse must leave to reshow a hint
+    if ShowHint and (ScrollAmount <> 0) then
+      FLastHintRect := Rect(0, 0, 0, 0);
   end;
   {$ifdef DEBUG_VTV}Logger.ExitMethod([lcScroll],'CMMouseWheel');{$endif}
 end;
@@ -22322,6 +22331,14 @@ begin
   // Get information about the hit.
   GetHitTestInfoAt(X, Y, True, {%H-}HitInfo);
 
+  // If we left the old hot node, then we should hide it's hint
+  if ShowHint then
+    if (HitInfo.HitNode <> FCurrentHintNode) or (HitInfo.HitColumn <> FCurrentHotColumn) then
+    begin
+      Application.HideHint;
+      FCurrentHintNode := HitInfo.HitNode;
+    end;
+
   // Only make the new node being "hot" if its label is hit or full row selection is enabled.
   CheckPositions := [hiOnItemLabel, hiOnItemCheckbox];
 
@@ -34194,6 +34211,17 @@ end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
+function TCustomVirtualDrawTree.DoGetNodeHint(Node: PVirtualNode; Column: TColumnIndex;
+  var LineBreakStyle: TVTTooltipLineBreakStyle): String;
+
+begin
+  Result := inherited DoGetNodeHint(Node, Column, LineBreakStyle);
+  if (FHintData.Kind = vhkText) and Assigned(FOnGetHint) then
+    FOnGetHint(Self, Node, Column, LineBreakStyle, Result);
+end;
+
+//----------------------------------------------------------------------------------------------------------------------
+
 function TCustomVirtualStringTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer;
 
 // Returns the text width of the given node in pixels.

examples/virtualtreeview/vst_advanced/DrawTreeDemo.lfm

@@ -7,8 +7,8 @@ object DrawTreeForm: TDrawTreeForm
   Caption = 'DrawTreeForm'
   ClientHeight = 453
   ClientWidth = 710
+  LCLVersion = '3.99.0.0'
   OnCreate = FormCreate
-  LCLVersion = '2.1.0.0'
   object Label7: TLabel
     Left = 8
     Height = 30
@@ -53,6 +53,7 @@ object DrawTreeForm: TDrawTreeForm
     AnchorSideBottom.Control = TrackBar1
     Left = 8
     Height = 361
+    Hint = '(dummy)'
     Top = 46
     Width = 694
     Anchors = [akTop, akLeft, akRight, akBottom]
@@ -111,6 +112,8 @@ object DrawTreeForm: TDrawTreeForm
     OnDrawHint = VDT1DrawHint
     OnDrawNode = VDT1DrawNode
     OnFreeNode = VDT1FreeNode
+    OnGetHint = VDT1GetHint
+    OnGetHintKind = VDT1GetHintKind
     OnGetHintSize = VDT1GetHintSize
     OnGetImageIndex = VDT1GetImageIndex
     OnGetNodeWidth = VDT1GetNodeWidth
@@ -129,9 +132,9 @@ object DrawTreeForm: TDrawTreeForm
     Top = 415
     Width = 197
     Max = 100
-    OnChange = TrackBar1Change
     Position = 50
     TickStyle = tsNone
+    OnChange = TrackBar1Change
     Anchors = [akLeft, akBottom]
     BorderSpacing.Left = 7
     TabOrder = 1

examples/virtualtreeview/vst_advanced/DrawTreeDemo.pas

@@ -26,6 +26,9 @@ uses
   LazFileUtils;
 
 type
+
+  { TDrawTreeForm }
+
   TDrawTreeForm = class(TForm)
     VDT1: TLazVirtualDrawTree;
     Label7: TLabel;
@@ -39,6 +42,10 @@ type
     procedure VDT1DrawHint(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; R: TRect; Column: TColumnIndex);
     procedure VDT1DrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
     procedure VDT1FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
+    procedure VDT1GetHint(Sender: TBaseVirtualTree;  Node: PVirtualNode; Column: TColumnIndex;
+        var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
+    procedure VDT1GetHintKind(Sender: TBaseVirtualTree; Node: PVirtualNode;
+        Column: TColumnIndex; var Kind: TVTHintKind);
     procedure VDT1GetHintSize(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect);
     procedure VDT1GetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
       var Ghosted: Boolean; var Index: Integer);
@@ -181,6 +188,7 @@ begin
   GetLogicalDrivesInfo(FDriveStrings,Count);
   VDT1.RootNodeCount := Count;
 
+
   //todo
   {
   SystemImages.Handle := SHGetFileInfo('', 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
@@ -607,6 +615,26 @@ end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
+procedure TDrawTreeForm.VDT1GetHint(Sender: TBaseVirtualTree;
+    Node: PVirtualNode; Column: TColumnIndex;
+    var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
+var
+  Data: PShellObjectData;
+begin
+  Data := Sender.GetNodeData(Node);
+  if Column = 0 then HintText := Data.Display;
+end;
+
+//----------------------------------------------------------------------------------------------------------------------
+
+procedure TDrawTreeForm.VDT1GetHintKind(Sender: TBaseVirtualTree;
+  Node: PVirtualNode; Column: TColumnIndex; var Kind: TVTHintKind);
+begin
+  if Column = 0 then Kind := vhkText else Kind := vhkOwnerDraw;
+end;
+
+//----------------------------------------------------------------------------------------------------------------------
+
 procedure TDrawTreeForm.VDT1GetHintSize(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var R: TRect);
 
 // Draw trees must manage parts of the hints themselves. Here we return the size of the hint window we want to show