本文整理自网络,侵删。
unit uHintWin;
interfaceuses 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.
相关阅读 >>
Delphi 多核机器上编程实现将指定进程pid放到指定cpu上运行
Delphi �c 使用createoleobject后释放olevariant
更多相关阅读请进入《Delphi》频道 >>