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;                                                           

展开阅读全文

没有更多推荐了,返回首页