source: components/CoolTrayIcon/demos/CustomHint1/Main.pas

Last change on this file was 1, checked in by maron, 16 years ago

3.1 verze, první revize

File size: 2.5 KB
Line 
1unit Main;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, ImgList, CoolTrayIcon, Menus;
8
9type
10 TForm1 = class(TForm)
11 CoolTrayIcon1: TCoolTrayIcon;
12 PopupMenu1: TPopupMenu;
13 Exit1: TMenuItem;
14 Label1: TLabel;
15 Button1: TButton;
16 Label2: TLabel;
17 procedure FormCreate(Sender: TObject);
18 procedure FormDestroy(Sender: TObject);
19 procedure Loaded; override;
20 procedure CoolTrayIcon1MouseEnter(Sender: TObject);
21 procedure CoolTrayIcon1MouseExit(Sender: TObject);
22 procedure Exit1Click(Sender: TObject);
23 procedure Button1Click(Sender: TObject);
24 private
25 HTooltip: HWND;
26 CustomFont: TFont;
27 BackColor, TextColor: COLORREF;
28 end;
29
30var
31 Form1: TForm1;
32
33implementation
34
35{$R *.DFM}
36
37const
38 // Tooltip constants
39 TTM_SETMAXTIPWIDTH = (WM_USER + 24);
40 TTM_SETTIPBKCOLOR = (WM_USER + 19);
41 TTM_SETTIPTEXTCOLOR = (WM_USER + 20);
42 TTM_SETTITLEA = (WM_USER + 32);
43
44procedure TForm1.FormCreate(Sender: TObject);
45begin
46 CustomFont := TFont.Create;
47 CustomFont.Size := 14;
48 CustomFont.Name := 'Verdana';
49 BackColor := RGB(0, 0, 255);
50 TextColor := RGB(255, 255, 0);
51end;
52
53
54procedure TForm1.FormDestroy(Sender: TObject);
55begin
56 CustomFont.Free;
57end;
58
59
60procedure TForm1.Loaded;
61begin
62 inherited;
63 HTooltip := CoolTrayIcon1.GetTooltipHandle;
64end;
65
66
67procedure TForm1.CoolTrayIcon1MouseEnter(Sender: TObject);
68begin
69 if HTooltip = 0 then
70 Exit;
71 // Set colors
72 SendMessage(HTooltip, TTM_SETTIPBKCOLOR, BackColor, 0);
73 SendMessage(HTooltip, TTM_SETTIPTEXTCOLOR, TextColor, 0);
74 // Set max width
75// SendMessage(HTooltip, TTM_SETMAXTIPWIDTH, 0, 999); //???
76 // Set font
77 SendMessage(HTooltip, WM_SETFONT, CustomFont.Handle, 0);
78end;
79
80
81procedure TForm1.CoolTrayIcon1MouseExit(Sender: TObject);
82begin
83 if HTooltip = 0 then
84 Exit;
85 // Close tooltip immediately (by moving it off-screen)
86 SetWindowPos(HTooltip, 0, -500, -500, 0, 0, SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOSIZE);
87 // Reset tooltip properties to defaults
88 SendMessage(HTooltip, TTM_SETMAXTIPWIDTH, 0, -1);
89 SendMessage(HTooltip, WM_SETFONT, 0, 0);
90 SendMessage(HTooltip, TTM_SETTIPBKCOLOR, GetSysColor(COLOR_INFOBK), 0);
91 SendMessage(HTooltip, TTM_SETTIPTEXTCOLOR, GetSysColor(COLOR_INFOTEXT), 0);
92end;
93
94
95procedure TForm1.Exit1Click(Sender: TObject);
96begin
97 Close;
98end;
99
100
101procedure TForm1.Button1Click(Sender: TObject);
102begin
103 Exit1Click(Self);
104end;
105
106end.
107
Note: See TracBrowser for help on using the repository browser.