Fixed unreliable header tooltips (issue #728)

Source/VirtualTrees.AncestorVcl.pas

@@ -208,6 +208,13 @@ procedure TVirtualTreeHintWindow.Paint();
   LGradientEnd: TColor;
 
 begin
+  if FHintData.Tree = nil then
+  begin
+    // Hint of a foreign control (we are the application-wide hint window class,
+    // see initialization, issue #728). Render like the standard VCL hint window.
+    inherited Paint;
+    Exit;
+  end;
   with FHintData do
   begin
     // Do actual painting only in the very first run.
@@ -315,8 +322,13 @@ function TVirtualTreeHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: str
 begin
   try
     if AData = nil then
-      // Defensive approach, it *can* happen that AData is nil. Maybe when several user defined hint classes are used.
-      Result := Rect(0, 0, 0, 0)
+    begin
+      // No tree hint data. Since we register ourselves as the application-wide
+      // hint window class (see initialization, issue #728), this hint belongs to
+      // another control - behave exactly like the standard VCL hint window.
+      FHintData.Tree := nil;
+      Result := inherited CalcHintRect(MaxWidth, AHint, AData);
+    end
     else
     begin
       // The hint window does not need any bidi mode setting but the caller of this method (TApplication.ActivateHint)
@@ -491,4 +503,29 @@ function TVirtualTreeHintWindow.IsHintMsg(var Msg: TMsg): Boolean;
     Result := False;
 end;
 
+//----------------------------------------------------------------------------------------------------------------------
+
+initialization
+  // Issue #728: The header occupies the window's non-client area, so hovering it
+  // produces WM_NCMOUSEMOVE messages. The stock THintWindow.IsHintMsg tells the VCL
+  // to cancel a pending hint on every such message, which made header tooltips
+  // unreliable - they only worked while a TVirtualTreeHintWindow happened to be the
+  // application's hint window (e.g. after a node hint had been shown).
+  // TVirtualTreeHintWindow.IsHintMsg filters those messages out, so we install it as
+  // the application-wide hint window class to make that override always effective.
+  // For hints of other controls it falls back to the stock rendering (see the
+  // AData = nil branches in CalcHintRect and Paint). We only replace the default
+  // class, so applications using their own hint window are left untouched.
+  if HintWindowClass = THintWindow then
+  begin
+    HintWindowClass := TVirtualTreeHintWindow;
+    // The application already created its hint window during VCL startup (before this
+    // unit's initialization ran), so recreate it to adopt the new class right away.
+    if Assigned(Application) and Application.ShowHint then
+    begin
+      Application.ShowHint := False;
+      Application.ShowHint := True;
+    end;
+  end;
+
 end.

Tests/Tests.dpr

@@ -22,6 +22,7 @@ uses
   VTBandsIssue1091Tests in 'VTBandsIssue1091Tests.pas',
   VTFixedColumnDragIssue1377Tests in 'VTFixedColumnDragIssue1377Tests.pas',
   VTHeaderBackgroundTests in 'VTHeaderBackgroundTests.pas',
+  VTHeaderHintIssue728Tests in 'VTHeaderHintIssue728Tests.pas',
   VTCellSelectionTests in 'VTCellSelectionTests.pas',
   VTSelectedCountIssue1197Tests in 'VTSelectedCountIssue1197Tests.pas',
   VTPaintToIssue632Tests in 'VTPaintToIssue632Tests.pas',

Tests/VTHeaderHintIssue728Tests.pas

@@ -0,0 +1,80 @@
+unit VTHeaderHintIssue728Tests;
+
+// Regression test for issue #728 "Header tooltip not always displaying".
+//
+// The header lives in the window's non-client area (WMNCCalcSize reserves it,
+// WMNCHitTest returns HTBORDER), so hovering it produces WM_NCMOUSEMOVE messages.
+// The stock THintWindow.IsHintMsg tells the VCL to cancel a pending hint on every
+// such message, which made header tooltips unreliable - they only worked while
+// Application.FHintWindow happened to be a TVirtualTreeHintWindow (whose IsHintMsg
+// override filters those messages out).
+//
+// Fix: TVirtualTreeHintWindow installs itself as the application-wide hint window
+// class so the override is always in effect, and falls back to the stock rendering
+// for hints that do not belong to a tree (AData / FHintData.Tree = nil).
+//
+// These two facts are what the tests below pin down; the full end-to-end cancel
+// behaviour (which needs a real cursor and message pump) is covered by the
+// deterministic measurement harness build\HintProbe728.dpr.
+
+interface
+
+uses
+  DUnitX.TestFramework;
+
+type
+  [TestFixture]
+  TVTHeaderHintIssue728Tests = class
+  public
+    /// The unit must have made TVirtualTreeHintWindow the application's hint window
+    /// class, otherwise its IsHintMsg override cannot keep header hints alive.
+    [Test]
+    procedure InstallsItselfAsApplicationHintWindowClass;
+
+    /// Because we are now the app-wide hint window, hints of foreign controls pass
+    /// through us with nil hint data. CalcHintRect must still size them (previously
+    /// it returned an empty rect, which would have made every other hint invisible).
+    [Test]
+    procedure ForeignControlHintGetsANonEmptyRect;
+  end;
+
+implementation
+
+uses
+  System.Types,
+  Winapi.Windows,
+  Vcl.Controls,
+  Vcl.Forms,
+  VirtualTrees.AncestorVCL;
+
+procedure TVTHeaderHintIssue728Tests.InstallsItselfAsApplicationHintWindowClass;
+begin
+  Assert.IsTrue(HintWindowClass = TVirtualTreeHintWindow,
+    'VirtualTrees.AncestorVCL must register TVirtualTreeHintWindow as the application-wide ' +
+    'hint window class so its WM_NCMOUSEMOVE filtering is always effective (issue #728).');
+end;
+
+procedure TVTHeaderHintIssue728Tests.ForeignControlHintGetsANonEmptyRect;
+var
+  HintWin: TVirtualTreeHintWindow;
+  R: TRect;
+  H: HWND;
+begin
+  HintWin := TVirtualTreeHintWindow.Create(nil);
+  try
+    H := HintWin.Handle; // force handle creation; CalcHintRect measures via the canvas
+    Assert.IsTrue(H <> 0, 'Sanity: hint window handle must be created.');
+    // nil hint data == a hint that does not belong to a tree (a foreign control).
+    R := HintWin.CalcHintRect(300, 'A foreign control hint', nil);
+    Assert.IsFalse(IsRectEmpty(R),
+      'With nil hint data CalcHintRect must fall back to the stock sizing so that ' +
+      'hints of other controls stay visible (issue #728).');
+  finally
+    HintWin.Free;
+  end;
+end;
+
+initialization
+  TDUnitX.RegisterTestFixture(TVTHeaderHintIssue728Tests);
+
+end.