unit Unit1;<br><br>interface<br><br>uses<br> Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,<br> Dialogs, commctrl, StdCtrls;<br><br>const<br> TTS_BALLOON = $40;<br> TTM_SETTITLE = (WM_USER + 32);<br><br>type<br> TForm1 = class(TForm)<br> Button1: TButton;<br> Memo1: TMemo;<br> Button2: TButton;<br> Button3: TButton;<br> Button4: TButton;<br> procedure Button1Click(Sender: TObject);<br> procedure Button2Click(Sender: TObject);<br> procedure Button3Click(Sender: TObject);<br> procedure Button4Click(Sender: TObject);<br> private<br> { Private declarations }<br> public<br> { Public declarations }<br> end;<br><br> procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;<br> Text, Title: PChar);<br> procedure CreateToolTips(hwnd: Cardinal);<br><br>var<br> Form1: TForm1;<br> hTooltip: Cardinal;<br> ti: TToolInfo;<br> buffer: array[0..255] of char;<br><br>implementation<br><br>{$R *.dfm}<br><br>procedure CreateToolTips(hwnd: Cardinal);<br>begin<br> hTooltip := CreateWindowEx(0, 'Tooltips_Class32', nil,<br> TTS_ALWAYSTIP or TTS_BALLOON,<br> Integer(CW_USEDEFAULT),<br> Integer(CW_USEDEFAULT),<br> Integer(CW_USEDEFAULT),<br> Integer(CW_USEDEFAULT),<br> hwnd, 0, hInstance, nil);<br> if hTooltip <> 0 then<br> begin<br> SetWindowPos(hTooltip, HWND_TOPMOST, 0, 0, 0, 0,<br> SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);<br> ti.cbSize := SizeOf(TToolInfo);<br> ti.uFlags := TTF_SUBCLASS;<br> ti.hInst := hInstance;<br> end;<br>end;<br><br>procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer; Text, Title: PChar);<br>var<br> Item: THandle;<br> Rect: TRect;<br>begin<br> Item := hwnd;<br> if (Item <> 0) and (GetClientRect(Item, Rect)) then<br> begin<br> lpti.hwnd := Item;<br> lpti.Rect := Rect;<br> lpti.lpszText := Text;<br> SendMessage(hTooltip, TTM_ADDTOOL, 0, Integer(lpti));<br> FillChar(buffer, SizeOf(buffer), #0);<br> lstrcpy(buffer, Title);<br> if (IconType > 3) or (IconType < 0) then IconType := 0;<br> SendMessage(hTooltip, TTM_SETTITLE, IconType, Integer(@buffer));<br> end;<br>end;<br><br>procedure TForm1.Button1Click(Sender: TObject);<br>begin<br> CreateToolTips(Form1.Handle);<br> AddToolTip(Memo1.Handle, @ti, 0, '测试飞跃提示', '无图标提示');<br>end;<br><br>procedure TForm1.Button2Click(Sender: TObject);<br>begin<br> CreateToolTips(Form1.Handle);<br> AddToolTip(Memo1.Handle, @ti, 1, '测试飞跃提示', '信息图标');<br>end;<br><br>procedure TForm1.Button3Click(Sender: TObject);<br>begin<br> CreateToolTips(Form1.Handle);<br> AddToolTip(Memo1.Handle, @ti, 2, '测试飞跃提示', '警告图标');<br>end;<br><br>procedure TForm1.Button4Click(Sender: TObject);<br>begin<br> CreateToolTips(Form1.Handle);<br> AddToolTip(Memo1.Handle, @ti, 3, '测试飞跃提示', '错误图标');<br>end;<br><br>end.