Jak zrobić balonikowatego hinta

[Bodzio]

Na początu deklarujemy klika zmiennych:

var
  hTooltip: Cardinal; 
  ti: TToolInfo; 
  buffer : array[0..255] of char; 

const
  TTS_BALLOON    = $40;
  TTM_SETTITLE = (WM_USER + 32);

Później wrzucamy dwie procedurki:

procedure CreateToolTips(hWnd: Cardinal); 
begin 
  hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or TTS_BALLOON, 
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 
    Integer(CW_USEDEFAULT), hWnd, 0, hInstance, nil); 
  if hToolTip <> 0 then 
  begin 
    SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or 
      SWP_NOSIZE or SWP_NOACTIVATE); 
    ti.cbSize := SizeOf(TToolInfo); 
    ti.uFlags := TTF_SUBCLASS; 
    ti.hInst  := hInstance; 
  end; 
end; 

procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer; 
  Text, Title: PChar); 
var 
  Item: THandle; 
  Rect: TRect; 
begin 
  Item := hWnd; 
  if (Item <> 0) and (GetClientRect(Item, Rect)) then 
  begin 
    lpti.hwnd := Item; 
    lpti.Rect := Rect; 
    lpti.lpszText := Text; 
    SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti)); 
    FillChar(buffer, SizeOf(buffer), #0); 
    lstrcpy(buffer, Title); 
    if (IconType > 3) or (IconType < 0) then IconType := 0; 
    SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer)); 
  end; 
end;

i teraz wrzucamy np. Memo i w OnFormCreate:

  CreateToolTips(Form1.Handle);
  AddToolTip(Memo1.Handle, @ti, 1, 'Tooltip text', 'Title');

Typy ikonek w balonikach:

0 - Bez ikony
1 - Informacja
2 - Ostrzeżenie
3 - Błąd

Testowane na WinShicie 98 ;)
! na podstawie artykułu z torry.net !

FAQ

9 komentarzy

tylko do uses trza dać Commctrl i w CreateToolTips jak i AddToolTip musi być ten sam uchwyt w parametrze podany, a działa nawet spoko

Zalorze sie, ze nic z tego nie kapujesz

mam 15 takich,i wogle nie odpala.Handle-undeclared identifier ;(

win9x a czy xp to nie wiem ...

Czy to chodzi w Win 9x, czy tylko pod XP?

Jak można przepisywać z innych stronek ?? Bodzio lol...