// Function to show baloon hint
// (found on pl.comp.lang.delphi newsgroup - posted by spook)
function ShowBaloonHint(Point: TPoint; Handle: THandle; Title: String;
Msg: String; Icon: Integer): Boolean;
var
hwnd: THandle;
ti: TToolInfo;
hCursor: THandle;
Rect: TRect;
IconData: TNotifyIconData;
const
TTS_BALLOON = $40;
TTS_CLOSE = $80;
procedure SetToolTipTitle(tt: THandle; IconType: Integer; Title: string);
var
buffer: array[0..255] of Char;
const
TTM_SETTITLE = (WM_USER + 32);
begin
FillChar(buffer, SizeOf(buffer),
lstrcpy(buffer, PChar(Title));
SendMessage(tt, TTM_SETTITLE, IconType, Integer(@buffer));
end;
begin
hwnd:= CreateWindowEx(0,
TOOLTIPS_CLASS,
nil,
TTS_ALWAYSTIP or TTS_BALLOON or TTS_CLOSE,
CW_USEDEFAULT,
CW_USEDEFAULT,
CW_USEDEFAULT,
CW_USEDEFAULT,
Application.MainForm.Handle,
0,
Application.Handle,
0);
SetWindowPos( hwnd,
HWND_TOPMOST,
0,
0,
0,
0,
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
GetClientRect(Handle, Rect);
with ti do
begin
cbSize:= Sizeof(TToolInfo);
uFlags:= TTF_TRACK;
hwnd:= Handle;
hInst:= Application.Handle;
uId:= Handle;
lpszText:= PChar(Msg);
end;
ti.Rect.Left:= Rect.Left;
ti.Rect.Top:= Rect.Top;
ti.Rect.Right:= Rect.Right;
ti.Rect.Bottom:= Rect.Bottom;
SendMessage(hwnd,TTM_ADDTOOL,1,Integer(@ti));
SetToolTipTitle(hwnd,Icon,Title);
SendMessage(hwnd, TTM_TRACKPOSITION, 0, MakeLParam(Point.x,Point.y));
SendMessage(hwnd, TTM_TRACKACTIVATE, Integer(True), Integer(@ti));
end;