Delphi 三种气泡提示效果

一、方法一

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

unitUnit1;
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;
    procedureButton1Click(Sender: TObject);
private
    { Privatedeclarations }
public
    { Publicdeclarations }
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;
    procedureButton1Click(Sender: TObject);
    procedureFormActivate(Sender: TObject);
  private
    { Privatedeclarations }
  public
    { Publicdeclarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedureCreateBox(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 orSWP_NOACTIVATE);  //让气泡在最前面
   ti.cbSize :=SizeOf(TToolInfo);  
   ti.uFlags := TTF_IDISHWND orTTF_TRACK;  
   ti.hInst :=hInstance;  
   ti.lpszText:=pchar(text);  
   SendMessage(hToolTip,TTM_ADDTOOL, 0,Integer(@ti));  
   if (IconType > 3) or(IconType < 0) thenIconType:=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;   

procedureTForm1.Button1Click(Sender: TObject);
begin
CreateBox(TButton(form1.FindComponent(cbb1.Text)).Handle,'处理群内陌生人问题','你好');
end;

procedureTForm1.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'

是一个记录（Record），保存了矩形的（左上角右下角两个点）4个坐标或2个点的值。

转载自 http://wapapp.baidu.com/_n_iu/item/d259a881ff25905e27ebd961