Hint balloon - Hint balao com imagem

Top  Previous  Next

uses Commctrl; 

 

{....} 

 

const 

  TTS_BALLOON    = $40

  TTM_SETTITLE = (WM_USER + 32); 

 

var 

  hTooltip: Cardinal; 

  ti: TToolInfo; 

  buffer : array[0..255of char; 

   

{....} 

 

 

 

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, 0000, 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 <> 0and (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 > 3or (IconType < 0) then IconType := 0

    SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer)); 

  end

end

 

procedure TForm1.Button1Click(Sender: TObject); 

begin 

  CreateToolTips(Form1.Handle); 

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

end

 

IconType can be: 

 

 0 - No icon 

 1 - Information 

 2 - Warning 

 3 - Error 

}