diff --git a/Source/VirtualTrees.AncestorVcl.pas b/Source/VirtualTrees.AncestorVcl.pas index d0739a9e..4c3750ca 100644 --- a/Source/VirtualTrees.AncestorVcl.pas +++ b/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. diff --git a/Tests/Tests.dpr b/Tests/Tests.dpr index b1ad8ae9..51468805 100644 --- a/Tests/Tests.dpr +++ b/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', diff --git a/Tests/VTHeaderHintIssue728Tests.pas b/Tests/VTHeaderHintIssue728Tests.pas new file mode 100644 index 00000000..8cebabec --- /dev/null +++ b/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.