《GOF设计模式》—模板方法(TEMPLATE METHOD)—Delphi源码示例：文档

示例：文档
说明：
考虑一个提供Application和Document类的应用框架。Application类负责打开一个已有的以外部形式存储的文档，如一个文件。一旦一个文档中的信息从该文件中读出后，它就由一个Document对象表示。



OpenDocument是一个模板方法，定义了打开一个文档的每一个主要步骤。

界面：
 


object Form2: TForm2
  Left = 192
  Top = 110
  Width = 285
  Height = 212
  Caption = 'Form2'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 24
    Top = 16
    Width = 233
    Height = 113
    Lines.Strings = (
      'Memo1')
    TabOrder = 0
  end
  object btnDocOpen: TButton
    Left = 16
    Top = 144
    Width = 113
    Height = 25
    Caption = 'btnDocOpen'
    TabOrder = 1
    OnClick = btnDocOpenClick
  end
  object btnDocClose: TButton
    Left = 160
    Top = 144
    Width = 99
    Height = 25
    Caption = 'btnDocClose'
    TabOrder = 2
    OnClick = btnDocCloseClick
  end
  object OpenDialog1: TOpenDialog
    Left = 112
    Top = 64
  end
end

代码：
unit uDocument;

interface

uses
    Windows, SysUtils, Classes, Controls,Dialogs, StdCtrls, Contnrs;

type
    TApplication1 = class;

    TDocument = class
    private
        FFileHandle: integer;
        FFileName: string;
        FContent: string;
        FParent: TApplication1;
        function IsOpen: Boolean;
    public
        procedure Open();
        procedure Close();
        procedure Save();
        procedure DoRead(); virtual; abstract;
        procedure DoWrite(); virtual; abstract;
        //---
        property FileName: string read FFileName write FFileName;
        property Parent: TApplication1 read FParent write FParent;
    end;
    TMyDocument = class(TDocument)
    public
        procedure DoRead; override;
        procedure DoWrite; override;
    end;

    TApplication1 = class
    private
        FDocs: TObjectList;
        FMemo: TMemo;
        function GetCount: Integer;
        function GetItems(Index: Integer): TDocument;
        function GetLast: TDocument;
    protected
        function CanOpenDocument(const AName: string): Boolean; virtual;
        function DoCreateDocument(const AName: string): TDocument; virtual;
        procedure AboutToOpenDocument(ADoc: TDocument); virtual;
        //---
        procedure AboutToCloseDocument(ADoc: TDocument); virtual;
    public
        constructor Create(AMemo: TMemo);
        destructor Destroy; override;
        //---
        procedure AddDocument(ADoc: TDocument);
        procedure OpenDocument(const AName: string);
        procedure CloseDocument();
        //---
        property Count: Integer read GetCount;
        property Items[Index: Integer]: TDocument read GetItems;
        property Last: TDocument read GetLast;
        property Memo: TMemo read FMemo;
    end;
    TMyApplication = class(TApplication1)
    protected
        procedure AboutToOpenDocument(ADoc: TDocument); override;
        function CanOpenDocument(const AName: string): Boolean; override;
        function DoCreateDocument(const AName: string): TDocument; override;
        //---
        procedure AboutToCloseDocument(ADoc: TDocument); override;
    end;

implementation

procedure TApplication1.AboutToOpenDocument(ADoc: TDocument);
{文档何时将被打开}
begin
end;

procedure TApplication1.AddDocument(ADoc: TDocument);
begin
    ADoc.Parent := self;
    FDocs.Add(ADoc);
end;

function TApplication1.CanOpenDocument(const AName: string): Boolean;
{检查一个文档是否能够被打开}
begin
    Result := False;
end;

constructor TApplication1.Create(AMemo: TMemo);
begin
    FDocs := TObjectList.Create;
    FMemo := AMemo;
end;

destructor TApplication1.Destroy;
    //---
    procedure _CloseDocs;
    var
        i: Integer;
    begin
        for i := 0 to self.Count - 1 do
            self.Items[i].Close;
    end;
begin
    FDocs.Free;
    //---
    inherited;
end;

function TApplication1.DoCreateDocument(const AName: string): TDocument;
begin
    Result := nil;
end;

function TApplication1.GetItems(Index: Integer): TDocument;
begin
    Result := TDocument(FDocs[Index]);
end;

function TDocument.IsOpen: Boolean;
begin
    Result := FFileHandle >= 0;
end;

procedure TDocument.Open;
begin
    if FileExists(FFileName) then
        FFileHandle := FileOpen(FFileName, fmOpenReadWrite)
    else
        FFileHandle := -1;
end;

procedure TDocument.Close;
begin
    if Self.IsOpen then
        FileClose(FFileHandle);
    FFileHandle := -1;
end;

procedure TDocument.Save;
begin
    if Self.IsOpen then
    begin
        FileSeek(FFileHandle, 0, soFromBeginning);
        FileWrite(FFileHandle, PChar(FContent)^, Length(FContent));
        //---
        SetEndOfFile(FFileHandle);
    end;
end;

procedure TMyDocument.DoRead;
var
    AFileLen: integer;
begin
    if Self.IsOpen then
    begin
        AFileLen := FileSeek(FFileHandle, 0, soFromEnd);
        if AFileLen > 0 then
        begin
            SetLength(FContent,AFileLen);
            //---
            FileSeek(FFileHandle, 0, soFromBeginning);
            FileRead(FFileHandle, PChar(FContent)^, Length(FContent));
        end
        else
            FContent := '';
        //---
        if Assigned(FParent) then
            FParent.Memo.Text := FContent;
    end;
end;

procedure TMyDocument.DoWrite;
begin
    if Assigned(FParent) then
        FContent := FParent.Memo.Text
    else
        FContent := '';
end;

function TApplication1.GetCount: Integer;
begin
    Result := FDocs.Count;
end;

procedure TApplication1.OpenDocument(const AName: string);
var
    ADoc: TDocument;
begin
    if not CanOpenDocument(AName) then
        exit;
    //---
    ADoc := DoCreateDocument(AName);
    if ADoc <> nil then
    begin
        FDocs.Add(ADoc);
        //---
        AboutToOpenDocument(ADoc);
        //---
        ADoc.Open();
        ADoc.DoRead();
    end;
end;

procedure TMyApplication.AboutToCloseDocument(ADoc: TDocument);
begin
    ShowMessage('正在关闭文档:' + ADoc.FileName);
end;

procedure TMyApplication.AboutToOpenDocument(ADoc: TDocument);
begin
    ShowMessage('正在打开文档:' + ADoc.FileName);
end;

function TMyApplication.CanOpenDocument(const AName: string): Boolean;
begin
    Result := FileExists(AName);
end;

function TMyApplication.DoCreateDocument(const AName: string): TDocument;
begin
    Result := TMyDocument.Create;
    with Result do
    begin
        Parent := Self;
        FileName := AName;
    end;
end;

procedure TApplication1.CloseDocument;
var
    ADoc: TDocument;
begin
    ADoc := Self.Last;
    if ADoc <> nil then
    begin
        AboutToCloseDocument(ADoc);
        //---
        ADoc.DoWrite;
        ADoc.Save;
        ADoc.Close;
        //---
        FDocs.Remove(ADoc);
    end;
end;

function TApplication1.GetLast: TDocument;
begin
    Result := TDocument(FDocs.Last);
end;

procedure TApplication1.AboutToCloseDocument(ADoc: TDocument);
begin
end;

end.

unit Unit2;

interface

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

type
    TForm2 = class(TForm)
        Memo1: TMemo;
        btnDocOpen: TButton;
        OpenDialog1: TOpenDialog;
        btnDocClose: TButton;
        procedure btnDocCloseClick(Sender: TObject);
        procedure btnDocOpenClick(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure FormCreate(Sender: TObject);
    private
        FApp: TApplication1;
    public
    { Public declarations }
    end;

var
    Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
    FApp := TMyApplication.Create(self.Memo1);
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
    FApp.Free;
end;

procedure TForm2.btnDocOpenClick(Sender: TObject);
begin
    with OpenDialog1 do
    begin
        if Execute then
            FApp.OpenDocument(FileName);
    end;
end;

procedure TForm2.btnDocCloseClick(Sender: TObject);
begin
    FApp.CloseDocument;
end;

end.