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

Question

Before I used THint, and it was working with this code:

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;

Now I use TBalloonHint and want to change hint text when hint is shown. The above procedure is not triggered.

I am changing the hint text each second, so when user enters control, the hint is shown and I want to update the hint text each second, also when user is not moving with the mouse.

How to achieve this with TBalloonHint?

Answer 1

TBalloonHint does not support this functionality. The following code (Delphi XE3) adds it.

Cons:

• CPU load - every call TBalloonHint.ShowHint creates a new TCustomHintWindow
• flickering when redrawing

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;

Another ways:

• rewrite TMyHintWindow.CalcHintRect and .Paint taking code from TBalloonHint

• rewrite TMyHintWindow using Tooltip Controls

Add: Use tooltip control. Try also set 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;