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

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;