如何在 TBalloonHint 中显示提示时更改提示文本？

Question

在我使用 THint 之前，它使用的是这段代码：

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnShowHint := AppShowHint;
end;

procedure TMainForm.AppShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: Controls.THintInfo);
begin
  HintInfo.ReshowTimeout := 1;
end;

现在我使用 TBalloonHint 并希望在显示提示时更改提示文本。上面的程序没有触发。

我每秒都在更改提示文本，因此当用户输入控件时，会显示提示，我想每秒更新一次提示文本，即使用户没有使用鼠标移动时也是如此。

如何使用 TBalloonHint 实现这一点？

Answer 1

TBalloonHint 不支持此功能。下面的代码（Delphi XE3）添加了它。

缺点：

CPU 加载 - 每次调用 TBalloonHint.ShowHint 都会创建一个新的 TCustomHintWindow
重绘时闪烁

type
  TMyHintWindow = class(THintWindow)
  public
    function CalcHintRect(MaxWidth: Integer; const AHint: string;
      AData: TCustomData): TRect; override;
    function ShouldHideHint: Boolean; override;
  end;

var BalloonHint: TBalloonHint;
    _HintPos: TPoint;

function TMyHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: TCustomData): TRect;
begin
  Result := Rect(0,0,0,0);
end;

function TMyHintWindow.ShouldHideHint: Boolean;
begin
  Result := True;
  BalloonHint.Free; BalloonHint := nil;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  HintWindowClass := TMyHintWindow;
  Application.OnShowHint := AppShowHint;
end;

procedure TMainForm.AppShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo);
begin
  HintInfo.ReshowTimeout := 1;

  if not Assigned(BalloonHint)
  then begin
    BalloonHint := TBalloonHint.Create(Self);
    _HintPos := Point(MaxInt, MaxInt);
  end;

  if (_HintPos <> HintInfo.HintPos) or (BalloonHint.Description <> HintStr)
  then begin
    _HintPos := HintInfo.HintPos;
    BalloonHint.Description := HintStr;
    BalloonHint.ShowHint(_HintPos);
  end;
end;

另一种方式：

重写 TMyHintWindow.CalcHintRect 和 .Paint 从 TBalloonHint
使用Tooltip Controls

TMyHintWindow

添加：使用工具提示控件。也尝试设置 HintInfo.ReshowTimeout := 25.

uses Windows, Vcl.Controls, System.Classes, Winapi.CommCtrl, Winapi.Messages;

type
  TTooltipHintWindow = class(THintWindow)
  private
    TooltipWnd: HWND;
    TooltipInfo: TToolInfo;
    TooltipText: string;
    TooltipPos: TPoint;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
    function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: TCustomData): TRect; override;
    function ShouldHideHint: Boolean; override;
  end;

implementation

procedure TTooltipHintWindow.ActivateHint(Rect: TRect; const AHint: string);
begin
  inherited;
  if (TooltipText <> AHint)
  then begin // update text
    TooltipText := AHint;
    TooltipInfo.lpszText := PChar(TooltipText);
    SendMessage(TooltipWnd, TTM_UPDATETIPTEXT, 0, LParam(@TooltipInfo));
  end;
  if (TooltipPos <> Rect.TopLeft)
  then begin // update position
    TooltipPos := Rect.TopLeft;
    SendMessage(TooltipWnd, TTM_TRACKPOSITION, 0, PointToLParam(TooltipPos));
  end;
  // show
  SendMessage(TooltipWnd, TTM_TRACKACTIVATE, WParam(True), LParam(@TooltipInfo));
end;

function TTooltipHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: TCustomData): TRect;
begin
  Result := Rect(0,0,0,0);
end;

constructor TTooltipHintWindow.Create(AOwner: TComponent);
var font, boldfont: HFONT;
    logfont: TLogFont;
begin
  inherited;
  // create tooltip
  TooltipWnd := CreateWindowEx(WS_EX_TOPMOST or WS_EX_TRANSPARENT,
    TOOLTIPS_CLASS, nil,
    TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON,
    0, 0, 0, 0, 0, 0, HInstance, nil);
  // set bold font
  font := SendMessage(TooltipWnd, WM_GETFONT, 0, 0);
  if (font <> 0)
  then begin
    if GetObject(font, SizeOf(logfont), @logfont) > 0
    then begin
      logfont.lfWeight := FW_BOLD;
      boldfont := CreateFontIndirect(logfont);
      SendMessage(TooltipWnd, WM_SETFONT, boldfont, 0);
    end;
  end;
  // set maximum width
  SendMessage(TooltipWnd, TTM_SETMAXTIPWIDTH, 0 , 400);
  // init
  FillChar(TooltipInfo, SizeOf(TooltipInfo), 0);
  TooltipInfo.cbSize := SizeOf(TooltipInfo);
  TooltipInfo.uFlags := TTF_TRACK or TTF_TRANSPARENT;
  TooltipInfo.uId := 1;
  SendMessage(TooltipWnd, TTM_ADDTOOL, 0, LParam(@TooltipInfo));
end;

destructor TTooltipHintWindow.Destroy;
begin
  DestroyWindow(TooltipWnd);
  inherited;
end;

function TTooltipHintWindow.ShouldHideHint: Boolean;
begin
  inherited;
  // hide
  SendMessage(TooltipWnd, TTM_TRACKACTIVATE, WParam(False), LParam(@TooltipInfo));
  TooltipPos := Point(MaxInt, MaxInt);
  TooltipText := '';
end;

如何在 TBalloonHint 中显示提示时更改提示文本？

How to change hint text while hint is shown in TBalloonHint?

delphi

delphi-xe2

hint