 {
 ****************************************************************************
 CRW32 project
 Copyright (C) by Kuryakin Alexey, Sarov, Russia, 2004, <kouriakine@mail.ru>
 Minimize program to system tray.
 Modified:
  20040424 - Create & test
  20080402 - UpdateIcon
 ****************************************************************************
 }

unit _SysTray;

{$I _sysdef}

interface

uses sysutils, windows, messages, shellapi, Forms, _alloc, _str, _fio, _oneinst, _stdapp;

type
 TSysTray=class(TMasterObject)
 private
  myTrayData : TNotifyIconData;
  myTrayIcon : Boolean;
  myTrayHook : Boolean;
  function  AppWindowHook(var M:TMessage):Boolean;
  function  GetTrayIcon:Boolean;
  procedure SetTrayIcon(isIcon:Boolean);
  function  GetTrayHook:Boolean;
  procedure SetTrayHook(isHook:Boolean);
 public
  constructor Create;
  destructor  Destroy; override;
  property    TrayIcon:Boolean read GetTrayIcon write SetTrayIcon;
  property    TrayHook:Boolean read GetTrayHook write SetTrayHook;
  procedure   UpdateIcon;
 end;

function SysTray:TSysTray;

procedure UsesSysTray;

const
 sig_TRIC =  $43495254;  // 'TRIC' signature to identify Tray Icon message

implementation

constructor TSysTray.Create;
begin
 inherited Create;
 FillChar(myTrayData,sizeof(myTrayData),0);
 myTrayIcon:=false;
 myTrayHook:=false;
end;

destructor  TSysTray.Destroy;
begin
 TrayIcon:=false;
 TrayHook:=false;
 inherited Destroy;
end;

function TSysTray.AppWindowHook(var M: TMessage): Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  if (M.Msg=OneInstance.UniqueAppMessage) and (Cardinal(M.WParam)=sig_TRIC) then
  case M.LParam of
   WM_LBUTTONDOWN:
    begin
     Result:=True;
     OneInstance.RestoreApplication(true);
    end;
  end;
  case M.Msg of
   WM_SYSCOMMAND:
    case M.wParam of
     SC_MINIMIZE:
      begin
       if Assigned(Application.MainForm) then Application.MainForm.Hide;
       ShowWindow(Application.Handle,SW_HIDE);
       TrayIcon:=true;
       Result:=true;
      end;
    end;
   WM_DESTROY:
    begin
     TrayIcon:=false;
     TrayHook:=false;
    end;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function  TSysTray.GetTrayIcon:Boolean;
begin
 if Assigned(Self) then Result:=myTrayIcon else Result:=false;
end;

procedure TSysTray.SetTrayIcon(isIcon:Boolean);
Begin
 if Assigned(Self) then
 try
  if isIcon then begin
   if not myTrayIcon then begin
    myTrayData.cbSize:=SizeOf(myTrayData);
    myTrayData.Wnd:=Application.Handle;
    myTrayData.uID:=sig_TRIC;
    myTrayData.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
    myTrayData.uCallBackMessage:=OneInstance.UniqueAppMessage;
    myTrayData.hIcon:=Application.Icon.Handle;
    StrLCopy(myTrayData.szTip,PChar(Application.Title),SizeOf(myTrayData.szTip)-1);
    if Shell_NotifyIcon(NIM_ADD,@myTrayData) then begin
     ShowWindow(Application.Handle,SW_HIDE);
     myTrayIcon:=True;
    end;
   end;
  end else begin
   if myTrayIcon then begin
    if Shell_NotifyIcon(NIM_DELETE,@myTrayData) then begin
     ShowWindow(Application.Handle,SW_SHOW);
     myTrayIcon:=False;
    end;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

procedure TSysTray.UpdateIcon;
Begin
 if Assigned(Self) then
 try
  if myTrayIcon then begin
   myTrayData.hIcon:=Application.Icon.Handle;
   Shell_NotifyIcon(NIM_MODIFY,@myTrayData);
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

function  TSysTray.GetTrayHook:Boolean;
begin
 if Assigned(Self) then Result:=myTrayHook else Result:=false;
end;

procedure TSysTray.SetTrayHook(isHook:Boolean);
Begin
 if Assigned(Self) then
 try
  if isHook then begin
   if not myTrayHook then begin
    Application.HookMainWindow(AppWindowHook);
    myTrayHook:=true;
   end;
  end else begin
   if myTrayHook then begin
    Application.UnhookMainWindow(AppWindowHook);
    myTrayHook:=false;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self);
 end;
end;

procedure InitSysTray;
begin
 SysTray.TrayHook:=true;
 SysTray.TrayIcon:=true;
end;

procedure DoneSysTray;
begin
 SysTray.TrayIcon:=false;
 SysTray.TrayHook:=false;
end;

const
 TheSysTray : TSysTray = nil;

function SysTray:TSysTray;
begin
 if not Assigned(TheSysTray) then
 try
  TheSysTray:=TSysTray.Create;
  TheSysTray.Master:=TheSysTray;
 except
  on E:Exception do BugReport(E);
 end;
 Result:=TheSysTray;
end;

procedure UsesSysTray;
begin
 InitSubSystems.Add(InitSysTray);
 DoneSubSystems.Add(DoneSysTray);
end;

initialization

 SysTray;

finalization

 Kill(TObject(TheSysTray));

end.
