Project Structure

• Screen2.dpr
• ScreenF.pas
• SecondF.pas
• ScreenF.dfm
• SecondF.dfm

program Screen2;

uses
  Forms,
  ScreenF in 'ScreenF.pas' {MainForm},
  SecondF in 'SecondF.pas' {SecondForm};

{$R *.RES}

begin
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.

unit ScreenF;

interface

uses
  SysUtils, Windows, Messages, Classes,
  Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TMainForm = class(TForm)
    FormsLabel: TLabel;
    FormsListBox: TListBox;
    NewButton: TButton;
    ActiveLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure NewButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject;
      var Action: TCloseAction);
    procedure FormsListBoxClick(Sender: TObject);
  private
    nForms: Integer;
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    procedure ActiveFormChange (Sender: TObject);
    procedure FillFormsList;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses
  SecondF;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FillFormsList;
  // set the secondary forms counter to 0
  nForms := 0;
  // activate an event handler of the screen object
  Screen.OnActiveFormChange := ActiveFormChange;
end;

procedure TMainForm.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and Showing
      and (AComponent is TForm) then
    FillFormsList;
end;

procedure TMainForm.FillFormsList;
var
  I: Integer;
begin
  if assigned (FormsListBox) then
  begin
    FormsLabel.Caption := 'Forms: ' + IntToStr (Screen.FormCount);
    FormsListBox.Clear;
    // write class name and form title to the list box
    for I := 0 to Screen.FormCount - 1 do
      FormsListBox.Items.Add (Screen.Forms[I].ClassName +
        ' - ' + Screen.Forms[I].Caption);
    ActiveLabel.Caption := 'Active Form : ' +
      Screen.ActiveForm.Caption;
  end;
end;

procedure TMainForm.ActiveFormChange (Sender: TObject);
begin
  FillFormsList;
end;

procedure TMainForm.NewButtonClick(Sender: TObject);
begin
  // create a new form, set its caption, and run it.
  with TSecondForm.Create(Application) do begin
    Inc (nForms);
    Caption := 'Second ' + IntToStr (nForms);
    Show;
  end;
end;

procedure TMainForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  // VERY IMPORTANT! disable the event handler to avoid a GPFault
  // Screen.OnActiveFormChange := nil;
end;

procedure TMainForm.FormsListBoxClick(Sender: TObject);
begin
  // activate the form the user has clicked onto
  Screen.Forms [FormsListBox.ItemIndex].BringToFront;
end;

end.

unit SecondF;

interface

uses
  SysUtils, Windows, Messages, Classes,
  Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TSecondForm = class(TForm)
    CloseButton: TButton;
    procedure CloseButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  SecondForm: TSecondForm;

implementation

{$R *.DFM}

uses
  ScreenF;

procedure TSecondForm.CloseButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TSecondForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  // actually delete the form.
  Action := caFree;
end;

end.

object MainForm: TMainForm
  Left = 229
  Top = 155
  Width = 296
  Height = 253
  BorderWidth = 1
  Caption = 'Screen Info'
  Color = clBtnFace
  ParentFont = True
  OldCreateOrder = False
  Visible = True
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object FormsLabel: TLabel
    Left = 8
    Top = 32
    Width = 34
    Height = 13
    Caption = 'Forms: '
  end
  object ActiveLabel: TLabel
    Left = 8
    Top = 8
    Width = 56
    Height = 13
    Caption = 'ActiveLabel'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
  end
  object FormsListBox: TListBox
    Left = 8
    Top = 48
    Width = 273
    Height = 169
    ItemHeight = 13
    TabOrder = 0
    OnClick = FormsListBoxClick
  end
  object NewButton: TButton
    Left = 232
    Top = 8
    Width = 49
    Height = 25
    Caption = 'New'
    TabOrder = 1
    OnClick = NewButtonClick
  end
end

object SecondForm: TSecondForm
  Left = 223
  Top = 153
  Width = 144
  Height = 118
  Caption = 'Second'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  Position = poDefaultPosOnly
  OnClose = FormClose
  PixelsPerInch = 96
  TextHeight = 13
  object CloseButton: TButton
    Left = 40
    Top = 31
    Width = 56
    Height = 28
    Caption = 'Close'
    TabOrder = 0
    OnClick = CloseButtonClick
  end
end