《GOF设计模式》—命令（COMMAND）—Delphi源码示例：文档编辑

示例：文档编辑
说明：

界面：
 
object Form1: TForm1
  Left = 420
  Top = 246
  Width = 388
  Height = 221
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 380
    Height = 167
    Align = alClient
    TabOrder = 0
  end
  object MainMenu1: TMainMenu
    Left = 80
    Top = 56
    object mniFile: TMenuItem
      Caption = '文件'
      object mniOpen: TMenuItem
        Caption = '打开'
        OnClick = mniOpenClick
      end
      object mniSave: TMenuItem
        Caption = '保存'
        OnClick = mniSaveClick
      end
      object mniClose: TMenuItem
        Caption = '退出'
        OnClick = mniSaveClick
      end
    end
    object mniEdit: TMenuItem
      Caption = '编辑'
      object mniCut: TMenuItem
        Caption = '剪切'
        OnClick = mniSaveClick
      end
      object mniCopy: TMenuItem
        Caption = '复制'
        OnClick = mniSaveClick
      end
      object mniPaste: TMenuItem
        Caption = '粘贴'
        OnClick = mniPasteClick
      end
    end
  end
end



代码：
 

unit uIterator;

interface

uses
    Classes;

type
    TIterator = class
    public
        procedure First(); virtual; abstract;
        procedure Next(); virtual; abstract;
        function IsDone(): Boolean; virtual; abstract;
        function CurrentItem(): Pointer; virtual; abstract;
    end;

    TListIterator = class(TIterator)
    private
        FList: TList;
        FCurrent: integer;
    public
        constructor Create(const AList: TList);
        //---
        procedure First(); override;
        procedure Next(); override;
        function IsDone(): Boolean; override;
        function CurrentItem: Pointer; override;
    end;

implementation

constructor TListIterator.Create(const AList: TList);
begin
    inherited Create;
    //---
    FList := AList;
end;

procedure TListIterator.First;
begin
    FCurrent := 0;
end;

procedure TListIterator.Next;
begin
    FCurrent := FCurrent + 1;
end;

function TListIterator.IsDone: Boolean;
begin
    result := FCurrent >= FList.Count;
end;

function TListIterator.CurrentItem: Pointer;
begin
    result := FList[FCurrent];
end;

end.

unit uDocument;

interface

uses
    SysUtils,Controls,Dialogs,StdCtrls,Contnrs;

type
    TAction1 = procedure() of object;

    TApplication1 = class;
    TDocument = class;
    TReceiver = TDocument;

    TCommand = class
    public
        procedure Execute(); virtual; abstract;
    end;

    TOpenCommand = class(TCommand)
    private
        FApplication: TApplication1;
        FResponse: string;
    protected
        function AskUser: string; virtual;
    public
        constructor Create(app: TApplication1);
        //---
        procedure Execute(); override;
    end;

    TPasteCommand = class(TCommand)
    private
        FDocument: TDocument;
    public
        constructor Create(ADocument: TDocument);
        //---
        procedure Execute(); override;
    end;

    TSimpleCommand = class(TCommand)
    private
        FReceiver: TReceiver;
        FAction: TAction1;
    public
        constructor Create(AReceiver: TReceiver; AAction: TAction1);
        //---
        procedure Execute; override;
    end;

    TMacroCommand = class(TCommand)
    private
        FCmds: TObjectList;
    public
        constructor Create;
        destructor Destroy; override;
        //---
        procedure Add(ACommand: TCommand);
        procedure Remove(ACommand: TCommand);
        //---
        procedure Execute(); override;
    end;

    TDocument = class
    private
        FFileName: string;
        FParent: TApplication1;
    public
        constructor Create(const AFileName: string);
        //---
        procedure Open();
        procedure Save();
        procedure Close();
        procedure Cut();
        procedure Copy();
        procedure Paste();
        //---
        property Parent: TApplication1 read FParent write FParent;
    end;

    TApplication1 = class
    private
        FDocuments: TObjectList;
        FMemo: TMemo;
        function GetItems(Index: Integer): TDocument;
        function GetLast: TDocument;
    public
        constructor Create(AMemo: TMemo);
        destructor Destroy; override;
        //---
        procedure Add(ADocument: TDocument);
        procedure Remove(ADocument: TDocument);
        //---
        property Items[Index: Integer]: TDocument read GetItems;
        property Last: TDocument read GetLast;
        property Memo: TMemo read FMemo;
    end;

implementation

uses uIterator;

constructor TMacroCommand.Create;
begin
    inherited Create;
    //---
    FCmds := TObjectList.Create;
end;

destructor TMacroCommand.Destroy;
begin
    FCmds.Free;
    //---
    inherited;
end;

procedure TMacroCommand.Add(ACommand: TCommand);
begin
    FCmds.Add(ACommand);
end;

procedure TMacroCommand.Remove(ACommand: TCommand);
begin
    FCmds.Remove(ACommand);
end;

procedure TMacroCommand.Execute();
var
    AIterator: TIterator;
    ACommand: TCommand;
begin
    AIterator := TListIterator.Create(FCmds);
    try
        with AIterator do
        begin
            First;
            while not IsDone do
            begin
                ACommand := CurrentItem;
                ACommand.Execute;
                //---
                Next;
            end;
        end;
    finally
        AIterator.Free;
    end;
end;

function TOpenCommand.AskUser: string;
var
    AOpenDialog: TOpenDialog;
begin
    AOpenDialog := TOpenDialog.Create(nil);
    try
        with AOpenDialog do
        begin
            DefaultExt := '*.txt';
            Filter := '文本文档(*.txt)|*.txt';
            if Execute then
                Result := FileName
            else
                Result := '';
        end;
    finally
        AOpenDialog.Free;
    end;
end;

constructor TOpenCommand.Create(app: TApplication1);
begin
    inherited Create;
    //---
    FApplication := app;
end;

procedure TOpenCommand.Execute();
var
    ADocument: TDocument;
begin
    FResponse := self.AskUser;
    if Length(FResponse) <> 0 then
    begin
        ADocument := TDocument.Create(FResponse);
        FApplication.Add(ADocument);
        ADocument.Open;
    end;
end;

constructor TPasteCommand.Create(ADocument: TDocument);
begin
    inherited Create;
    //---
    FDocument := ADocument;
end;

procedure TPasteCommand.Execute();
begin
    FDocument.Paste;
end;

constructor TDocument.Create(const AFileName: string);
begin
    FFileName := AFileName;
end;

procedure TDocument.Open();
    //---
    function _Open(): string;
    var
        F: file;
        AFileSize: integer;
    begin
        Result := '';
        //---
        if not FileExists(FFileName) then
            exit;
        //---
        AssignFile(F,FFileName);
        try
            Reset(F,1);
            //---
            AFileSize := FileSize(F);
            setlength(Result,AFileSize);
            //---
            BlockRead(F,PChar(Result)^,AFileSize);
        finally
            CloseFile(F);
        end;
    end;
begin
    if Assigned(FParent) then
        FParent.Memo.Text := _Open();
end;

procedure TDocument.Save;
    //---
    procedure _Save(const AContent: string);
    var
        F: file;
    begin
        if FFileName = '' then
            exit;
        //---
        try
            AssignFile(F,FFileName);
            try
                Rewrite(F,1);
                BlockWrite(F,PChar(AContent)^,Length(AContent));
            finally
                CloseFile(F);
            end;
        except
        end;
    end;
begin
    if Assigned(FParent) then
        _Save(FParent.Memo.Text);
end;

procedure TDocument.Close();
begin
    if Assigned(FParent) then
    begin
        FParent.Remove(self);
        Free;
    end;
end;

procedure TDocument.Cut();
begin
    if Assigned(FParent) then
        FParent.Memo.CutToClipboard;
end;

procedure TDocument.Copy();
begin
    if Assigned(FParent) then
        FParent.Memo.CopyToClipboard;
end;

procedure TDocument.Paste();
begin
    if Assigned(FParent) then
        FParent.Memo.PasteFromClipboard;
end;

procedure TApplication1.Add(ADocument: TDocument);
begin
    ADocument.Parent := self;
    FDocuments.Add(ADocument);
end;

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

destructor TApplication1.Destroy;
begin
    FDocuments.Free;
    //---
    inherited;
end;

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

constructor TSimpleCommand.Create(AReceiver: TReceiver; AAction: TAction1);
begin
    inherited Create;
    //---
    FReceiver := AReceiver;
    FAction := AAction;
end;

procedure TSimpleCommand.Execute;
begin
    if Assigned(FAction) then
        FAction();
end;

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

procedure TApplication1.Remove(ADocument: TDocument);
begin
    FDocuments.Remove(ADocument);
end;

end.

unit Unit1;

interface

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

type
    TForm1 = class(TForm)
        MainMenu1: TMainMenu;
        mniFile: TMenuItem;
        mniEdit: TMenuItem;
        mniOpen: TMenuItem;
        mniSave: TMenuItem;
        mniClose: TMenuItem;
        mniCut: TMenuItem;
        mniCopy: TMenuItem;
        mniPaste: TMenuItem;
        Memo1: TMemo;
        procedure FormDestroy(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure mniOpenClick(Sender: TObject);
        procedure mniPasteClick(Sender: TObject);
        procedure mniSaveClick(Sender: TObject);
    private
        FApplication1: TApplication1;
    public

    end;

var
    Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
    FApplication1 := TApplication1.Create(self.Memo1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    FApplication1.Free;
end;

procedure TForm1.mniOpenClick(Sender: TObject);
var
    ACommand: TCommand;
begin
    ACommand := TOpenCommand.Create(FApplication1);
    ACommand.Execute;
    ACommand.Free;
end;

procedure TForm1.mniPasteClick(Sender: TObject);
var
    ACommand: TCommand;
begin
    if FApplication1.Last <> nil then
    begin
        ACommand := TPasteCommand.Create(FApplication1.Last);
        ACommand.Execute;
        ACommand.Free;
    end;
end;

procedure TForm1.mniSaveClick(Sender: TObject);
var
    ACommand: TCommand;
    AReceiver: TReceiver;
begin
    AReceiver := FApplication1.Last;
    if AReceiver <> nil then
    begin
        if Sender = mniSave then
            ACommand := TSimpleCommand.Create(AReceiver,AReceiver.Save)
        else if Sender = mniClose then
            ACommand := TSimpleCommand.Create(AReceiver,AReceiver.Close)
        else if Sender = mniCut then
            ACommand := TSimpleCommand.Create(AReceiver,AReceiver.Cut)
        else if Sender = mniCopy then
            ACommand := TSimpleCommand.Create(AReceiver,AReceiver.Copy)
        else
            exit;
        //---
        ACommand.Execute;
        ACommand.Free;
    end;
end;

end.