{ Summary: System tray icon routines ## $Id: systray.pas,v 1.1 2004/04/14 21:33:02 druid Exp $ } unit systray; interface type GMenuCallBack = procedure(id : integer); procedure registerSysTray(); procedure unregisterSysTray(); procedure addMenuSeparator(); procedure registerMenuItem(const name : string; callback : GMenuCallBack); procedure unregisterMenuItem(const name : string); procedure initSysTray(); procedure cleanupSysTray(); implementation uses SysUtils, Windows, Classes, Messages, ShellAPI, Forms, dtypes, server, mudsystem, constants; const WM_TASKICON = WM_USER + 14; taskIconID = 10; type GSysTray = class private icon : TNotifyIconData; handle : HWND; procedure windowHandler(var msg : TMessage); procedure WMRButtonDown(var Mess: TMessage); message WM_RBUTTONDOWN; procedure WMCommand(var Mess : TMessage); message WM_COMMAND; procedure serverTick(); public constructor Create(); destructor Destroy; override; end; GMenuItem = class public id : integer; name : string; callback : GMenuCallBack; end; var sys : GSysTray; menuitems : GDLinkedList; menu : HMENU; procedure GSysTray.serverTick(); begin Application.ProcessMessages(); end; procedure GSysTray.windowHandler(var msg : TMessage); var TempMess: TMessage; begin msg.Result := 1; if (msg.WParam = taskIconID) then begin TempMess.Msg := msg.LParam; TempMess.WParam := msg.WParam; Dispatch(TempMess); end else Dispatch(msg); end; constructor GSysTray.Create(); begin inherited Create(); handle := AllocateHWnd(windowHandler); with icon do begin cbSize := SizeOf(TNotifyIconData); Wnd := handle; uID := taskIconID; uFlags := NIF_MESSAGE OR NIF_TIP OR NIF_ICON; uCallbackMessage := WM_TASKICON; hIcon := Application.Icon.Handle; szTip := version_info; end; Shell_NotifyIcon(NIM_ADD, @icon); end; destructor GSysTray.Destroy(); begin Shell_NotifyIcon(NIM_DELETE, @icon); DeAllocateHWnd(handle); inherited Destroy(); end; procedure GSysTray.WMRButtonDown(var Mess: TMessage); var coord : TPoint; begin SetForegroundWindow(handle); GetCursorPos(coord); TrackPopupMenu(menu, TPM_RIGHTBUTTON, coord.x, coord.y, 0, handle, nil); PostMessage(handle, WM_NULL, 0, 0); Mess.Result := 0; end; procedure GSysTray.WMCommand(var Mess : TMessage); var iterator : GIterator; item : GMenuItem; id : integer; begin id := LOWORD(Mess.WParam); iterator := menuitems.iterator(); while (iterator.hasNext()) do begin item := GMenuItem(iterator.next()); if (item.id = id) then begin item.callback(id); Mess.Result := 0; break; end; end; iterator.Free(); end; procedure registerSysTray(); var serverInstance : GServer; begin sys := GSysTray.Create(); serverInstance := GServer.Create(); serverInstance.OnTick := sys.serverTick; serverInstance.Free(); end; procedure unregisterSysTray(); begin sys.Free(); end; function getFreeMenuID() : integer; var iterator : GIterator; item : GMenuItem; id : integer; begin iterator := menuitems.iterator(); id := -1; while (iterator.hasNext()) do begin item := GMenuItem(iterator.next()); if (item.id > id) then id := item.id; end; iterator.Free(); Result := id + 1; end; procedure addMenuSeparator(); begin InsertMenu(menu, 0, MF_BYPOSITION or MF_SEPARATOR, 0, nil); end; procedure registerMenuItem(const name : string; callback : GMenuCallBack); var item : GMenuItem; begin item := GMenuItem.Create(); item.id := getFreeMenuID(); item.name := name; item.callback := callback; InsertMenu(menu, 0, MF_BYPOSITION or MF_ENABLED or MF_STRING, item.id, PChar(item.name)); menuitems.insertLast(item); end; procedure unregisterMenuItem(const name : string); var node : GListNode; item : GMenuItem; begin node := menuitems.head; while (node <> nil) do begin item := GMenuItem(node.element); if (item.name = name) then begin RemoveMenu(menu, item.id, MF_BYCOMMAND); menuitems.remove(node); item.Free(); break; end; node := node.next; end; end; procedure aboutProc(id : integer); begin MessageBox(0, version_info + ',' + version_number + '.'#13#10#13#10 + version_copyright + '.'#13#10#13#10 + 'This is free software, with ABSOLUTELY NO WARRANTY; view LICENSE.TXT.', 'About ' + version_info, MB_OK or MB_SETFOREGROUND); end; procedure copyoverProc(id : integer); var serverInstance : GServer; begin serverInstance := GServer.Create(); serverInstance.shutdown(SHUTDOWNTYPE_COPYOVER); serverInstance.Free(); end; procedure rebootProc(id : integer); var serverInstance : GServer; begin serverInstance := GServer.Create(); serverInstance.shutdown(SHUTDOWNTYPE_REBOOT); serverInstance.Free(); end; procedure shutdownProc(id : integer); var serverInstance : GServer; begin serverInstance := GServer.Create(); serverInstance.shutdown(SHUTDOWNTYPE_HALT); serverInstance.Free(); end; procedure initSysTray(); begin menu := CreatePopupMenu(); menuitems := GDLinkedList.Create(); registerMenuItem('Shutdown', shutdownProc); registerMenuItem('Reboot', rebootProc); registerMenuItem('Copyover', copyoverProc); addMenuSeparator(); registerMenuItem('About', aboutProc); addMenuSeparator(); end; procedure cleanupSysTray(); begin DestroyMenu(menu); menuitems.clear(); menuitems.Free(); end; end.