CslHint.pas 2.2 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879
  1. {*******************************************************************************
  2. 单元名称: CslHint.pas
  3. 单元说明: 美化系统Hint提示界面。
  4. 控件版本: 1.0
  5. 调用示例: Application.ShowHint := False;
  6. HintWindowClass := TCslHintWindow;
  7. Application.HintPause := 0;
  8. Application.HintHidePause := 60000;
  9. Application.ShowHint := True;
  10. 作者时间: Chenshilong, 2014-12-23
  11. *******************************************************************************}
  12. unit CslHint;
  13. interface
  14. uses
  15. Windows, Messages, Classes, Controls, Forms, CommCtrl, Graphics;
  16. const
  17. G_Hint_Titel = '计量支付';
  18. G_Hint_BackColor: Integer = $00BBFFBB;
  19. G_Hint_FontColor: Integer = clBlack;
  20. G_Hint_ShowTime: Integer = 60; // 显示时长,单位秒
  21. type
  22. TCslHintWindow = class(THintWindow)
  23. private
  24. FLastActive: THandle;
  25. public
  26. procedure ActivateHint(Rect: TRect; const AHint: string); override;
  27. end;
  28. implementation
  29. procedure TCslHintWindow.ActivateHint(Rect: TRect; const AHint: string);
  30. procedure AddTipTool(hWnd: DWORD; IconType: Integer; ATitle, AText: PChar);
  31. const
  32. TTS_BALLOON = $0040;
  33. TTM_SETTITLE = WM_USER + 32;
  34. var
  35. hWndTip: DWORD;
  36. ToolInfo: TToolInfo;
  37. begin
  38. hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
  39. WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
  40. 0, 0, 0, 0, hWnd, 0, HInstance, nil);
  41. if (hWndTip <> 0) then
  42. begin
  43. ToolInfo.cbSize := SizeOf(ToolInfo);
  44. ToolInfo.uFlags := TTF_IDISHWND or TTF_SUBCLASS or TTF_TRANSPARENT;
  45. ToolInfo.uId := hWnd;
  46. ToolInfo.lpszText := AText;
  47. SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ToolInfo));
  48. SendMessage(hWndTip, TTM_SETTIPBKCOLOR, G_Hint_BackColor, 0); //设置背景色
  49. SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, G_Hint_FontColor, 0); //设置字体颜色
  50. SendMessage(hWndTip, TTM_SETTITLE, 1, Integer(ATitle));
  51. end;
  52. InitCommonControls();
  53. end;
  54. begin
  55. if FLastActive <> WindowFromPoint(Mouse.CursorPos) then
  56. AddTipTool(WindowFromPoint(Mouse.CursorPos), 1, PAnsiChar(G_Hint_Titel), PChar(AHint));
  57. FLastActive := WindowFromPoint(Mouse.CursorPos);
  58. end;
  59. end.