Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to create a tray application that shows and hides the Desktop Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
03-Oct-02
Category
System
Language
Delphi 2.x
Views
77
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC