{******************************************************************************* 单元名称: CslHint.pas 单元说明: 美化系统Hint提示界面。 控件版本: 1.0 调用示例: Application.ShowHint := False; HintWindowClass := TCslHintWindow; Application.HintPause := 0; Application.HintHidePause := 60000; Application.ShowHint := True; 作者时间: Chenshilong, 2014-12-23 *******************************************************************************} unit CslHint; interface uses Windows, Messages, Classes, Controls, Forms, CommCtrl, Graphics; const G_Hint_Titel = '计量支付'; G_Hint_BackColor: Integer = $00BBFFBB; G_Hint_FontColor: Integer = clBlack; G_Hint_ShowTime: Integer = 60; // 显示时长,单位秒 type TCslHintWindow = class(THintWindow) private FLastActive: THandle; public procedure ActivateHint(Rect: TRect; const AHint: string); override; end; implementation procedure TCslHintWindow.ActivateHint(Rect: TRect; const AHint: string); procedure AddTipTool(hWnd: DWORD; IconType: Integer; ATitle, AText: PChar); const TTS_BALLOON = $0040; 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.uFlags := TTF_IDISHWND or TTF_SUBCLASS or TTF_TRANSPARENT; ToolInfo.uId := hWnd; ToolInfo.lpszText := AText; SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ToolInfo)); SendMessage(hWndTip, TTM_SETTIPBKCOLOR, G_Hint_BackColor, 0); //设置背景色 SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, G_Hint_FontColor, 0); //设置字体颜色 SendMessage(hWndTip, TTM_SETTITLE, 1, Integer(ATitle)); end; InitCommonControls(); end; begin if FLastActive <> WindowFromPoint(Mouse.CursorPos) then AddTipTool(WindowFromPoint(Mouse.CursorPos), 1, PAnsiChar(G_Hint_Titel), PChar(AHint)); FLastActive := WindowFromPoint(Mouse.CursorPos); end; end.