TVirtualStringTree - How to use my own hint window class for VT columns?

I want to use a custom Hint window class for my entire application. I use the Application.OnShowHint, analyze the THintInfo, and return my own TMyHintWindow in the HintInfo.HintWindowClass. This works well for all controls but I have a strange problem only with TVirtualStringTree Columns hint.

VT uses it's own hint window and own structure for the HintInfo.HintData. I study the code, and know it uses the VTHintData. so far so good. problem is that when I return my own hint window class (derived from THintWindow) it shows the hint window only for a split second and disappears!

There is no problem with hints returned for tree Nodes. they use the same method/structure (VTHintData).

Here is a very simple MCVE:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees, StdCtrls;

type
  TForm1 = class(TForm)
    VirtualStringTree1: TVirtualStringTree;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);    
  private
  public
    procedure ApplicationShowHint(var HintStr: string; var CanShow: Boolean;
      var HintInfo: THintInfo);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TMyHintWindow = class(THintWindow)
  public
    { nothing special here for now }
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  VirtualStringTree1.Hint := 'VT main hint';
  VirtualStringTree1.ShowHint := True;

  Memo1.Hint := 'Memo hint';
  Memo1.ShowHint := True;

  Application.OnShowHint := ApplicationShowHint;
end;

procedure TForm1.ApplicationShowHint(var HintStr: string; var CanShow: Boolean;
  var HintInfo: THintInfo);
var
  VTHintData: TVTHintData;
begin
  { VT uses it's own hint window class }
  if HintInfo.HintWindowClass = TVirtualTreeHintWindow then
  begin
    { VT passes columns and nodes hints information in HintInfo.HintData }
    if HintInfo.HintData <> nil then
    begin
      VTHintData := PVTHintData(HintInfo.HintData)^;
      if VTHintData.Node <> nil then { node hint }
      begin
        { handle this case with DoGetNodeHint/DoGetNodeToolTip ... it works fine }
      end
      else
      begin { column hint }
        HintStr := VTHintData.DefaultHint; { got it! }
      end;
    end;
  end;

  Memo1.Lines.Add(HintStr); { prove I got the right hint }

  HintInfo.HintColor := clAqua;

  { use my own hint window class
    the hint from the VT columns is shown for a split second and hides! }
  HintInfo.HintWindowClass := TMyHintWindow;
end;

end.

Form:

object Form1: TForm1
  Left = 399
  Top = 256
  Width = 720
  Height = 211
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object VirtualStringTree1: TVirtualStringTree
    Left = 8
    Top = 8
    Width = 409
    Height = 153
    Header.AutoSizeIndex = 0
    Header.Font.Charset = DEFAULT_CHARSET
    Header.Font.Color = clWindowText
    Header.Font.Height = -11
    Header.Font.Name = 'MS Sans Serif'
    Header.Font.Style = []
    Header.Options = [hoColumnResize, hoDrag, hoShowHint, hoShowSortGlyphs, hoVisible]
    HintAnimation = hatNone
    HintMode = hmTooltip
    TabOrder = 0
    Columns = <
      item
        Position = 0
        Width = 150
        WideText = 'column 0'
        WideHint = 'VT column 0 hint'
      end
      item
        Position = 1
        Width = 150
        WideText = 'column 1'
        WideHint = 'VT column 1 hint'
      end>
  end
  object Memo1: TMemo
    Left = 424
    Top = 8
    Width = 273
    Height = 153
    ScrollBars = ssVertical
    TabOrder = 1
  end
end

I have debugged this for hours. I see nothing special. Why is this happening? who/what closes the hint window right away? Thanks.

I'm using VT version 5.3.0

In the TBaseVirtualTree.CMHintShowPause() it is stated:

A little workaround is needed here to make the application class using the correct hint window class. Once the application gets ShowHint set to true (which is the case when we want to show hints in the tree) then an internal hint window will be created which is not our own class (because we don't set an application wide hint window class but only one for the tree). Unfortunately, this default hint window class will prevent hints for the non-client area to show up (e.g. for the header) by calling CancelHint whenever certain messages arrive. By setting the hint show pause to 0 if our hint class was not used recently we make sure that the hint timer (in Forms.pas) is not used and our class is created immediately.

I'm not really sure how to handle this. I think I'll drop the whole idea of using my won hint class for the header columns.

Recommended topics

Hot tags