How to create a tray application that shows and hides the Desktop (Views: 29)
Problem/Question/Abstract: 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. unit DeskIcons; interface uses Graphics; {Definition of TColor} procedure SetDesktopIconColor(Forground, Background: TColor; Trans: Boolean); procedure SetDefaultIconColors; implementation uses Windows, CommCtrl; {Definition of HWND and ListView_XXXXX} procedure SetDesktopIconColor(Forground, Background: TColor; Trans: Boolean); {This procedure set's the desktop icon text color to a given color with the option to add a transparent background.} var Window: HWND; begin {Find the right window with 3 calls} Window := FindWindow('Progman', 'Program Manager'); {FindWindowEx is used to find a child window} Window := FindWindowEx(Window, HWND(nil), 'SHELLDLL_DefView', ''); {SysListView32 is the desktop icon list view} Window := FindWindowEx(Window, HWND(nil), 'SysListView32', ''); {Use the macro to set the background color to clear} if Trans then ListView_SetTextBkColor(Window, $FFFFFFFF) {back color} else ListView_SetTextBkColor(Window, Background); {back color} ListView_SetTextColor(Window, Forground); {foreground color} {now send a redraw to the icons to redraw the new color} ListView_RedrawItems(Window, 0, ListView_GetItemCount(Window) - 1); UpdateWindow(Window); {force the redraw to take effect immediately} end; procedure SetDefaultIconColors; {This set's the colors to be whatever is currently stored by windows} var Kind: Integer; Color: TColor; begin Kind := COLOR_DESKTOP; Color := GetSysColor(COLOR_DESKTOP); SetSysColors(1, Kind, Color); end; end. And now the program: program DeskPop; uses Windows, Messages, ShellAPI, sysutils, DeskIcons in 'DeskIcons.pas'; {$R *.RES} {$R ICONS.RES} const AppName = 'DeskTop Hide by Brian Slack'; var x: integer; tid: TNotifyIconData; WndClass: array[0..50] of char; procedure Panic(szMessage: PChar); begin if szMessage <> nil then MessageBox(0, szMessage, AppName, mb_ok); Halt(0); end; procedure HandleCommand(Wnd: hWnd; Cmd: Word); begin case Cmd of Ord('A'): MessageBox(0, 'Freeware Ninstall ©1999', AppName, mb_ok); Ord('E'): PostMessage(Wnd, WM_CLOSE, 0, 0); Ord('0'): SetDesktopIconColor($80000000, $C0C0C0, True); end; end; function DummyWindowProc(Wnd: hWnd; Msg, wParam: Word; lParam: LongInt): LongInt; stdcall; var TrayHandle: THandle; dc: hDC; {i: Integer;} pm: HMenu; pt: TPoint; begin DummyWindowProc := 0; StrPCopy(@WndClass[0], 'Progman'); TrayHandle := FindWindow(@WndClass[0], nil); case Msg of WM_CREATE: {Program initialisation - just set up a tray icon} begin tid.cbSize := sizeof(tid); tid.Wnd := Wnd; tid.uID := 1; tid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; tid.uCallBackMessage := WM_USER; tid.hIcon := LoadIcon(hInstance, 'MAINICON'); lstrcpy(tid.szTip, 'Desktop is on'); Shell_NotifyIcon(nim_Add, @tid); end; WM_DESTROY: begin Shell_NotifyIcon(nim_Delete, @tid); PostQuitMessage(0); ShowWindow(TrayHandle, SW_RESTORE); SetDefaultIconColors; end; WM_COMMAND: {Command notification} begin HandleCommand(Wnd, LoWord(wParam)); Exit; end; WM_USER: {Had a tray notification - see what to do} if (lParam = wm_LButtonDown) then begin if x = 0 then begin ShowWindow(TrayHandle, SW_HIDE); tid.hIcon := LoadIcon(hInstance, 'offICON'); lstrcpy(tid.szTip, 'Desktop is off'); Shell_NotifyIcon(NIM_MODIFY, @tid); x := 1 end else begin ShowWindow(TrayHandle, SW_RESTORE); tid.hIcon := LoadIcon(hInstance, 'ONICON'); lstrcpy(tid.szTip, 'Desktop is on'); Shell_NotifyIcon(NIM_MODIFY, @tid); x := 0; end; end else if (lParam = wm_RButtonDown) then begin GetCursorPos(pt); pm := CreatePopupMenu; AppendMenu(pm, 0, Ord('O'), 'Transparent Icons'); AppendMenu(pm, 0, Ord('A'), 'About DeskTop Hide...'); AppendMenu(pm, mf_Separator, 0, nil); AppendMenu(pm, 0, Ord('E'), 'Exit DeskTop Hide'); SetForegroundWindow(Wnd); dc := GetDC(0); if TrackPopupMenu(pm, tpm_BottomAlign or tpm_RightAlign, pt.x, GetDeviceCaps(dc, HORZRES) {pt.y}, 0, Wnd, nil) then SetForegroundWindow(Wnd); DestroyMenu(pm) end; end; DummyWindowProc := DefWindowProc(Wnd, Msg, wParam, lParam); end; procedure WinMain; var Wnd: hWnd; Msg: TMsg; cls: TWndClass; begin { Previous instance running ? If so, exit } if FindWindow(AppName, nil) <> 0 then Panic(AppName + ' is already running.'); { Register the window class } FillChar(cls, sizeof(cls), 0); cls.lpfnWndProc := @DummyWindowProc; cls.hInstance := hInstance; cls.lpszClassName := AppName; RegisterClass(cls); { Now create the dummy window } Wnd := CreateWindow(AppName, AppName, ws_OverlappedWindow, 4, 4, 4, 4, 0, 0, hInstance, nil); x := 0; if Wnd <> 0 then begin ShowWindow(Wnd, sw_Hide); while GetMessage(Msg, 0, 0, 0) do begin TranslateMessage(Msg); DispatchMessage(Msg); end; end; end; begin WinMain; end. |