WinApi и подсказки (ToolTips)

program WinApiStub;
uses windows,messages,commctrl;
 
var
 tips,hInst,h,d,c:cardinal;
 x,y:integer;
 cl:tWndClass;
 ms:tMsg;
 
const
 _s='   ';
 tit='WinApi Stub Exe';
 cap=_s+tit;
 cln='M13Class';
 bt='Button';
 ww=320;
 wh=240;
 v=8;
 tx1='Text Text Text';
 tx2='Markus_13';
 
function mesaga(s:string;f:cardinal=0):integer;//выдача сообщения
begin
 result:=MessageBox(0,pchar(s+_s),cap,f+$1000);
end;
 
procedure quit;//процедура завершения проги
begin
 UnRegisterClass(cln,hInst);
 ExitProcess(hInst);
 halt;
end;
 
function WindowProc(hwnd,msg,wparam,lparam:integer):integer;stdcall;//обработчик сообщений
begin
 result:=DefWindowProc(hwnd,msg,wparam,lparam);
 if msg=WM_COMMAND then begin
  if HiWord(wParam)=BN_CLICKED then begin
   if LoWord(wParam)=1 then mesaga('Button1');
   if LoWord(wParam)=2 then mesaga('Button2');
  end;
 end;
 if msg=WM_DESTROY then quit;
end;
 
procedure InitTips;//инициализация подсказки
var ICC:TInitCommonControlsEx;
begin
 ICC.dwICC:=ICC_WIN95_CLASSES;
 ICC.dwSize:=SizeOf(TInitCommonControlsEx);
 InitCommonControlsEx(ICC);
 tips:=CreateWindow(TOOLTIPS_CLASS,'',TTS_ALWAYSTIP,
  CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,0,0,hInstance,nil);
 SendMessage(tips,TTM_SETDELAYTIME,TTDT_AUTOPOP,5000);
 SendMessage(tips,TTM_SETDELAYTIME,TTDT_INITIAL,500);
 SendMessage(tips,TTM_SETDELAYTIME,TTDT_RESHOW,150);
 //SendMessage(tip,TTM_SETMAXTIPWIDTH,0,220);
 SetWindowPos(tips,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
end;
 
procedure AddTip(d:hwnd;t:string);//добавление хинта к контролу
var TI:TToolInfo;
begin
 TI.cbSize:=SizeOf(TToolInfo);
 TI.uFlags:=TTF_SUBCLASS or TTF_IDISHWND;
 TI.hwnd:=h;
 TI.uId:=d;
 TI.hInst:=hInstance;
 TI.lpszText:=pchar(t);
 SendMessage(tips,TTM_ADDTOOL,0,Lparam(@TI));
end;
 
procedure EnableTips(e:boolean);//включение/выключение хинтов
begin
 SendMessage(tips,TTM_ACTIVATE,ord(e),0);
end;
 
begin
 if FindWindow(cln,cap)>0 then halt;
 hInst:=GetModuleHandle(nil);
 cl.Style:=CS_PARENTDC;
 cl.hIcon:=LoadIcon(hInstance,IDI_APPLICATION);
 cl.lpfnWndProc:=@WindowProc;
 cl.hInstance:=hInst;
 cl.hbrBackground:=16;
 cl.lpszClassName:=cln;
 cl.hCursor:=LoadCursor(0,IDC_ARROW);
 InitCommonControls;
 RegisterClass(cl);
 x:=(GetDeviceCaps(getDC(0),HORZRES)-ww)div 2;
 y:=(GetDeviceCaps(getDC(0),VERTRES)-wh)div 2;
 c:=WS_OVERLAPPED or WS_SYSMENU or WS_VISIBLE;
 h:=CreateWindowEx(0,cln,cap,c,x,y,ww,wh,0,0,hInst,nil);
 InitTips;
 AddTip(h,'Example ToolTip');
 c:=WS_CHILD or WS_VISIBLE or BS_PUSHLIKE;
 d:=CreateWindow(bt,tx1,c,22,32,270,80,h,1,0,nil);
 AddTip(d,'Example ToolTip 1');
 d:=CreateWindow(bt,tx2,c,64,142,220,36,h,2,0,nil);
 AddTip(d,'Example ToolTip 2');
 EnableTips(true);
 while(GetMessage(ms,h,0,0))do begin
  TranslateMessage(ms);
  //SendMessage(tips,TTM_RELAYEVENT,0,integer(@ms));
  if(GetAsyncKeyState(vk_escape)<>0)then quit;
  DispatchMessage(ms);
 end;
 quit;
end.

program WinApiStub;
uses Windows, Messages, CommCtrl;
 
const
   IDbtn1 = 100;
   IDbtn2 = 101;
   btnClass = 'BUTTON';
   szClassName = 'M13Class';
 
   tx_1 = 'Text Text Text';
   tx_2 = 'Markus_13';
 
   Wid = 320;
   Hei = 240;
   Title = 'WinApi Stub Exe';
var
   hInst : THandle;
   hMainWnd, tips : HWND;
   hBtn1, hBtn2 : HWND;
 
 
procedure AddTip(Control : HWND; Tip : string);
var TI : TToolInfo;
begin
   TI.cbSize := SizeOf(TToolInfo);
   TI.uFlags := TTF_SUBCLASS or TTF_IDISHWND;
   TI.hwnd := hMainWnd;
   TI.uId := Control;
   TI.hInst := hInst;
   TI.lpszText := PChar(Tip);
   SendMessage(tips, TTM_ADDTOOL, 0, Lparam(@TI));
end;
 
procedure InitTips (parent : HWND);
begin
   tips := CreateWindowEx(0, TOOLTIPS_CLASS, nil, TTS_ALWAYSTIP, CW_USEDEFAULT, CW_USEDEFAULT,
                         CW_USEDEFAULT, CW_USEDEFAULT, parent, 0, hInst, nil);
 
   AddTip(parent, 'Example ToolTip');
 
   AddTip(hBtn1, 'Example ToolTip 1');
   AddTip(hBtn2, 'Example ToolTip 2');
end;
 
 
function WindowProc (hWnd : HWND; msg : UINT;
                     wParam : WPARAM; lParam : LPARAM) : LRESULT; stdcall;
begin
   result := 0;
   case msg of
      WM_SHOWWINDOW:
      begin
            InitTips(hWnd);
            result := 1;
      end;
      WM_CREATE:
      begin
            hBtn1 := CreateWindowEx(0, btnClass, tx_1, WS_CHILD or WS_VISIBLE or BS_PUSHLIKE,
                                 22, 32, 270, 80, hWnd, IDbtn1, hInst, nil);
 
            hBtn2 := CreateWindowEx(0, btnClass, tx_2, WS_CHILD or WS_VISIBLE or BS_PUSHLIKE,
                                 64, 142, 220, 36, hWnd, IDbtn2, hInst, nil);
      end;
      WM_COMMAND:
      begin
         if HiWord(wParam) = BN_CLICKED then
         case LOWORD(wParam) of
            IDbtn1 : MessageBox(0, PChar('Button1'), Title, MB_OK);
            IDbtn2 : MessageBox(0, PChar('Button2'), Title, MB_OK);
         end;
      end;
      WM_DESTROY:
         PostQuitMessage (0);
      else
         result := DefWindowProc (hWnd, msg, wParam, lParam);
   end;
end;
 
var
   ms : TMsg;
   wincl : TWndClassEx;
begin
   hInst := hInstance;
   InitCommonControls;
 
   wincl.hInstance := hInstance;
   wincl.lpszClassName := szClassName;
   wincl.lpfnWndProc := @WindowProc;
   wincl.style := CS_DBLCLKS;
   wincl.cbSize := sizeof(WNDCLASSEX);
   wincl.hIcon := LoadIcon(0, IDI_APPLICATION);
   wincl.hIconSm := LoadIcon(0, IDI_APPLICATION);
   wincl.hCursor := LoadCursor(0, IDC_ARROW);
   wincl.lpszMenuName := nil;
   wincl.cbClsExtra := 0;
   wincl.cbWndExtra := 0;
   wincl.hbrBackground := COLOR_BACKGROUND;
 
   if RegisterClassEx(wincl) = 0 then exit;
 
    hMainWnd := CreateWindowEx (0, szClassName, Title, WS_OVERLAPPED or WS_SYSMENU or WS_VISIBLE,
      (GetDeviceCaps(getDC(0), HORZRES) - Wid) div 2,
      (GetDeviceCaps(getDC(0), VERTRES) - Hei) div 2, Wid, Hei,
      0, 0, hInst, nil);
   ShowWindow(hMainWnd, CmdShow);
 
   while (GetMessage (ms, 0, 0, 0)) do
   begin
      TranslateMessage(ms);
      DispatchMessage(ms);
   end;
   Halt(ms.wParam);
end.