program DeskPop;
uses
Windows, Messages, ShellAPI, SysUtils;
{$R *.RES}
{$R ICONS.RES}
const
AppName = '
DeskTop Hide';
var
x: Integer;
NID: 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 brian.slack@strath.ac.uk 1997', AppName, MB_OK);
Ord('
E'):
PostMessage(Wnd, WM_CLOSE, 0, 0);
end;
end;
function DummyWindowProc(Wnd: HWND; Msg, wParam: Word; lParam: LongInt): LongInt;
stdcall;
var
TrayHandle: THandle;
DC: HDC;
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
NID.cbSize := SizeOf(NID);
NID.Wnd := Wnd;
NID.uID := 1;
NID.uFlags := NIF_MESSAGE
or NIF_ICON
or NIF_TIP;
NID.uCallBackMessage := WM_USER;
NID.hIcon := LoadIcon(hInstance, '
MAINICON');
lstrcpy(NID.szTip, '
Desktop is on');
Shell_NotifyIcon(NIM_ADD, @NID);
end;
WM_DESTROY:
begin
Shell_NotifyIcon(nim_Delete, @NID);
PostQuitMessage(0);
ShowWindow(TrayHandle, SW_RESTORE);
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);
NID.hIcon := LoadIcon(hInstance, '
offICON');
lstrcpy(NID.szTip, '
Desktop is off');
Shell_NotifyIcon(NIM_MODIFY, @NID);
x := 1
end
else
begin
ShowWindow(TrayHandle, SW_RESTORE);
NID.hIcon := LoadIcon(hInstance, '
ONICON');
lstrcpy(NID.szTip, '
Desktop is on');
Shell_NotifyIcon(NIM_MODIFY, @NID);
x := 0;
end;
end
else if (lParam = wm_RButtonDown)
then
begin
GetCursorPos(Pt);
PM := CreatePopupMenu;
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, CW_USEDEFAULT, CW_USEDEFAULT,
CW_USEDEFAULT, CW_USEDEFAULT, 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.