Эмуляция многоэкранного режима

Code:

{** Building a multi screen emulator ***

 }

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.

{

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.

{

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.

{

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.