Marco Web Center

[an error occurred while processing this directive]

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