Author: Jonas Bilinkevicius
How to create a tray application that shows and hides the Desktop
Answer:
Here is code for a small tray app that shows and hides the desktop. It has hint
activation.
1 unit DeskIcons;
2
3 interface
4
5 uses
6 Graphics; {Definition of TColor}
7
8 procedure SetDesktopIconColor(Forground, Background: TColor; Trans: Boolean);
9 procedure SetDefaultIconColors;
10
11 implementation
12
13 uses
14 Windows, CommCtrl; {Definition of HWND and ListView_XXXXX}
15
16 procedure SetDesktopIconColor(Forground, Background: TColor; Trans: Boolean);
17 {This procedure set's the desktop icon text color to a given color with the option
18 to add a
19 transparent background.}
20 var
21 Window: HWND;
22 begin
23 {Find the right window with 3 calls}
24 Window := FindWindow('Progman', 'Program Manager');
25 {FindWindowEx is used to find a child window}
26 Window := FindWindowEx(Window, HWND(nil), 'SHELLDLL_DefView', '');
27 {SysListView32 is the desktop icon list view}
28 Window := FindWindowEx(Window, HWND(nil), 'SysListView32', '');
29 {Use the macro to set the background color to clear}
30 if Trans then
31 ListView_SetTextBkColor(Window, $FFFFFFFF) {back color}
32 else
33 ListView_SetTextBkColor(Window, Background); {back color}
34 ListView_SetTextColor(Window, Forground); {foreground color}
35 {now send a redraw to the icons to redraw the new color}
36 ListView_RedrawItems(Window, 0, ListView_GetItemCount(Window) - 1);
37 UpdateWindow(Window); {force the redraw to take effect immediately}
38 end;
39
40 procedure SetDefaultIconColors;
41 {This set's the colors to be whatever is currently stored by windows}
42 var
43 Kind: Integer;
44 Color: TColor;
45 begin
46 Kind := COLOR_DESKTOP;
47 Color := GetSysColor(COLOR_DESKTOP);
48 SetSysColors(1, Kind, Color);
49 end;
50
51 end.
52
53 //And now the program:
54
55 program DeskPop;
56
57 uses
58 Windows, Messages, ShellAPI, sysutils, DeskIcons in 'DeskIcons.pas';
59
60 {$R *.RES}
61 {$R ICONS.RES}
62
63 const
64 AppName = 'DeskTop Hide by Brian Slack';
65
66 var
67 x: integer;
68 tid: TNotifyIconData;
69 WndClass: array[0..50] of char;
70
71 procedure Panic(szMessage: PChar);
72 begin
73 if szMessage <> nil then
74 MessageBox(0, szMessage, AppName, mb_ok);
75 Halt(0);
76 end;
77
78 procedure HandleCommand(Wnd: hWnd; Cmd: Word);
79 begin
80 case Cmd of
81 Ord('A'): MessageBox(0, 'Freeware Ninstall ©1999', AppName, mb_ok);
82 Ord('E'): PostMessage(Wnd, WM_CLOSE, 0, 0);
83 Ord('0'): SetDesktopIconColor($80000000, $C0C0C0, True);
84 end;
85 end;
86
87 function DummyWindowProc(Wnd: hWnd; Msg, wParam: Word; lParam: LongInt): LongInt;
88 stdcall;
89 var
90 TrayHandle: THandle;
91 dc: hDC;
92 {i: Integer;}
93 pm: HMenu;
94 pt: TPoint;
95 begin
96 DummyWindowProc := 0;
97 StrPCopy(@WndClass[0], 'Progman');
98 TrayHandle := FindWindow(@WndClass[0], nil);
99 case Msg of
100 WM_CREATE: {Program initialisation - just set up a tray icon}
101 begin
102 tid.cbSize := sizeof(tid);
103 tid.Wnd := Wnd;
104 tid.uID := 1;
105 tid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
106 tid.uCallBackMessage := WM_USER;
107 tid.hIcon := LoadIcon(hInstance, 'MAINICON');
108 lstrcpy(tid.szTip, 'Desktop is on');
109 Shell_NotifyIcon(nim_Add, @tid);
110 end;
111 WM_DESTROY:
112 begin
113 Shell_NotifyIcon(nim_Delete, @tid);
114 PostQuitMessage(0);
115 ShowWindow(TrayHandle, SW_RESTORE);
116 SetDefaultIconColors;
117 end;
118 WM_COMMAND: {Command notification}
119 begin
120 HandleCommand(Wnd, LoWord(wParam));
121 Exit;
122 end;
123 WM_USER: {Had a tray notification - see what to do}
124 if (lParam = wm_LButtonDown) then
125 begin
126 if x = 0 then
127 begin
128 ShowWindow(TrayHandle, SW_HIDE);
129 tid.hIcon := LoadIcon(hInstance, 'offICON');
130 lstrcpy(tid.szTip, 'Desktop is off');
131 Shell_NotifyIcon(NIM_MODIFY, @tid);
132 x := 1
133 end
134 else
135 begin
136 ShowWindow(TrayHandle, SW_RESTORE);
137 tid.hIcon := LoadIcon(hInstance, 'ONICON');
138 lstrcpy(tid.szTip, 'Desktop is on');
139 Shell_NotifyIcon(NIM_MODIFY, @tid);
140 x := 0;
141 end;
142 end
143 else if (lParam = wm_RButtonDown) then
144 begin
145 GetCursorPos(pt);
146 pm := CreatePopupMenu;
147 AppendMenu(pm, 0, Ord('O'), 'Transparent Icons');
148 AppendMenu(pm, 0, Ord('A'), 'About DeskTop Hide...');
149 AppendMenu(pm, mf_Separator, 0, nil);
150 AppendMenu(pm, 0, Ord('E'), 'Exit DeskTop Hide');
151 SetForegroundWindow(Wnd);
152 dc := GetDC(0);
153 if TrackPopupMenu(pm, tpm_BottomAlign or tpm_RightAlign, pt.x,
154 GetDeviceCaps(dc, HORZRES) {pt.y}, 0, Wnd, nil) then
155 SetForegroundWindow(Wnd);
156 DestroyMenu(pm)
157 end;
158 end;
159 DummyWindowProc := DefWindowProc(Wnd, Msg, wParam, lParam);
160 end;
161
162 procedure WinMain;
163 var
164 Wnd: hWnd;
165 Msg: TMsg;
166 cls: TWndClass;
167 begin
168 { Previous instance running ? If so, exit }
169 if FindWindow(AppName, nil) <> 0 then
170 Panic(AppName + ' is already running.');
171 { Register the window class }
172 FillChar(cls, sizeof(cls), 0);
173 cls.lpfnWndProc := @DummyWindowProc;
174 cls.hInstance := hInstance;
175 cls.lpszClassName := AppName;
176 RegisterClass(cls);
177 { Now create the dummy window }
178 Wnd := CreateWindow(AppName, AppName, ws_OverlappedWindow, 4, 4, 4, 4, 0, 0,
179 hInstance, nil);
180 x := 0;
181 if Wnd <> 0 then
182 begin
183 ShowWindow(Wnd, sw_Hide);
184 while GetMessage(Msg, 0, 0, 0) do
185 begin
186 TranslateMessage(Msg);
187 DispatchMessage(Msg);
188 end;
189 end;
190 end;
191
192 begin
193 WinMain;
194
195 end.
|
