delphi气泡提示

气泡提示比弹出框可能用户体验更好，下面是从网上搜索来的代码

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs,commctrl, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
    cbb1: TComboBox;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure CreateBox(h: HWND; text, cap : string; IconType: Integer = 1; T: Integer = 1000);
var
 r : TRect;
 hTooltip: Cardinal;
 ti: TToolInfo;
begin
 hToolTip := CreateWindow('Tooltips_Class32',nil,$40,0,0,0,0,0,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_IDISHWND or TTF_TRACK;
   ti.hInst := hInstance;
   ti.lpszText :=pchar(text);
   SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(@ti));
   if (IconType > 3) or (IconType < 0) then IconType:=0;
   SendMessage(hToolTip,WM_USER + 32,IconType,Integer(pchar(cap)));
   GetWindowRect(H,R);             //获取指定控件的坐标,R.Right 、R.Left、R.Bottom、R.Top
   SendMessage(hToolTip,TTM_TRACKPOSITION, 0, MAKELONG((r.Right - r.Left) div 2 + r.Left, (r.Bottom - r.Top) div 2 + r.Top));      // 定义气泡位置
   SendMessage(hToolTip, TTM_TRACKACTIVATE, Integer(True), Integer(@ti));
   Sleep(t);
   DestroyWindow(hToolTip);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CreateBox(TButton(form1.FindComponent(cbb1.Text)).Handle,'控件' + cbb1.Text,'你好');
end;

procedure TForm1.FormActivate(Sender: TObject);
var i:integer;
begin
  for i := 0 to ComponentCount - 1 do
    cbb1.Items.Add(Components[i].Name);
  cbb1.ItemIndex:=0;
end;

end.