delphi 气泡提示

这是一个气泡提示的动态库.(参考网络资源 自己封装)

library BoolTip;

uses
  SysUtils,
  CommCtrl,
  Windows,
  Controls,
  Classes;

{$R *.res}
var
  tI: TToolInfo;
  buffer : array[0..255] of char;

 function CreateInfoTip(hWnd: THandle): THandle; stdcall;
 var
   hToolTip: Cardinal;
 begin
   hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or $40,
   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 or TTF_TRANSPARENT;
     tI.hInst := hInstance;
   end;
   Result := hToolTip;
 end;

 function ShowInfoTip(pTip: THandle; lpszText: PChar; pos:PPoint=nil; icon:HICON=0;
                       nDelay:Integer=1000): Boolean; stdcall;
 var
   Rect: TRect;
 begin
   FillChar(buffer, sizeof(buffer), #0);
   lstrcpy(buffer, '提示');
   if pos = nil then Rect.BottomRight := Mouse.CursorPos
   else  Rect.BottomRight := Point(pos^.X,pos^.Y);
   tI.hwnd := WindowFromPoint(Mouse.CursorPos);
   Rect.TopLeft := Point(0,0);
   tI.Rect := Rect;
   tI.lpszText := lpszText;
   SendMessage(pTip, TTM_ADDTOOL, 0, Integer(@tI));
   if (icon > 3) or (icon < 0) then icon := 0;
//   icon  0: 默认  1: 提示  2: 感叹号  3: 错误
   SendMessage(pTip, $0400 + 32, icon, Integer(@buffer));
//   SendMessage(pTip, TTM_SETTIPBKCOLOR, $95E3FF, 0);  //设置背景色
//   SendMessage(hToolTip, TTM_SETTIPTEXTCOLOR, clGreen , 0);  //设置字体颜色
   Result := True;
 end;

 procedure DestroyInfoTip(pTip: THandle); stdcall;
 begin
   DestroyWindow(pTip);
 end;

exports
  CreateInfoTip   name 'CreateInfoTip',
  ShowInfoTip     name 'ShowInfoTip',
  DestroyInfoTip  name 'DestroyInfoTip';
  
end.