Home: Code Repository: Mastering Delphi 5

Project SCREEN

Project Structure

SCREEN.DPR
SCREENF.PAS
SECONDF.PAS
SCREENF.DFM
SECONDF.DFM

program Screen;

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;
  public
    procedure FillFormsList (Sender: TObject);
    // handler of a user defined Windows message
    procedure ChildClosed (var Message: TMessage);
      message wm_User;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses
  SecondF;

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

           procedure TMainForm.FillFormsList (Sender: TObject);
var
  I: Integer;
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;

procedure TMainForm.ChildClosed (var Message: TMessage);
begin
  // handler of the user message sent by the secondary form
  FillFormsList (Self);
end;

procedure TMainForm.NewButtonClick(Sender: TObject);
var
  NewForm: TSecondForm;
begin
  {create a new form, set its caption, and run it}
  NewForm := TSecondForm.Create (Self);
  Inc (nForms);
  NewForm.Caption := 'Second ' + IntToStr (nForms);
  NewForm.Show;
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);
    procedure FormDestroy(Sender: TObject);
  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;

procedure TSecondForm.FormDestroy(Sender: TObject);
begin
  {post a message to the main form, but only if it is
  not closing, to avoid a GPFault}
  if not (csDestroying in MainForm.ComponentState) then
    PostMessage (MainForm.Handle, wm_User, 0, 0);
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'
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Position = poDefaultPosOnly
  OnClose = FormClose
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object CloseButton: TButton
    Left = 40
    Top = 31
    Width = 56
    Height = 28
    Caption = 'Close'
    TabOrder = 0
    OnClick = CloseButtonClick
  end
end