[NumLock]

Код:

unit ToolTips;

interface

uses
  CommCtrl, Windows, Messages;

procedure ToolTipShow(Handle: THandle; Msg: String; Title: String);
procedure ToolTipHide(Handle: THandle);

implementation

uses Types;

var
  FToolTip: HWND;
  FToolTipInfo: TOOLINFO;

const
  TTI_NONE = 0;
  TTI_INFO = 1;
  TTI_WARNING = 2;
  TTI_ERROR = 3;

  TTS_ALWAYSTIP = $01;
  TTS_NOPREFIX = $02;
  TTS_NOANIMATE = $10;
  TTS_NOFADE = $20;
  TTS_BALLOON = $40;
  TTS_CLOSE = $80;

  TTM_SETTITLE = WM_USER+32;

procedure ToolTipShow(Handle: THandle; Msg: String; Title: String);
var
  p: TPoint;
begin
  ZeroMemory(@FToolTipInfo, SizeOf(TOOLINFO));
  FToolTipInfo.cbSize:=SizeOf(TOOLINFO);
  FToolTipInfo.hInst:=HInstance;
  FToolTipInfo.uFlags:=TTF_TRACK or TTF_ABSOLUTE;
  FToolTipInfo.hwnd:=Handle;
  FToolTipInfo.lpszText:=PChar(Msg);
  p.X:=0;
  p.Y:=0;
  ClientToScreen(Handle, p);
  SendMessage(FToolTip, TTM_ADDTOOL, 0, LPARAM(@FToolTipInfo));
  SendMessage(FToolTip, TTM_SETTITLE, TTI_INFO, Integer(PChar(Title)));
  SendMessage(FToolTip, TTM_TRACKPOSITION, 0, MakeLong(p.X, p.Y));
  SendMessage(FToolTip, TTM_TRACKACTIVATE, 1, LPARAM(@FToolTipInfo));
end;

procedure ToolTipHide(Handle: THandle);
begin
  SendMessage(FToolTip, TTM_TRACKACTIVATE, 0, LPARAM(@FToolTipInfo));
  SendMessage(FToolTip, TTM_DELTOOL, 0, LPARAM(@FToolTipInfo));
end;

procedure ToolTipCreate;
begin
  FToolTip:=CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil,
    WS_POPUP or TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON,
    0, 0, 0, 0, 0, 0, HInstance, nil);
  SendMessage(FToolTip, TTM_SETTIPTEXTCOLOR, $000000, 0);
  SendMessage(FToolTip, TTM_SETTIPBKCOLOR, $F0FBFF, 0);
end;

procedure ToolTipDestroy;
begin
  DestroyWindow(FToolTip);
end;

initialization
  ToolTipCreate;

finalization
  ToolTipDestroy; 

end.

http://zalil.ru/34239301