Delphi 三种气泡提示效果

一、方法一

说明：这个效果不好，鼠标必须放在按钮上，气泡提示才可以出来，如果鼠标在按钮的范围之外，
        用回车键点击按钮也不会激活气泡提示。

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,CommCtrl;
const
    TTS_BALLOON   =   $40;
    TTM_SETTITLE   =   (WM_USER   +   32);
type
TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;
hTooltip:   Cardinal;
ti:   TToolInfo;
buffer   :   array[0..255]   of   char;

implementation

{$R *.dfm}

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   or   TTF_TRANSPARENT;
      ti.hInst   :=   hInstance;
    end;
end;

//BackColor,TextColor分别是背景颜色和文本颜色,如果是0则取默认值.
procedure   AddToolTip(hwnd:   dword;   lpti:   PToolInfo;   IconType:   Integer;   Text,   Title:   PChar;
BackColor,TextColor:TColor);
var
Rect:   TRect;
begin
    if   (hwnd   <>   0)   AND   (GetClientRect(hwnd,   Rect))   then
    begin
        lpti.hwnd   :=   hwnd;
        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;
        if   BackColor <> 0   then
        SendMessage(hToolTip,   TTM_SETTIPBKCOLOR,   BackColor,   0);
        if   TextColor <> 0   then
        SendMessage(hToolTip,   TTM_SETTIPTEXTCOLOR,   TextColor,   0);
        SendMessage(hToolTip,   TTM_SETTITLE,   IconType,   Integer(@buffer));
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateToolTips(Button1.Handle);
AddToolTip(Button1.Handle,   @ti,   1,   '提示内容',   '提示标题',0,0);   //数字1可以该为其它的数字来显示不同的图标
end;

 

 

----------------------------------------------------------------------------------------------------------------------------------------------------------------

一、方法二

效果图片如下：
说明：这个方法比较好，鼠标不必放在按钮上，只要按钮有焦点，用回车和空格键都可以出现气泡提示，
         而且气泡提示是跟着鼠标的，也就是说鼠标移动到什么地方气泡提示也会出现在那里！

//代码如下：
//说明：这个是封装的一个类，调用的时候需要创建一个实例后，再调用那个方法即可。

1、类的代码：

unit uHintWin;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,CommCtrl;

type
THintWin = class(THintWindow)
private
    FLastActive:   THandle;
public
    procedure   ActivateHint(Rect:TRect;Const   AHint:string);override;
end;

implementation

{ THintWin }
procedure   AddTipTool(hWnd:   DWORD;   IconType:   Integer;   Title,   Text:   PChar);
const
  TTS_BALLOON   =$0040 ;                  //ToolTip提示窗口的外形，指定为气球型
  TTM_SETTITLE=WM_USER   +   32;         //设置提示标题信息的消息
var
  hWndTip:   DWORD;
  ToolInfo:   TToolInfo;
begin
  hWndTip:=CreateWindow(TOOLTIPS_CLASS,   nil,
                  WS_POPUP   or   TTS_NOPREFIX   or   TTS_BALLOON   or   TTS_ALWAYSTIP ,
                  0,   0,   0,   0,   hWnd,   0,   HInstance,   nil);
  if   (hWndTip <> 0)   then
  begin
      ToolInfo.cbSize:=SizeOf(ToolInfo);                                             //设置ToolInfo的大小
      ToolInfo.uFlags:=TTF_IDISHWND   or   TTF_SUBCLASS   or   TTF_TRANSPARENT;      //设置基本风格
      ToolInfo.uId:=hWnd;                                                            //设置所有者的句柄
      ToolInfo.lpszText:=Text;
      SendMessage(hWndTip,TTM_ADDTOOL,1,Integer(@ToolInfo));
      SendMessage(hWndTip,TTM_SETTITLE,2,Integer(Title));            //设置气泡窗体的提示图标和标题信息
      SendMessage(hWndTip, TTM_SETTIPBKCOLOR, $D2FAFA, 0);          //设置背景色
      SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, $4040 , 0);        //设置字体颜色
  end;
  InitCommonControls();

end;

procedure THintWin.ActivateHint(Rect: TRect; const AHint: string);
begin
inherited;
    if   FLastActive <> WindowFromPoint(Mouse.CursorPos)   then
    AddTipTool(WindowFromPoint(Mouse.CursorPos),1,'Sherry   SoftWare',   PChar(AHint));//Application.Hint));
    FLastActive:=WindowFromPoint(Mouse.CursorPos);
end;

initialization
Application.HintPause:=0;
Application.ShowHint:=False;
HintWindowClass:=THintWin;
Application.ShowHint:=True;

end.

2、调用的代码
//说明：调用之前要引用上面这个类的单元。

procedure TForm2.Button1Click(Sender: TObject);
var
a:THintWin;
Rect:   TRect;
begin
a := THintWin.Create(Self);
a.ActivateHint(Rect,'测试提示气泡！');

 sndPlaySound('C:\Windows\Media\Windows XP 气球.wav', SND_ASYNC );
end;

 

 

----------------------------------------------------------------------------------------------------------------------------------------------------------------

一、方法三

在任意控件里显示气泡，不需要鼠标放在控件上才显示。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    cbb1: TComboBox;
    edt1: TEdit;
    lst1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure CreateBox(h:HWND;text,cap:string;IconType:integer=1;t:integer=1000);  
var  
 r : TRect;                       //是一个记录（Record），保存了矩形的（左上角右下角两个点）4个坐标或2个点的值。
 hTooltip: Cardinal;    //Cardinal是无符号32位整数 ，取值0到4294967295范围。

 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,'处理群内陌生人问题','你好');
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.

 

 

 

----------------------------------------------------------------------------------------------------------------------------------------------------------------

WM_USER                 = $400;
  TTN_FIRST               = 0-520;
  TTS_ALWAYSTIP           = $01;
  TTS_NOPREFIX            = $02;
  TTF_IDISHWND            = $01;
  TTF_CENTERTIP           = $02;
  TTF_RTLREADING          = $04;
  TTF_SUBCLASS            = $10;
  TTS_NOANIMATE           = $10;
  TTS_NOFADE              = $20;
  TTS_BALLOON             = $40;
  TTF_TRACK               = $00000020;
  TTF_ABSOLUTE            = $00000080;
  TTF_TRANSPARENT         = $00000100;
  TTI_NONE                = $0;
  TTI_INFO                = $1;
  TTI_WARNING             = $2;
  TTI_ERROR               = $3;
  TTM_TRACKACTIVATE       = WM_USER + 17;
  TTM_TRACKPOSITION       = WM_USER + 18;
  TTM_SETTIPBKCOLOR       = WM_USER + 19;
  TTM_SETTIPTEXTCOLOR     = WM_USER + 20;
  TTM_GETDELAYTIME        = WM_USER + 21;
  TTM_GETTIPBKCOLOR       = WM_USER + 22;
  TTM_GETTIPTEXTCOLOR     = WM_USER + 23;
  TTM_SETMAXTIPWIDTH      = WM_USER + 24;
  TTM_GETMAXTIPWIDTH      = WM_USER + 25;
  TTM_SETMARGIN           = WM_USER + 26;
  TTM_GETMARGIN           = WM_USER + 27;
  TTM_POP                 = WM_USER + 28;
  TTM_GETBUBBLESIZE       = WM_USER + 30;
  TTM_ADJUSTRECT          = WM_USER + 31;
  TTM_SETTITLE            = WM_USER + 32;
  TTM_SETTITLEW           = WM_USER + 33;
  TTN_GETDISPINFOW        = (TTN_FIRST - 10);
  TOOLTIPS_CLASS          = 'tooltips_class32'

转自：http://hi.baidu.com/%B0%AE%C1%B5%D4%B5/blog/item/2bc936fe04b496245c600887.html