//****************************************************************** //作 者:js0001 //描 述:气泡信息提示 V1.0 //发布日期:2009/3/19 //****************************************************************** unit Hint; interface uses Windows, Classes, Types, Graphics, Controls, Forms, ShellAPI; const //Windows API HWND_TOPMOST: LongInt = -1; SWP_NOSIZE = $1; SWP_NOMOVE = $2; SWP_NOACTIVATE = $10; WM_USER = $400; CW_USEDEFAULT = $80000000; //Tooltips Window TTF_TRANSPARENT = $100; TTF_CENTERTIP = $2;//居中 TTF_SUBCLASS = $10;//初始 TTM_ADDTOOLA = (WM_USER + 4);//添加Tooltips TTM_ACTIVATE = WM_USER + 1; TTM_SETDELAYTIME = (WM_USER + 3); //设置Tooltip时间 TTM_UPDATETIPTEXTA = (WM_USER + 12); TTM_SETMAXTIPWIDTH = (WM_USER + 24);//设置最大宽度 TTM_SETTIPBKCOLOR = (WM_USER + 19);//设置背景颜色 TTM_SETTIPTEXTCOLOR = (WM_USER + 20);//设置文本颜色 TTM_SETTITLE = (WM_USER + 32);//设置标题 TTS_BALLOON = $40; //气球(如果不要则是普通矩形窗口) TTS_ALWAYSTIP = $1;//永久 TTS_NOPREFIX = $2; TTS_CLOSE = $80; //关闭按钮 TOOLTIPS_CLASSA = 'tooltips_class32';//类名 type IconType = (None = 0, //无图标 Information = 1, //错误 Warning = 2, //询问 Error = 3 //警告 );//枚举图标类型 HintStyle =(Standard = 0, //标准型 Balloon =1 //气球型 );//枚举气泡提示风格 type TOOLINFO = packed record//气泡提示参数 hSize: Longint; hFlags: Longint; hHwnd: Longint; hId: Longint; hRect: TRECT; hHInstance: Longint; lpszText: String; lParam: Longint; end; TToolTips = class(TComponent) public Title: String; //标题 Text: String; //内容 BackColor: TColor; //背景色 TextColor: TColor; //文本色 Icon: IconType; //图标类型 Style: HintStyle; //气泡风格 constructor Create(AOwner: TComponent);virtual;//构造函数 destructor Destroy; override;//析构函数 end; var TipHwnd: Longint; //ToolTip句柄 implementation uses MainForm; constructor TToolTips.Create(AOwner: TComponent);//构造函数 var lpRect: TRECT; lWinStyle: LongInt; lpToolInfo: TOOLINFO; begin if TipHwnd <> 0 then begin DestroyWindow(TipHwnd); end; MainForm.ApplyDemoValues(self); lWinStyle:=TTS_ALWAYSTIP Or TTS_NOPREFIX; //创建气球风格 if Style = Balloon Then lWinStyle:=lWinStyle Or TTS_BALLOON; //必须有明确的父控件 if AOwner is TWinControl Then begin//存在父控件 //创建窗口 TipHwnd:=CreateWindowEx(0, //窗口的扩展风格 TOOLTIPS_CLASSA, //注册窗口类的名称 nil, //窗口标题名 lWinStyle, //窗口的风格 CW_USEDEFAULT, //窗口默认的水平位置 CW_USEDEFAULT, //窗口默认的垂直位置 CW_USEDEFAULT, //窗口默认的宽度 CW_USEDEFAULT, //窗口默认的高度 (AOwner as TWinControl).Handle, //父窗口的句柄 0, //窗口的菜单句柄 HInstance, //程序实例句柄(注:Delphi中HInstance是全局变量可直接使用) nil); //窗体附加信息 //显示提示窗口 SetWindowPos(TipHwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE); //获取父窗口区域 GetClientRect((AOwner as TWinControl).Handle, lpRect); //设置TOOLINFO的具体参数 With lpToolInfo do begin hSize := SizeOf(lpToolInfo); //大小 //设置样式 hFlags:=TTF_SUBCLASS; hHwnd:=(AOwner as TWinControl).Handle;//句柄 hId:=0;//hId为空 hHInstance:=hInstance;//句柄实例 hRect:=lpRect; lpszText:=Text;//提示内容 end; //SendMessage函数在使用时,它的第4个参数接收的是Longint型数值, //所有对于一些变量或常量需要传递的是它的地址的Longint型数值 //添加气泡提示结构体 SendMessage(TipHwnd, TTM_ADDTOOLA, 0, Longint(@lpToolInfo)); //设置标题或图标 if (Title <> '') Or (Icon <> None) then SendMessage(TipHwnd, TTM_SETTITLE, Longint(Icon), Longint(PChar(Title))); //文字颜色 if TextColor <> 0 then SendMessage(TipHwnd, TTM_SETTIPTEXTCOLOR, Longint(TextColor), 0); //背景颜色 if BackColor <> 0 Then SendMessage(TipHwnd, TTM_SETTIPBKCOLOR, Longint(BackColor), 0); end;//存在父控件 end; destructor TToolTips.Destroy;//析构函数 begin if TipHwnd <> 0 then begin DestroyWindow(TipHwnd); end; inherited Destroy; end; end.