{************* FREEWARE ******************}
{****************************************************}
{************* copyright (c) ******************}
{************* Alexander Rodigin ******************}
{************* ras@ras.udm.ru ******************}
{************* May 6 1999 Russia ******************}
{*****************************************************
TrayComponent is a mix of two components:
Stealth by Janus N. Tшndering 1998
[j@nus.person.dk]
with thanks to...
Eric Lawrence [deltagrp@juno.com]
John Molyneux [jaymol@hotmail.com]
copyright © Amigreen Software 1998
and
TrayIcon by Pete Ness
Compuserve ID: 102347,710
Internet: 102347.710@compuserve.com
http:\\ourworld.compuserve.com\homepages\peteness.
Some properties were modified.
Also some new properties were added :
1)ShowInTaskBar allow not to minimize the form onto TaskBar;
2)ShowForm allow completely hide the form from the user and Alt-Tab Menu;
3)RunMinimized disallow application's start-up in minimized state
because minimized form will appear onto Task Bar;
4)DefRClick and DefLClick activates the form if ShowForm = true
and no code assigned to these eventhandlers;
5)the Icon by default is the application's icon;
6)HideApp doesn't conflict with Windows NT now;

The first time you try TTrayComponent just put it onto the form and
run app to test default options.

Any changes,bugs and suggestions please report to ras@ras.udm.ru}

unit TrayComp;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, ShellAPI, Menus, Dialogs, CommCtrl;

const
WM_FROMTRAYICON = WM_USER+59;
WM_RESETTOOLTIP = WM_USER+61;

type
TTrayComp = class(TComponent)
private
{ Private declarations }
{ general }
FhWnd : hWnd;
FhLib : hInst;
{ for hiding }
FHideApp : Boolean;
FShowForm : Boolean;
FShowInTaskBar: Boolean;
FRunMinimized : Boolean;
OldWndProc : TFarProc;
NewWndProc : Pointer;
{ for icon }
IconData : TNOTIFYICONDATA;
FIcon : TIcon;
FToolTip : string;
FShowIcon : Boolean;
FPopupMenu : TPopupMenu;
FDefRClick : Boolean;
FDefLClick : Boolean;
FOnLeftClick : TNotifyEvent;
FOnRightClick : TMouseEvent;
FOnMouseMove : TNotifyEvent;
{ for hiding }
procedure SetHideApp(Value:Boolean);
procedure SetShowForm(Value:Boolean);
procedure SetShowInTaskBar(Value: Boolean);
procedure InsertHook;
procedure RemoveHook;
procedure OurWndProc(var M: TMessage);
{ for icon }
function PlaceIcon : Boolean;
function ReplaceIcon : Boolean;
function EraseIcon : Boolean;
procedure SetShowIcon(Value : Boolean);
procedure SetIcon(Value : TIcon);
procedure SetToolTip(Value : string);
procedure FillIconData;
procedure DoRightClick(Sender : TObject);
procedure DoLeftClick(Sender : TObject);
procedure DoMouseMove(Sender:TObject);
protected
{ Protected declarations }
{ for hiding }
procedure Loaded; override;
procedure DoHiding;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
{ for hiding }
property HideApp :Boolean read FHideApp write SetHideApp ;
property ShowForm :Boolean read FShowForm write SetShowForm default True;
property ShowInTaskBar:Boolean read FShowInTaskBar write SetShowInTaskBar default False;
property RunMinimized :Boolean read FRunMinimized write FRunMinimized default False;
{ for icon }
property ShowIcon : boolean read FShowIcon write SetShowIcon;
property Icon : TIcon read FIcon write SetIcon;
property ToolTip : string read FTooltip write SetToolTip;
property PopupMenu : TPopupMenu read fPopupMenu write fPopupMenu;
property DefRClick : Boolean read FDefRClick write FDefRClick default False;
property DefLClick : Boolean read FDefLClick write FDefLClick default True;
property OnLeftClick : TNotifyEvent read FOnLeftClick write FOnLeftClick;
property OnRightClick : TMouseEvent read FOnRightClick write FonRightClick;
property OnMouseMove : TNotifyEvent read FOnMouseMove write FOnMouseMove;
end;

procedure register;

implementation

constructor TTrayComp.Create(AOwner: TComponent);
var
i: Integer;
Already:Byte;
begin
inherited Create(AOwner);
{ for hiding }
FHideApp:=True;
FShowForm:=True;
FShowInTaskBar := False;
FRunMinimized:=False;
NewWndProc := nil;
OldWndProc := nil;
Already:=0;
if (csDesigning in ComponentState) then
if (AOwner is TForm) then
with (AOwner as TForm) do
begin
for i := 0 to ComponentCount - 1 do
if Components[i] is TTrayComp then
Inc(Already);
if Already>1 then
raise Exception.Create('You can''t create a second TTrayComp on the same form!');
end
else
raise Exception.Create('You can create a TTrayComp only on the form!');
{ for icon }
FIcon := TIcon.Create;
FShowIcon:=True;
FDefRClick:=False;
FDefLClick:=True;
if (csDesigning in ComponentState) then
SetIcon(Application.Icon);
end;

destructor TTrayComp.Destroy;
begin
{ for hiding }
RemoveHook;
{ for icon }
if not (csDesigning in ComponentState)then
if FShowIcon then
EraseIcon;
FIcon.Free;
inherited Destroy;
end;

procedure TTrayComp.Loaded;
begin
inherited Loaded;
FhWnd:=(Owner as TForm).Handle;
{ terminate if minimized not allowed }
if IsIconic(FhWnd)and not FRunMinimized then
Application.Terminate;
InsertHook;
{ hide the form at start-up if needed }
if not FShowForm then
begin
(Owner as TForm).Visible:=False;
Application.ShowMainForm:=False;
end;
end;

procedure TTrayComp.DoHiding;
begin
if not (csDesigning in ComponentState) then
if not FShowInTaskBar then
ShowWindow(FindWindow(nil, @Application.Title[1]), SW_HIDE);
end;

procedure TTrayComp.SetShowInTaskBar(Value:Boolean);
begin
FShowInTaskBar:=Value;
DoHiding;
end;

procedure TTrayComp.InsertHook;
begin
if Owner <> nil then
begin
OldWndProc := TFarProc(GetWindowLong(FhWnd, GWL_WNDPROC));
NewWndProc := MakeObjectInstance(OurWndProc);
SetWindowLong(FhWnd, GWL_WNDPROC,Integer(NewWndProc));
end;
end;

procedure TTrayComp.RemoveHook;
begin
if (Owner <> nil) and Assigned(OldWndProc) then
SetWindowLong(FhWnd, GWL_WNDPROC,Integer(OldWndProc));
if Assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);
NewWndProc := nil;
OldWndProc := nil;
end;

procedure TTrayComp.OurWndProc(var M: TMessage);
begin
if Owner <> nil then
case M.Msg of
WM_ACTIVATE:
if (M.WParamLo <> WA_INACTIVE) then
DoHiding;
WM_SYSCOMMAND:
if (M.WParam = SC_MINIMIZE)and not ShowInTaskBar then
begin
M.Msg:=WM_SHOWWINDOW;
M.WParam := SW_HIDE;
end;
WM_FROMTRAYICON:
begin
case M.LParam of
WM_LBUTTONUP : DoLeftClick(Self);
WM_RBUTTONUP : DoRightClick(Self);
WM_MOUSEMOVE : DoMouseMove(Self);
end;
Exit
end;
WM_RESETTOOLTIP:
begin
SetToolTip(FToolTip);
Exit
end
end;
M.Result := CallWindowProc(OldWndProc,FhWnd, M.Msg, M.WParam, M.LParam);
end;

procedure TTrayComp.SetHideApp(Value:Boolean);
type
Proc=procedure(PID,T:DWord); stdcall;
var
RegProc: Proc;
begin
if Value<>FHideApp then
FHideApp:=Value;
if not (csDesigning in ComponentState)then
begin
if FhLib=0 then
FhLib:=GetModuleHandle(PChar('kernel32.dll'));
if FhLib=0 then
Exit;
@RegProc:=GetProcAddress(FhLib,PChar('RegisterServiceProcess'));
if @RegProc<>nil then
begin
if Value then
RegProc(GetCurrentProcessID, 1)
else
RegProc(GetCurrentProcessID, 0);
end
else
FHideApp:=False;
end;
end;

procedure TTrayComp.SetShowForm(Value:Boolean);
begin
if not (csDesigning in ComponentState)then
if Value then
ShowWindow(FhWnd,SW_SHOW)
else
ShowWindow(FhWnd,SW_HIDE);
if Value and not(Owner as TForm).Visible then
(Owner as TForm).Visible:=True;
if FShowForm<>Value then
FShowForm:=Value;
DoHiding;
end;

procedure TTrayComp.FillIconData;
begin
with IconData do
begin
cbSize := sizeof(TNOTIFYICONDATA);
wnd := (Owner as TForm).Handle;
uID := 0;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
hIcon := FIcon.Handle;
StrPCopy(szTip,FToolTip);
uCallbackMessage := WM_FROMTRAYICON;
end;
end;

procedure TTrayComp.SetToolTip(Value:string);
begin
// This routine ALWAYS re-sets the field value and re-loads the
// icon. This is so the ToolTip can be set blank when the component
// is first loaded. If this is changed, the icon will be blank on
// the tray when no ToolTip is specified.
if Length( Value ) > 62 then
Value := Copy(Value,1,62);
FToolTip := Value;
ReplaceIcon;
end;

function TTrayComp.PlaceIcon:Boolean;
begin
FillIconData;
Result := Shell_NotifyIcon(NIM_ADD,@IconData);
// For some reason, if there is no tool tip set up, then the icon
// doesn't display. This fixes that.
if FToolTip = '' then
PostMessage( (Owner as TForm).Handle, WM_RESETTOOLTIP,0,0 );
end;

function TTrayComp.ReplaceIcon:Boolean;
begin
FillIconData;
if FShowIcon then
Result := Shell_NotifyIcon(NIM_MODIFY,@IconData)
else
Result := True;
end;

function TTrayComp.EraseIcon:Boolean;
begin
Result := Shell_NotifyIcon(NIM_DELETE,@IconData);
end;

procedure TTrayComp.SetShowIcon(Value:Boolean);
begin
if not (csdesigning in ComponentState) then
begin
if Value then
PlaceIcon
else
EraseIcon
end;
if Value <> FShowIcon then
FShowIcon:=Value;
end;

procedure TTrayComp.SetIcon(Value:TIcon);
begin
if Value <> FIcon then
begin
FIcon.Assign(Value);
ReplaceIcon;
end;
end;

procedure TTrayComp.DoRightClick(Sender:TObject);
var
Coord: TPoint;
begin
GetCursorPos(Coord);
if Assigned( FOnRightClick ) then
FOnRightClick(Self,mbRight,[],Coord.X,Coord.Y)
else
if FDefRClick and FShowForm then
begin
ShowWindow(FhWnd,SW_SHOW);
SetActiveWindow(FhWnd);
end;
if Assigned(FPopupMenu) then
begin
SetActiveWindow((Owner as TForm).Handle);
FPopupMenu.PopUp(Coord.X,Coord.Y);
end
end;

procedure TTrayComp.DoLeftClick(Sender : TObject);
begin
if Assigned(FOnLeftClick)then
FOnLeftClick(Self)
else
if DefLClick and FShowForm then
begin
ShowWindow(FhWnd,SW_SHOW);
SetActiveWindow(FhWnd);
end;
end;

procedure TTrayComp.DoMouseMove(Sender : TObject);
begin
if Assigned(FOnMouseMove)then
FOnMouseMove(Self)
end;

procedure register;
begin
RegisterComponents('RAS', [TTrayComp]);
end;

end.