Code:

{** Building a multi screen emulator ***

I want to present a simple multi-screen emulator written in Delphi.

It consists in a little Form placing in the bottom-right corner of the screen,

right above the traybar, which consists of 5 buttons.

At the beginning the first button is down; then, when I press another button,

a new fresh desktop is opened. In this new desktop I can open other programs

and so on with the other buttons. When I go back to one of the buttons,

I will see only the applications opened in that contest without the others.

The trick is to make the following steps just before pressing another button:

1)Get the handles of all the visible windows (except for Desktop,

Taskbar and the application itself)

2)Hiding all the windows detecting at step 1).

After pressing the button we must:

1)Show all the windows whose handles we got when we left

   the button itself by pressing another.

   Of course if a button is pressed for the first time we have no

   handles so we will have a new fresh desktop.

I want to retrieve the handles of all the visible windows:

the key is a call to the "EnumWindows" procedure

passing as a parameter a callback function called for example "EnumWindowsProc".

This callback function must be of the following type:

}

function EnumWindowsProc(hWnd: HWND; lParam: LPARAM): Bool;

// The EnumWindows function is of type:

BOOL EnumWindows(

WNDENUMPROC lpEnumFunc, // pointer to callback function

    LPARAM lParam  // application-defined value

   );

{

I will call EnumWindows(@EnumWindowsProc, 0);

The "EnumWindows" function loop over all windows (visible or invisible):

for each window there is a call to the callback function

"EnumWindowsProc" wich must be implemented.

The first param "hWnd" is the handle of the current window.

A possible implementation of the "EnumWindowsProc" function may be the inserting

of every handle in a list.

According to our target we must insert in a list the handle of

the following windows:

1)Visible windows //(IsWindowVisible(hwnd) = True)

2)Not my application window

//var processed: DWORD;

//GetWindowThreadProcessID( hwnd, @processID );

//processID <> GetCurrentProcessID

3)Not the taskbar window //hWnd <> FindWindow('Shell_TrayWnd', Nil)

4)Not the desktop window //hWnd <> FindWindow('Progman', Nil)

}

// This is the code:

unit ProcessView;

interface

uses

Windows, Dialogs, SysUtils, Classes, ShellAPI, TLHelp32, Forms;

var

HandleList: TStringList;

function EnumWindowsProc(hWnd: HWND; lParam: lParam): Bool; stdcall;

procedure GetProcessList;

implementation

procedure GetProcessList;

var

i: integer;

begin

HandleList.Clear;

EnumWindows(@EnumWindowsProc, 0);

end;

function EnumWindowsProc(hWnd: HWND; lParam: lParam): Bool;

var

processID: DWORD;

begin

GetWindowThreadProcessID(hwnd, @processID);

if processID <> GetCurrentProcessID then

   if (hWnd <> FindWindow('Shell_TrayWnd', nil)) and

     (hWnd <> FindWindow('Progman', nil)) then

     if IsWindowVisible(hwnd) then

     begin

       HandleList.Add(IntToStr(HWnd));

       Result := True;

     end;

end;

initialization

HandleList := TStringList.Create;

finalization

HandleList.Free;

end.

Code:

{

In the main program I used a variable named Monitors of type

"array of TstringList" whose dimension is given by the number of buttons

(different monitors available) to keep in memory all the hanldes

associated with every button. Another variable named CurrentMonitor

keeps in memory the index of the actual monitor (the caption of the button).

This is the code:

}

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ProcessView,

StdCtrls, Buttons, abfComponents, Menus, ImgList, AppEvnts, TrayIcon;

type

TForm1 = class(TForm)

   //these are the buttons (1..5) to switch from a monitor to another ///

   SpeedButton1: TSpeedButton;

   SpeedButton2: TSpeedButton;

   SpeedButton3: TSpeedButton;

   SpeedButton4: TSpeedButton;

   SpeedButton5: TSpeedButton;

   ///////////////////////////////////////////////////////////////////////

   ImageList1: TImageList; //ImageList connected to the Popup menu

   PopupMenu1: TPopupMenu; //popup menu displayed by the trayicon

   //PopupMenu Items///////

   ShowApplication: TMenuItem; //Show the form

   HideApplication: TMenuItem; //Hide the form

   N1: TMenuItem; // -

   CloseApplication: TMenuItem; //Close the application

   ////////////////////////////////

   TrayIcon1: TTrayIcon; //my TrayIcon component; you can use yours

   procedure SpeedButton1Click(Sender: TObject);

   procedure FormCreate(Sender: TObject);

   procedure FormDestroy(Sender: TObject);

   procedure FormClose(Sender: TObject; var Action: TCloseAction);

   procedure FormShow(Sender: TObject);

   procedure ShowApplicationClick(Sender: TObject);

   //click on ShowApplication (TMenuItem)

   procedure HideApplicationClick(Sender: TObject);

   //click on HideApplication (TMenuItem)

   procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

   procedure CloseApplicationClick(Sender: TObject);

   //click on CloseApplication (TMenuItem)

private

   { Private declarations }

   Monitors: array[1..5] of TStringList;

   CurrentMonitor: Integer;

public

   { Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SpeedButton1Click(Sender: TObject);

var

i: integer;

Rect: TRect;

begin

//

GetProcessList;

Monitors[CurrentMonitor].Assign(HandleList);

for i := 0 to HandleList.Count - 1 do

begin

   ShowWindow(StrToInt(HandleList.Strings[i]), SW_HIDE);

end;

CurrentMonitor := StrToInt((Sender as TSpeedButton).Caption);

for i := 0 to Monitors[CurrentMonitor].Count - 1 do

begin

   ShowWindow(StrToInt(Monitors[CurrentMonitor].Strings[i]), SW_SHOW);

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

i: integer;

begin

//

ShowWindow(Application.Handle, SW_HIDE);

SetWindowLong(Application.Handle,

   GWL_EXSTYLE, GetWindowLong(Application.Handle, GWL_EXSTYLE) and

   not WS_EX_APPWINDOW or WS_EX_TOOLWINDOW);

ShowWindow(Application.Handle, SW_SHOW);

CurrentMonitor := 1;

for i := Low(Monitors) to High(Monitors) do

   Monitors[i] := TStringList.Create;

end;

procedure TForm1.FormDestroy(Sender: TObject);

var

i: integer;

begin

//

for i := Low(Monitors) to High(Monitors) do

   Monitors[i].Free;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

var

i, j: integer;

begin

for i := Low(Monitors) to High(Monitors) do

begin

   for j := 0 to Monitors[i].Count - 1 do

   begin

     ShowWindow(StrToInt(Monitors[i].Strings[j]), SW_SHOW);

   end;

end;

end;

procedure TForm1.FormShow(Sender: TObject);

begin

//

Height := 61;

Width  := 173;

Top := Screen.Height - Height - 30;

Left := Screen.Width - Width;

end;

procedure TForm1.ShowApplicationClick(Sender: TObject);

begin

//

Application.MainForm.Show;

end;

procedure TForm1.HideApplicationClick(Sender: TObject);

begin

//

Application.MainForm.Hide;

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

//

if MessageDlg('Do you want to close Monitors?', mtConfirmation,

   [mbOK, mbCancel], 0) = mrCancel then

   CanClose := False;

end;

procedure TForm1.CloseApplicationClick(Sender: TObject);

begin

Close;

end;

end.

Code:

{

In order to prevent multiple instances of the application I inserted

some lines of code inside the project source;

this is the modified source:

}

program Project1;

uses

Forms,

Windows,

Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

var

atom: integer;

begin

if GlobalFindAtom('Monitors_Procedure_Atom') = 0 then

   atom := GlobalAddAtom('Monitors_Procedure_Atom')

else

   Exit;

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.Run;

GlobalDeleteAtom(atom);

end.

Code:

{

The GlobalAddAtom function adds a character string to the global atom table

and returns a unique value (an atom) identifying the string.

The GlobalFindAtom function searches the global atom table for the

specified character string and retrieves the global atom associated with that string.

If I have already run the programm then the GlobalFindAtom function returns a value

<> 0 because the atom is already present: in this case I abort the execution of the program.

Instead, if the GlobalFindAtom function returns 0 then this is the first time I run the

program, so I create the atom. At the end I delete the atom.

In order to remove the button on the taskbar I inserted the following code

inside the OnCreate event of the form:

}

{...}

ShowWindow( Application.handle, SW_HIDE );

SetWindowLong( Application.handle,

              GWL_EXSTYLE,

              GetWindowLong( application.handle, GWL_EXSTYLE ) and

              not WS_EX_APPWINDOW or WS_EX_TOOLWINDOW);

ShowWindow( Application.handle, SW_SHOW );

{...}

{

In order to have a tray icon in the traybar (wich display a menu containing showing,

hiding and closing of the form), I used a component (TTrayIcon),

I built a year ago; this is the source:

}

unit TrayIcon;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  ShellAPI, extctrls, Menus;

const

    WM_SYSTEM_TRAY_NOTIFY = WM_USER + 1;

type TTrayIconMessage =(imClick, imDoubleClick, imMouseDown,

                       imMouseUp, imLeftClickUp, imLeftDoubleClick,

                       imRightClickUp, imRightDoubleClick, imNone);

type

TTrayIcon = class(TComponent)

private

   { Private declarations }

  FData: TNotifyIconData;

  FIsClicked: Boolean;

  FIcon: TIcon;

  FIconList: TImageList;

  FPopupMenu: TPopupMenu;

  FTimer: TTimer;

  FHint: string;

  FIconIndex: integer;

  FVisible: Boolean;

  FHide: Boolean;

  FAnimate: Boolean;

  FAppRestore: TTrayIconMessage;

  FPopupMenuShow: TTrayIconMessage;

  FApplicationHook: TWindowHook;

  FOnMinimize: TNotifyEvent;

  FOnRestore: TNotifyEvent;

  FOnMouseMove: TMouseMoveEvent;

  FOnMouseExit: TMouseMoveEvent;

  FOnMouseEnter: TMouseMoveEvent;

  FOnClick: TNotifyEvent;

  FOnDblClick: TNotifyEvent;

  FOnMouseDown: TMouseEvent;

  FOnMouseUp: TMouseEvent;

  FOnAnimate: TNotifyEvent;

  FOnCreate: TNotifyEvent;

  FOnDestroy: TNotifyEvent;

  FOnActivate: TNotifyEvent;

  FOnDeactivate: TNotifyEvent;

  procedure SetHint(Hint: string);

  procedure SetHide(Value: Boolean);

  function GetAnimateInterval: integer;

  procedure SetAnimateInterval(Value: integer);

  function GetAnimate: Boolean;

  procedure SetAnimate(Value: Boolean);

  procedure EndSession;

  function ShiftState: TShiftState;

protected

   { Protected declarations }

  procedure SetVisible(Value: Boolean); virtual;

  procedure DoMessage(var Message: TMessage);virtual;

  procedure DoClick; virtual;

  procedure DoDblClick; virtual;

  procedure DoMouseMove(Shift: TShiftState; X: integer; Y: integer); virtual;

  procedure DoMouseDown(Button: TMouseButton; Shift: TShiftState; X: integer; Y: integer); virtual;

  procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState; X: integer; Y: integer); virtual;

  procedure DoOnAnimate(Sender: TObject); virtual;

  procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  function ApplicationHookProc(var Message: TMessage): Boolean;

  procedure Loaded(); override;

  property Data: TNotifyIconData read FData;

public

   { Public declarations }

  constructor Create(Owner: TComponent); override;

  destructor Destroy; override;

  procedure Minimize(); virtual;

  procedure Restore(); virtual;

  procedure Update(); virtual;

  procedure ShowMenu(); virtual;

  procedure SetIconIndex(Value: integer); virtual;

  procedure SetDefaultIcon(); virtual;

  function GetHandle():HWND;

published

   { Published declarations }

  property Visible: Boolean  read FVisible write SetVisible default false;

  property Hint: string read FHint write SetHint;

  property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;

  property Hide: Boolean read FHide write SetHide;

  property RestoreOn: TTrayIconMessage read FAppRestore write FAppRestore;

  property PopupMenuOn: TTrayIconMessage read FPopupMenuShow write FPopupMenuShow;

  property Icons: TImageList read FIconList write FIconList;

  property IconIndex: integer read FIconIndex write SetIconIndex default 0;

  property AnimateInterval: integer read GetAnimateInterval write SetAnimateInterval default 1000;

  property Animate: Boolean read GetAnimate write SetAnimate default false;

  property Handle: HWND read GetHandle;

  // Events

  property OnMinimize: TNotifyEvent read FOnMinimize write FOnMinimize;

  property OnRestore: TNotifyEvent read FOnRestore write FOnRestore;

  property OnClick: TNotifyEvent read FOnClick write FOnClick;

  property OnMouseEnter: TMouseMoveEvent read FOnMouseEnter write FOnMouseEnter;

  property OnMouseExit: TMouseMoveEvent read FOnMouseExit write FOnMouseExit;

  property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;

  property OnMouseUp:TMouseEvent read FOnMouseUp write FOnMouseUp;

  property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;

  property OnAnimate: TNotifyEvent read FOnAnimate write FOnAnimate;

  property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;

  property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;

  property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;

  property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Carlo Pasolini', [TTrayIcon]);

end;

constructor TTrayIcon.Create(Owner: TComponent);

begin

  inherited;

  FIcon := TIcon.Create();

  FTimer := TTimer.Create(nil);

  FIconIndex := 0;

  FIcon.Assign(Application.Icon);

  FAppRestore := imDoubleClick;

  FOnAnimate := DoOnAnimate;

  FPopupMenuShow := imNone;

  FVisible := false;

  FHide := true;

  FTimer.Enabled := false;

  FTimer.OnTimer := OnAnimate;

  FTimer.Interval := 1000;

  if not (csDesigning in ComponentState) then

     begin

          FillChar(FData, sizeof(TNotifyIconData), #0);

//           memset(&FData, 0, sizeof(TNotifyIconData));

          FData.cbSize := sizeof(TNotifyIconData);

          FData.Wnd := AllocateHWnd(DoMessage);

          FData.uID := UINT(Self);

          FData.hIcon := FIcon.Handle;

          FData.uFlags := NIF_ICON or NIF_MESSAGE;

          FData.uCallbackMessage := WM_SYSTEM_TRAY_NOTIFY;

          FApplicationHook := ApplicationHookProc;

          Update;

     end;

end;

//---------------------------------------------------------------------------

destructor TTrayIcon.Destroy();

begin

  if not (csDesigning in ComponentState) then

     begin

          Shell_NotifyIcon(NIM_DELETE, @FData);  //booh forse @FData

          DeallocateHWnd(FData.Wnd);

     end;

  if (Assigned(FIcon)) then

     FIcon.Free;

  if (Assigned(FTimer)) then

     FTimer.Free;

  inherited;

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.Notification(AComponent: TComponent; Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if Operation = opRemove then

    begin

         if (AComponent = FIconList) then

            FIconList := nil

         else

            if (AComponent = FPopupMenu) then

               FPopupMenu := nil;

    end;

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.Loaded();

begin

  inherited Loaded();

  if (not Assigned(FIconList)) then

     begin

          FAnimate := false;

          FIcon.Assign(Application.Icon);

     end

  else

     begin

          FTimer.Enabled := FAnimate;

          FIconList.GetIcon(FIconIndex, FIcon);

     end;

  Update();

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.SetVisible(Value: Boolean);

begin

  FVisible := Value;

  if not (csDesigning in ComponentState) then

   begin

     if FVisible then

      begin

        if (not Shell_NotifyIcon(NIM_ADD, @FData)) then

           raise EOutOfResources.Create('Cannot Create System Shell Notification Icon');

        Hide := true;

        Application.HookMainWindow(FApplicationHook);

      end

     else

      begin

        if (not Shell_NotifyIcon(NIM_DELETE, @FData)) then

           raise EOutOfResources.Create('Cannot Remove System Shell Notification Icon');

        Hide := false;

        Application.UnhookMainWindow(FApplicationHook);

      end;

   end;

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.SetHint(Hint: string);

begin

  // The new hint must be different than the previous hint and less than

  // 64 characters to be modified. 64 is an operating system limit.

  if ((FHint <> Hint) and (Length(Hint) < 64)) then

   begin

     FHint := Hint;

     StrPLCopy(FData.szTip, Hint, sizeof(FData.szTip) - 1);

     // If there is no hint then there is no tool tip.

     if (Length(Hint) <> 0) then

        FData.uFlags := FData.uFlags or NIF_TIP

     else

        FData.uFlags := FData.uFlags and (not NIF_TIP);

     Update();

   end;

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.SetHide(Value: Boolean);

begin

  FHide := Value;

end;

//---------------------------------------------------------------------------

function TTrayIcon.GetAnimateInterval(): integer;

begin

  Result := FTimer.Interval;

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.SetAnimateInterval(Value: integer);

begin

  FTimer.Interval := Value;

end;

//---------------------------------------------------------------------------

function TTrayIcon.GetAnimate(): Boolean;

begin

  Result := FAnimate;

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.SetAnimate(Value: Boolean);

begin

  if (Assigned(FIconList) or (csLoading in ComponentState)) then

     FAnimate := Value;

  if (Assigned(FIconList) and (not (csDesigning in ComponentState))) then

     FTimer.Enabled := Value;

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.EndSession();

begin

  Shell_NotifyIcon(NIM_DELETE, @FData);

end;

//---------------------------------------------------------------------------

function TTrayIcon.ShiftState(): TShiftState;

var

  Res: TShiftState;

begin

  Res := [];

  if (GetKeyState(VK_SHIFT) < 0) then

     Res := Res + [ssShift];

  if (GetKeyState(VK_CONTROL) < 0) then

     Res := Res + [ssCtrl];

  if (GetKeyState(VK_MENU) < 0) then

     Res := Res + [ssAlt];

  Result := Res;

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.DoMessage(var Message: TMessage);

var

  point: TPoint;

  shift: TShiftState;

begin

  case (Message.Msg) of

   //begin

     WM_QUERYENDSESSION:

        Message.Result := 1;

        //break;

     WM_ENDSESSION:

        EndSession();

        //break;

     WM_SYSTEM_TRAY_NOTIFY:

        case (Message.LParam) of

         //begin

           WM_MOUSEMOVE:

              if (Assigned(FOnClick)) then

               begin

                 shift := ShiftState();

                 GetCursorPos(point);

                 DoMouseMove(shift, point.x, point.y);

               end;

              //break;

           WM_LBUTTONDOWN:

            begin

              shift := ShiftState();

              shift := shift + [ssLeft];

              GetCursorPos(point);

              DoMouseDown(mbLeft, shift, point.x, point.y);

              FIsClicked := true;

              //break;

            end;

           WM_LBUTTONUP:

             begin

              shift := ShiftState();

              shift := shift + [ssLeft];

              GetCursorPos(point);

              if (Assigned(FOnClick)) then

                 DoClick();

              DoMouseUp(mbLeft, shift, point.x, point.y);

              if (FAppRestore = imLeftClickUp) then

                 Restore();

              if (FPopupMenuShow = imLeftClickUp) then

                 ShowMenu();

              //break;

             end;

           WM_LBUTTONDBLCLK:

             begin

              DoDblClick();

              if (FAppRestore = imLeftDoubleClick) then

                 Restore();

              if (FPopupMenuShow = imLeftDoubleClick) then

                 ShowMenu();

              //break;

             end;

           WM_RBUTTONDOWN:

             begin

              shift := ShiftState();

              shift := shift + [ssRight];

              GetCursorPos(point);

              DoMouseDown(mbRight, shift, point.x, point.y);

              //break;

             end;

           WM_RBUTTONUP:

             begin

              shift := ShiftState();

              shift := shift + [ssRight];

              GetCursorPos(point);

              DoMouseUp(mbRight, shift, point.x, point.y);

              if (FAppRestore = imRightClickUp) then

                 Restore();

              if (FPopupMenuShow = imRightClickUp) then

                 ShowMenu();

              //break;

             end;

           WM_RBUTTONDBLCLK:

             begin

              DoDblClick();

              if (FAppRestore = imRightDoubleClick) then

                 Restore();

              if (FPopupMenuShow = imRightDoubleClick) then

                 ShowMenu();

              //break;

             end;

           WM_MBUTTONDOWN:

             begin

              shift := ShiftState();

              shift := shift + [ssMiddle];

              GetCursorPos(point);

              DoMouseDown(mbMiddle, shift, point.x, point.y);

              //break;

             end;

           WM_MBUTTONUP:

             begin

              shift := ShiftState();

              shift := shift + [ssMiddle];

              GetCursorPos(point);

              DoMouseUp(mbMiddle, shift, point.x, point.y);

              //break;

             end;

           WM_MBUTTONDBLCLK:

              DoDblClick();

              //break;

        end;

  end;

  inherited Dispatch(Message);

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.ShowMenu();

var

  point: TPoint;

begin

  GetCursorPos(point);

  if (Screen.ActiveForm.Handle <> 0) then

     SetForegroundWindow(Screen.ActiveForm.Handle);

  FPopupMenu.Popup(point.x, point.y);

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.DoClick();

begin

  if (FAppRestore = imClick) then

     Restore();

  if (FPopupMenuShow = imClick) then

     ShowMenu();

  if (Assigned(FOnClick)) then

     FOnClick(Self);

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.DoDblClick();

begin

  if (FAppRestore = imDoubleClick) then

     Restore();

  if (FPopupMenuShow = imDoubleClick) then

     ShowMenu();

  if (Assigned(FOnDblClick)) then

     FOnDblClick(Self);

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.DoMouseMove(Shift: TShiftState; X:integer; Y: integer);

begin

  if (Assigned(FOnMouseMove)) then

     FOnMouseMove(Self, Shift, X, Y);

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.DoMouseDown(Button: TMouseButton; Shift: TShiftState;

                                      X: integer; Y: integer);

begin

  if (FAppRestore = imMouseDown) then

     Restore();

  if (FPopupMenuShow = imMouseDown) then

     ShowMenu();

  if (Assigned(FOnMouseDown)) then

     FOnMouseDown(Self, Button, Shift, X, Y);

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.DoMouseUp(Button: TMouseButton; Shift: TShiftState;

                                    X: integer; Y:integer);

begin

  if (FAppRestore = imMouseDown) then

     Restore();

  if (FPopupMenuShow = imMouseDown) then

     ShowMenu();

  if (Assigned(FOnMouseUp)) then

     FOnMouseUp(Self, Button, Shift, X, Y);

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.DoOnAnimate(Sender: TObject);

begin

  if (IconIndex < FIconList.Count) then

     Inc(FIconIndex)

  else

     FIconIndex := 0;

  SetIconIndex(FIconIndex);

  Update();

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.Minimize();

begin

  Application.Minimize();

  ShowWindow(Application.Handle, SW_HIDE);

  if (Assigned(FOnMinimize)) then

     FOnMinimize(Self);

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.Restore();

begin

  Application.Restore();

  ShowWindow(Application.Handle, SW_RESTORE);

  SetForegroundWindow(Application.Handle);

  if (Assigned(FOnRestore)) then

     FOnRestore(Self);

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.Update();

begin

  if not (csDesigning in ComponentState) then

   begin

     FData.hIcon := FIcon.Handle;

     if (Visible = true) then

        Shell_NotifyIcon(NIM_MODIFY, @FData);

   end;

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.SetIconIndex(Value: integer);

begin

  FIconIndex := Value;

  if (Assigned(FIconList)) then

     FIconList.GetIcon(FIconIndex, FIcon);

  Update();

end;

//---------------------------------------------------------------------------

function TTrayIcon.ApplicationHookProc(var Message: TMessage): Boolean;

begin

  if (Message.Msg = WM_SYSCOMMAND) then

   begin

     if (Message.WParam = SC_MINIMIZE) then

        Minimize();

     if (Message.WParam = SC_RESTORE) then

        Restore();

   end;

  Result:= false;

end;

//---------------------------------------------------------------------------

procedure TTrayIcon.SetDefaultIcon();

begin

FIcon.Assign(Application.Icon);

Update();

end;

//---------------------------------------------------------------------------

function TTrayIcon.GetHandle(): HWND;

begin

  Result := FData.Wnd;

end;

//---------------------------------------------------------------------------

end.