TVirtualStringTree - 如何为VT列使用我自己的提示窗口类？

Question

我想为我的整个应用程序使用自定义Hint窗口类.我使用Application.OnShowHint,分析THintInfo,并返回我自己TMyHintWindow的HintInfo.HintWindowClass.这适用于所有控件,但我只有TVirtualStringTree Columns提示有一个奇怪的问题.

VT使用它自己的提示窗口和自己的结构HintInfo.HintData.我研究代码,并知道它使用了VTHintData.到现在为止还挺好.问题是,当我返回自己的提示窗口类(派生自THintWindow)时,它仅显示提示窗口一瞬间消失!

为树节点返回的提示没有问题.他们使用相同的方法/结构(VTHintData).

这是一个非常简单的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.

形成:

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

我调试了几个小时.我觉得没什么特别的.为什么会这样？谁/什么立即关闭提示窗口？谢谢.

我正在使用VT版本5.3.0

---

在其中TBaseVirtualTree.CMHintShowPause()陈述:

这里需要一个小的解决方法来使用正确的提示窗口类来创建应用程序类.一旦应用程序将ShowHint设置为true(当我们想要在树中显示提示时就是这种情况),那么将创建一个内部提示窗口,这不是我们自己的类(因为我们没有设置应用程序范围的提示窗口类但只有一棵树).不幸的是,这个默认提示 窗口类将阻止非客户区域的提示 (例如,对于标题)通过在某些消息到达时调用CancelHint来显示.如果最近没有使用我们的提示类,通过将提示show pause设置为0,我们确保不使用提示计时器(在Forms.pas中)并立即创建我们的类.

我真的不确定如何处理这个问题.我想我会放弃使用我的赢得提示类作为标题列的整个想法.