Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project POLIFORM

Project Structure


POLIFORM.DPR

program PoliForm;

uses
  Forms,
  Viewer in 'Viewer.pas' {ViewerForm},
  TextView in 'TextView.pas' {TextViewerForm},
  Main in 'Main.pas' {MainForm},
  BmpView in 'BmpView.pas' {ImageViewerForm};

{$R *.RES}

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

VIEWER.PAS

unit Viewer;

interface

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

type
  TViewerForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Load1: TMenuItem;
    N1: TMenuItem;
    Close1: TMenuItem;
    Help1: TMenuItem;
    AboutPoliform1: TMenuItem;
    Panel1: TPanel;
    ButtonLoad: TButton;
    CloseButton: TButton;
    OpenDialog1: TOpenDialog;
    procedure AboutPoliform1Click(Sender: TObject);
    procedure CloseButtonClick(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure Load1Click(Sender: TObject);
    procedure ButtonLoadClick(Sender: TObject); virtual;
  private
    { Private declarations }
  public
    procedure LoadFile; virtual; abstract;
  end;

var
  ViewerForm: TViewerForm;

implementation

{$R *.DFM}

procedure TViewerForm.AboutPoliform1Click(Sender: TObject);
begin
  MessageDlg ('PoliForm, or Polymorphic Inherited Forms'#13 +
    'written by Marco Cantý for "Mastering Delphi"',
    mtInformation, [mbOK], 0);
end;

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

procedure TViewerForm.Close1Click(Sender: TObject);
begin
  Close;
end;

procedure TViewerForm.Load1Click(Sender: TObject);
begin
  LoadFile;
end;

procedure TViewerForm.ButtonLoadClick(Sender: TObject);
begin
  ShowMessage ('Error: File loading code missing');
end;

end.

TEXTVIEW.PAS

unit TextView;

interface

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

type
  TTextViewerForm = class(TViewerForm)
    Memo1: TMemo;
    procedure ButtonLoadClick(Sender: TObject); override;
  private
    { Private declarations }
  public
    procedure LoadFile; override;
  end;

{var
  TextViewerForm: TTextViewerForm;}

implementation

{$R *.DFM}

procedure TTextViewerForm.ButtonLoadClick(Sender: TObject);
begin
//  inherited;
  if OpenDialog1.Execute then
    Memo1.Lines.LoadFromFile (OpenDialog1.Filename);
end;

procedure TTextViewerForm.LoadFile;
begin
  if OpenDialog1.Execute then
    Memo1.Lines.LoadFromFile (OpenDialog1.Filename);
end;

end.

MAIN.PAS

unit Main;

interface

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

type
  TMainForm = class(TForm)
    ReloadButton1: TButton;
    ReloadButton2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ReloadButton1Click(Sender: TObject);
    procedure ReloadButton2Click(Sender: TObject);
  private
    FormList: array [1..2] of TViewerForm;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses BmpView, TextView;

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  FormList [1] :=
    TTextViewerForm.Create (Application);
  FormList [2] :=
    TImageViewerForm.Create (Application);
  for I := 1 to 2 do
    FormList[I].Show;
end;

procedure TMainForm.ReloadButton1Click(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to 2 do
    FormList[I].ButtonLoadClick (Self);
end;

procedure TMainForm.ReloadButton2Click(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to 2 do
    FormList[I].LoadFile;
end;

end.

BMPVIEW.PAS

unit BmpView;

interface

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

type
  TImageViewerForm = class(TViewerForm)
    Image1: TImage;
    procedure ButtonLoadClick(Sender: TObject); override;
  private
    { Private declarations }
  public
    procedure LoadFile; override;
  end;

{var
  ImageViewerForm: TImageViewerForm;}

implementation

{$R *.DFM}

procedure TImageViewerForm.ButtonLoadClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Image1.Picture.LoadFromFile (OpenDialog1.Filename);
end;

procedure TImageViewerForm.LoadFile;
begin
  if OpenDialog1.Execute then
    Image1.Picture.LoadFromFile (OpenDialog1.Filename);
end;

end.

VIEWER.DFM

object ViewerForm: TViewerForm
  Left = 313
  Top = 256
  Width = 292
  Height = 224
  Caption = 'Generic Viewer'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 136
    Width = 284
    Height = 42
    Align = alBottom
    TabOrder = 0
    object ButtonLoad: TButton
      Left = 56
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Load...'
      TabOrder = 0
      OnClick = ButtonLoadClick
    end
    object CloseButton: TButton
      Left = 152
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Close'
      TabOrder = 1
      OnClick = CloseButtonClick
    end
  end
  object MainMenu1: TMainMenu
    Left = 24
    Top = 8
    object File1: TMenuItem
      Caption = '&File'
      object Load1: TMenuItem
        Caption = '&Open...'
        OnClick = Load1Click
      end
      object N1: TMenuItem
        Caption = '-'
      end
      object Close1: TMenuItem
        Caption = '&Close'
        OnClick = Close1Click
      end
    end
    object Help1: TMenuItem
      Caption = '&Help'
      object AboutPoliform1: TMenuItem
        Caption = '&About Poliform...'
        OnClick = AboutPoliform1Click
      end
    end
  end
  object OpenDialog1: TOpenDialog
    Left = 96
    Top = 8
  end
end

TEXTVIEW.DFM

inherited TextViewerForm: TTextViewerForm
  Left = 465
  Top = 145
  Caption = 'Text Viewer'
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo [1]
    Left = 0
    Top = 0
    Width = 284
    Height = 136
    Align = alClient
    TabOrder = 1
  end
  inherited OpenDialog1: TOpenDialog
    Filter = 'Text files|*.txt|Any file|*.*'
  end
end

MAIN.DFM

object MainForm: TMainForm
  Left = 206
  Top = 96
  Width = 203
  Height = 86
  Caption = 'PoliForm'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ReloadButton1: TButton
    Left = 16
    Top = 17
    Width = 75
    Height = 25
    Caption = 'Reload All (1)'
    TabOrder = 0
    OnClick = ReloadButton1Click
  end
  object ReloadButton2: TButton
    Left = 104
    Top = 17
    Width = 75
    Height = 25
    Caption = 'Reload All (2)'
    TabOrder = 1
    OnClick = ReloadButton2Click
  end
end

BMPVIEW.DFM

inherited ImageViewerForm: TImageViewerForm
  Left = 159
  Top = 145
  Caption = 'Image Viewer'
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage [0]
    Left = 0
    Top = 0
    Width = 284
    Height = 136
    Align = alClient
  end
  inherited OpenDialog1: TOpenDialog
    Filter = 'Bitmap file|*.bmp|Any file|*.*'
  end
end