Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 10 - Project FormIntf

Project Structure

FormIntf.dpr
program FormIntf;

uses
  Forms,
  MainForm in 'MainForm.pas' {FormMain},
  MemoForm in 'MemoForm.pas' {FormMemo},
  BitmapForm in 'BitmapForm.pas' {FormBitmap},
  FormOperations in 'FormOperations.pas',
  SaveStatusForms in 'SaveStatusForms.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TFormMain, FormMain);
  Application.CreateForm(TFormMemo, FormMemo);
  Application.CreateForm(TFormBitmap, FormBitmap);
  Application.Run;
end.
MainForm.pas
unit MainForm;

interface

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

type
  TFormMain = class(TForm)
    btnLoad: TButton;
    btnSave: TButton;
    btnShow: TButton;
    procedure btnLoadClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnShowClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

uses
  FormOperations;

{$R *.DFM}

procedure TFormMain.btnLoadClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to Screen.FormCount - 1 do
    if Supports (Screen.Forms [i], IFormOperations) then
      (Screen.Forms [i] as IFormOperations).Load;
end;

procedure TFormMain.btnSaveClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to Screen.FormCount - 1 do
    if Supports (Screen.Forms [i], IFormOperations) then
      (Screen.Forms [i] as IFormOperations).Save;
end;

procedure TFormMain.btnShowClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to Screen.FormCount - 1 do
    Screen.Forms[i].Show;
end;

end.
MemoForm.pas
unit MemoForm;

interface

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

type
  TFormMemo = class(TSaveStatusForm, IFormOperations)
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
  private
    { Private declarations }
  public
    procedure Load;
    procedure Save;
  end;

var
  FormMemo: TFormMemo;

implementation

{$R *.DFM}

{ TForm2 }

procedure TFormMemo.Load;
begin
  if OpenDialog1.Execute then
    Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure TFormMemo.Save;
begin
  if SaveDialog1.Execute then
    Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;

end.
BitmapForm.pas
unit BitmapForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FormOperations, ExtDlgs, ExtCtrls, SaveStatusForms;

type
  TFormBitmap = class(TSaveStatusForm, IFormOperations)
    Image1: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
  private
    { Private declarations }
  public
    procedure Load;
    procedure Save;
  end;

var
  FormBitmap: TFormBitmap;

implementation

{$R *.DFM}

{ TFormBitmap }

procedure TFormBitmap.Load;
begin
  if OpenPictureDialog1.Execute then
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TFormBitmap.Save;
begin
  if SavePictureDialog1.Execute then
    Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
end;

end.
FormOperations.pas
unit FormOperations;

interface

type
  IFormOperations = interface
    ['{DACFDB76-0703-4A40-A951-10D140B4A2A0}']
    procedure Load;
    procedure Save;
  end;

implementation

end.
SaveStatusForms.pas
unit SaveStatusForms;

interface

uses
  Forms, IniFiles, SysUtils;

type
  TSaveStatusForm = class (TForm)
  protected
    procedure DoCreate; override;
    procedure DoDestroy; override;
  end;

implementation

{ TSaveStatusForm }

procedure TSaveStatusForm.DoCreate;
var
  Ini: TIniFile;
begin
  inherited;
  Ini := TIniFile.Create (ExtractFileName (Application.ExeName));
  Left := Ini.ReadInteger(Caption, 'Left', Left);
  Top := Ini.ReadInteger(Caption, 'Top', Top);
  Width := Ini.ReadInteger(Caption, 'Width', Width);
  Height := Ini.ReadInteger(Caption, 'Height', Height);
  Ini.Free;
end;

procedure TSaveStatusForm.DoDestroy;
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create (ExtractFileName (Application.ExeName));
  Ini.WriteInteger(Caption, 'Left', Left);
  Ini.WriteInteger(Caption, 'Top', Top);
  Ini.WriteInteger(Caption, 'Width', Width);
  Ini.WriteInteger(Caption, 'Height', Height);
  Ini.Free;
  inherited;
end;

end.
MainForm.dfm
object FormMain: TFormMain
  Left = 191
  Top = 107
  Width = 405
  Height = 139
  Caption = 'Form Intf'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btnLoad: TButton
    Left = 40
    Top = 32
    Width = 75
    Height = 25
    Caption = '&Load'
    TabOrder = 0
    OnClick = btnLoadClick
  end
  object btnSave: TButton
    Left = 136
    Top = 32
    Width = 75
    Height = 25
    Caption = '&Save'
    TabOrder = 1
    OnClick = btnSaveClick
  end
  object btnShow: TButton
    Left = 232
    Top = 32
    Width = 75
    Height = 25
    Caption = 'Show &All'
    TabOrder = 2
    OnClick = btnShowClick
  end
end
MemoForm.dfm
object FormMemo: TFormMemo
  Left = 402
  Top = 198
  Width = 475
  Height = 422
  Caption = 'MemoForm'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 467
    Height = 395
    Align = alClient
    Color = clWindow
    TabOrder = 0
  end
  object OpenDialog1: TOpenDialog
    Left = 136
    Top = 120
  end
  object SaveDialog1: TSaveDialog
    Left = 128
    Top = 176
  end
end
BitmapForm.dfm
object FormBitmap: TFormBitmap
  Left = 485
  Top = 159
  Width = 477
  Height = 416
  Caption = 'Bitmap Form'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 0
    Top = 0
    Width = 469
    Height = 389
    Align = alClient
  end
  object OpenPictureDialog1: TOpenPictureDialog
    Left = 72
    Top = 64
  end
  object SavePictureDialog1: TSavePictureDialog
    Left = 72
    Top = 120
  end
end