|
创建漂亮的气球提示:qfKLinux联盟
 qfKLinux联盟
qfKLinux联盟
{....}qfKLinux联盟
qfKLinux联盟
uses Commctrl;qfKLinux联盟
qfKLinux联盟
{....}qfKLinux联盟
qfKLinux联盟
constqfKLinux联盟
TTS_BALLOON = $40;qfKLinux联盟
TTM_SETTITLE = (WM_USER + 32);qfKLinux联盟
qfKLinux联盟
varqfKLinux联盟
hTooltip: Cardinal;qfKLinux联盟
ti: TToolInfo;qfKLinux联盟
buffer : array[0..255] of char;qfKLinux联盟
qfKLinux联盟
{....}qfKLinux联盟
qfKLinux联盟
qfKLinux联盟
qfKLinux联盟
procedure CreateToolTips(hWnd: Cardinal);qfKLinux联盟
beginqfKLinux联盟
hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or TTS_BALLOON,qfKLinux联盟
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),qfKLinux联盟
Integer(CW_USEDEFAULT), hWnd, 0, hInstance, nil);qfKLinux联盟
if hToolTip <> 0 thenqfKLinux联盟
beginqfKLinux联盟
SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE orqfKLinux联盟
SWP_NOSIZE or SWP_NOACTIVATE);qfKLinux联盟
ti.cbSize := SizeOf(TToolInfo);qfKLinux联盟
ti.uFlags := TTF_SUBCLASS;qfKLinux联盟
ti.hInst := hInstance;qfKLinux联盟
end;qfKLinux联盟
end;qfKLinux联盟
qfKLinux联盟
procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;qfKLinux联盟
Text, Title: PChar);qfKLinux联盟
varqfKLinux联盟
Item: THandle;qfKLinux联盟
Rect: TRect;qfKLinux联盟
beginqfKLinux联盟
Item := hWnd;qfKLinux联盟
if (Item <> 0) and (GetClientRect(Item, Rect)) thenqfKLinux联盟
beginqfKLinux联盟
lpti.hwnd := Item;qfKLinux联盟
lpti.Rect := Rect;qfKLinux联盟
lpti.lpszText := Text;qfKLinux联盟
SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti));qfKLinux联盟
FillChar(buffer, SizeOf(buffer), #0);qfKLinux联盟
lstrcpy(buffer, Title);qfKLinux联盟
if (IconType > 3) or (IconType < 0) then IconType := 0;qfKLinux联盟
SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer));qfKLinux联盟
end;qfKLinux联盟
end;qfKLinux联盟
qfKLinux联盟
procedure TForm1.Button1Click(Sender: TObject);qfKLinux联盟
beginqfKLinux联盟
CreateToolTips(Form1.Handle);qfKLinux联盟
AddToolTip(Memo1.Handle, @ti, 1, 'Tooltip text', 'Title');qfKLinux联盟
end;qfKLinux联盟
qfKLinux联盟
{qfKLinux联盟
IconType can be:qfKLinux联盟
qfKLinux联盟
0 - No iconqfKLinux联盟
1 - InformationqfKLinux联盟
2 - WarningqfKLinux联盟
3 - ErrorqfKLinux联盟
} |
|
|
