Внешний вид сайта:

Как изменить вид всплывающей подсказки

Для того, чтобы изменить вид всплывающей подсказки и сделать ее в виде воздушного шара, как этот делается в некоторый приложениях Windows XP, нужно всего лишь добавить приведенный ниже код в исходный код формы Вашего приложения.

Изменение вида всплывающей подсказки

uses
  { ... }, StdCtrls, Commctrl;

{ ... }

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

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

implementation

{$R *.dfm}

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;

procedure TForm1.FormCreate(Sender: TObject);
begin 
   CreateToolTips(Form1.Handle); 
   AddToolTip(
      Edit1.Handle, @ti, 1, 'Подсказка в виде воздушного шара', 'Заголовок');
end;

Комментарии

Нет комментариев. Ваш будет первым!