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.