创建漂亮的气球提示(balloon tooltips)

创建漂亮的气球提示(balloon tooltips) 日期:2007-7-12 类别:杂项 作者: 推荐:本站 人气:1076

创建漂亮的气球提示: {....} uses Commctrl; {....} const TTS_BALLOON    = $40; TTM_SETTITLE = (WM_USER + 32); var hTooltip: Cardinal; ti: TToolInfo; buffer : array[0..255] of 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, 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.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 }

转载于:https://www.cnblogs.com/wenwencao/archive/2010/05/18/1738289.html