Visibility of toolbox out of control

unit uPatterns;

interface

uses Classes, SysUtils;

type
  TMultiEvent = class
  private
    FObservers: TList;
  protected
    function FindObserver(Observer: TMethod): integer;
    function GetObserver(Index: integer): TMethod;
    procedure SignalObserver(Observer: TMethod); virtual;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Attach(Observer: TMethod);
    procedure Detach(Observer: TMethod);

    procedure Signal;
  end;

  TMultiNotifyEvent = class(TMultiEvent)
  private
    FSender: TObject;
  protected
    procedure SignalObserver(Observer: TMethod); override;
  public
    procedure Attach(Observer: TNotifyEvent);
    procedure Detach(Observer: TNotifyEvent);

    procedure Signal(Sender: TObject);
  end;

  TSubject = class
  private
    FOnChange: TMultiNotifyEvent;
    FValue: string;
    procedure SetValue(const aValue: string);
  protected
    procedure DoChange; virtual;
  public
    constructor Create(AValue: string);
    destructor Destroy; override;
    property OnChange: TMultiNotifyEvent read FOnChange;

    property Value: string read FValue write SetValue;
  end;

implementation

{ TEvent }

procedure TMultiEvent.Attach(Observer: TMethod);
var
  Index: integer;
begin
  Index := FindObserver(Observer);

  { A method contains two pointers:                              }
  { - The code pointer, that's where the procedure is in memory  }
  { - The data pointer, this tells Delphi what instance of the   }
  {   object calls the procedure                                 }
  { We must store both pointers in order to use that callback.   }

  if Index < 0 then
  begin
    FObservers.Add(Observer.Code);
    FObservers.Add(Observer.Data);
  end;
end;

constructor TMultiEvent.Create;
begin
  inherited Create;
  FObservers := TList.Create;
end;

destructor TMultiEvent.Destroy;
begin
  FreeAndNil(FObservers);
  inherited Destroy;
end;

procedure TMultiEvent.Detach(Observer: TMethod);
var
  Index: integer;
begin
  Index := FindObserver(Observer) * 2;

  if Index >= 0 then
  begin
    FObservers.Delete(Index); // Delete code pointer
    FObservers.Delete(Index); // Delete data pointer
  end;
end;

function TMultiEvent.FindObserver(Observer: TMethod): integer;
var
  i: integer;
begin
  { Search fails by default, if there is a match, result will be updated. }
  Result := -1;
  for i := (FObservers.Count div 2)-1 downto 0 do
  begin
    { We have a match only if both the Code and Data pointers are the same. }
    if (Observer.Code = FObservers[i * 2 ]) and (Observer.Data = FObservers[i * 2 + 1]) then
    begin
      Result := i;
      break;
    end;
  end;
end;

function TMultiEvent.GetObserver(Index: integer): TMethod;
begin
  { Fill the TMethod record with the code and data pointers. }
  Result.Code := FObservers[Index * 2];
  Result.Data := FObservers[Index * 2 + 1];
end;

procedure TMultiEvent.SignalObserver(Observer: TMethod);
begin
  { Descendants must take care to notify the Observer by themselves }
  { because we cannot know the parameters required by the event.    }

  Assert(Assigned(@Observer));
  { We could make this method Abstract and force descendants, but   }
  { I prefer to do a run-time check to validate the passe methods   }
end;


procedure TMultiEvent.Signal;
var
  i: integer;
begin
  { Call SignalObserver for each stored observers in reverse order. }

  { SignalObserver (which is declared in sub-classes) will typecast }
  { the TMethod record into whatever procedure type it handles.     }
  { See the TMultiNotifyEvent below for an example.                 }

  for i := (FObservers.Count div 2)-1 downto 0 do
  begin
    SignalObserver(GetObserver(i));
  end;
end;

{ TMultiNotifyEvent }

procedure TMultiNotifyEvent.Attach(Observer: TNotifyEvent);
begin
  inherited Attach(TMethod(Observer));
end;

procedure TMultiNotifyEvent.Detach(Observer: TNotifyEvent);
begin
  inherited Detach(TMethod(Observer));
end;

procedure TMultiNotifyEvent.Signal(Sender: TObject);
begin
  FSender := Sender;
  inherited Signal;
end;

procedure TMultiNotifyEvent.SignalObserver(Observer: TMethod);
begin
  inherited SignalObserver(Observer);
  TNotifyEvent(Observer)(FSender);
end;

{ TSubject }

constructor TSubject.Create(AValue: string);
begin
  inherited Create;
  FValue := AValue;
  FOnChange := TMultiNotifyEvent.Create;
end;

destructor TSubject.Destroy;
begin
  FOnChange.Free;
  inherited Destroy;
end;

procedure TSubject.DoChange;
begin
  { Signal is the method that notify every observers }
  OnChange.Signal(Self);
end;

procedure TSubject.SetValue(const aValue: string);
begin
  if fValue <> aValue then
  begin
    FValue := aValue;
    DoChange;
  end;
end;

end.

Select allOpen in new window

unit uToolbox;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  uPatterns;

type
  TfrmToolbox = class(TForm)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormWindowStateChanged(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    fSOWindowState: TSubject;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    function VisibleWindowState: string;

    property SOWindowState: TSubject read fSOWindowState;
  end;

var
  frmToolbox: TfrmToolbox = nil;

function Toolbox: TfrmToolbox;

implementation

{$R *.dfm}

function WindowStateToString(aWindowState: TWindowState): string;
begin
  Result := 'Normal';
  case aWindowState of
    wsMinimized: Result := 'Minimized';
    wsMaximized: Result := 'Maximized';
  //else
    // wsNormal
  //  Result := 'Normal';
  end;
end;

function VisibleToString(aVisible: Boolean): string;
begin
  Result := 'Hidden';
  if aVisible then
    Result := 'Visible';
end;

function Toolbox: TfrmToolbox;
begin
  if not Assigned(frmToolbox) or (frmToolbox = nil) then
    frmToolbox := TfrmToolbox.Create(Application);
  Result := frmToolbox;
end;

constructor TfrmToolbox.Create(aOwner: TComponent);
begin
  inherited Create(AOwner);
  fSOWindowState := TSubject.Create(VisibleWindowState);
end;

destructor TfrmToolbox.Destroy;
begin
  fSOWindowState.Free;
  inherited Destroy;
end;

procedure TfrmToolbox.FormActivate(Sender: TObject);
begin
  Visible := True;
end;

procedure TfrmToolbox.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caHide;
  FormWindowStateChanged(Self);
end;

procedure TfrmToolbox.FormWindowStateChanged(Sender: TObject);
begin
  fSOWindowState.Value := VisibleWindowState;
end;

function TfrmToolbox.VisibleWindowState: string;
begin
  Result := VisibleToString(Visible) + '_' + WindowStateToString(WindowState);
end;

end.

Select allOpen in new window

object frmToolbox: TfrmToolbox
  Left = 0
  Top = 0
  BorderStyle = bsSizeToolWin
  Caption = 'Toolbox'
  ClientHeight = 478
  ClientWidth = 387
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  Visible = True
  OnActivate = FormActivate
  OnClose = FormClose
  OnHide = FormWindowStateChanged
  OnResize = FormWindowStateChanged
  OnShow = FormWindowStateChanged
  PixelsPerInch = 96
  TextHeight = 13
end

Select allOpen in new window

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    mnuWindows: TMenuItem;
    mnuToolbox: TMenuItem;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure mnuToolboxClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure ToolboxChangedWindowState(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

uses uToolbox;

{$R *.dfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Toolbox.SOWindowState.OnChange.Attach(ToolboxChangedWindowState);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // this throws an AV because the TfromToolbox is destroyed first
  // Toolbox.SOWindowState.OnChange.Detach(ToolboxChangedWindowState);
end;

procedure TForm1.mnuToolboxClick(Sender: TObject);
begin
  Toolbox.Visible := mnuToolbox.Checked;
end;

procedure TForm1.ToolboxChangedWindowState(Sender: TObject);
var temp: string;
  IsVisible: Boolean;
begin
  temp := Toolbox.VisibleWindowState;
  IsVisible := SameText(Copy(temp, 1, 7), 'Visible');
  if mnuToolbox.Checked <> IsVisible then
    mnuToolbox.Checked := IsVisible;
  memo1.Lines.Add('Toolbox window state changed to : ' + temp);
end;

end.

Select allOpen in new window

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 426
  ClientWidth = 828
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 56
    Top = 96
    Width = 545
    Height = 225
    Lines.Strings = (
      'Memo1')
    TabOrder = 0
  end
  object MainMenu1: TMainMenu
    Left = 408
    Top = 216
    object mnuWindows: TMenuItem
      Caption = 'Windows'
      object mnuToolbox: TMenuItem
        AutoCheck = True
        Caption = 'Toolbox'
        Checked = True
        OnClick = mnuToolboxClick
      end
    end
  end
end

Select allOpen in new window

unit uToolbox;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  uPatterns;

type
  TfrmToolbox = class(TForm)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormWindowStateChanged(Sender: TObject);
  private
    fSOWindowState: TSubject;
    fVisibleOnDeactive: Boolean;
    fOldAppDeactivate: TNotifyEvent;
    fOldAppActivate: TNotifyEvent;
    fDeactivating: Boolean;
    procedure OnAppDeactivate(Sender: TObject);
    procedure OnAppActivate(Sender: TObject);
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    function VisibleWindowState: string;

    property SOWindowState: TSubject read fSOWindowState;
  end;

var
  frmToolbox: TfrmToolbox = nil;

function Toolbox: TfrmToolbox;

implementation

{$R *.dfm}

function WindowStateToString(aWindowState: TWindowState): string;
begin
  Result := 'Normal';
  case aWindowState of
    wsMinimized: Result := 'Minimized';
    wsMaximized: Result := 'Maximized';
  //else
    // wsNormal
  //  Result := 'Normal';
  end;
end;

function VisibleToString(aVisible: Boolean): string;
begin
  Result := 'Hidden';
  if aVisible then
    Result := 'Visible';
  if not Application.Active then
    Result := 'Inactive_' + Result;
end;

function Toolbox: TfrmToolbox;
begin
  if not Assigned(frmToolbox) or (frmToolbox = nil) then
    frmToolbox := TfrmToolbox.Create(Application);
  Result := frmToolbox;
end;

constructor TfrmToolbox.Create(aOwner: TComponent);
begin
  inherited Create(AOwner);
  fVisibleOnDeactive := True;
  fSOWindowState := TSubject.Create(VisibleWindowState);
  fDeactivating := False;
  fOldAppActivate := Application.OnActivate;
  Application.OnActivate := OnAppActivate;
  fOldAppDeactivate := Application.OnDeactivate;
  Application.OnDeactivate := OnAppDeactivate;
end;

destructor TfrmToolbox.Destroy;
begin
  fSOWindowState.Free;
  inherited Destroy;
end;

procedure TfrmToolbox.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caHide;
  FormWindowStateChanged(Self);
end;

procedure TfrmToolbox.FormWindowStateChanged(Sender: TObject);
begin
  if not fDeactivating then
   fSOWindowState.Value := VisibleWindowState;
end;

procedure TfrmToolbox.OnAppActivate(Sender: TObject);
begin
  if fVisibleOnDeactive then
      Visible := True;
end;

procedure TfrmToolbox.OnAppDeactivate(Sender: TObject);
begin
  fVisibleOnDeactive := Visible;
  fDeactivating := True;
  try
    Hide;
  finally
    fDeactivating := False;
  end;
end;

function TfrmToolbox.VisibleWindowState: string;
begin
  Result := VisibleToString(Visible) + '_' + WindowStateToString(WindowState);
end;

end.

Select allOpen in new window