《GOF设计模式》—命令（COMMAND）—Delphi源码示例：支持取消和重做（多次取消1）

示例：多次取消1
说明：
       若要支持多级的取消和重做，就需要有一个已被执行命令的历史列表 (historylist)，该列表的最大长度决定了取消和重做的级数。历史列表存储了已被执行的命令序列。向后遍历该列表并逆向执行 (reverse-executing)命令是取消它们的结果；向前遍历并执行命令是重执行它们。
       如果该命令的状态在执行时从不改变，则不需要拷贝，而仅需将一个对该命令的引用放入历史列表中。

界面：
 
object Form2: TForm2
  Left = 192
  Top = 110
  Width = 354
  Height = 200
  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 btnCalc1: TButton
    Left = 8
    Top = 128
    Width = 75
    Height = 25
    Caption = '计算1'
    TabOrder = 0
    OnClick= btnCalc1Click
  end
  object Memo1: TMemo
    Left = 64
    Top = 32
    Width = 193
    Height = 81
    Lines.Strings = (
      'Memo1')
    TabOrder = 1
  end
  object btnCalc2: TButton
    Left = 96
    Top = 128
    Width = 75
    Height = 25
    Caption = '计算2'
    TabOrder = 2
    OnClick= btnCalc2Click
  end
  object btnCancel: TButton
    Left = 184
    Top = 128
    Width = 75
    Height = 25
    Caption = '取消'
    TabOrder = 3
    OnClick= btnCancelClick
  end
  object btnRedo: TButton
    Left = 264
    Top = 128
    Width = 75
    Height = 25
    Caption = '重做'
    TabOrder = 4
    OnClick= btnRedoClick
  end
end

代码：
 

unit uCommand4;

interface

uses
    SysUtils,Controls,StdCtrls,classes;

type
    TReceiverState = record
        Count: Integer;
    end;

    TReceiver = class
    private
        FState: TReceiverState;
        FMemo: TMemo;
        procedure ShowState;
    public
        constructor Create(AMemo: TMemo);
        //---
        procedure Action();
        procedure Unaction();
    end;

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

    TCOncreteCommand= class(TCommand)
    private
        FReceiver: TReceiver;
    public
        constructor Create(AReceiver: TReceiver);
    end;
    TConcreteCommand_1 = class(TConcreteCommand)
    public
        procedure Execute; override;
        procedure Unexecute; override;
    end;
    TConcreteCommand_2 = class(TConcreteCommand)
    public
        procedure Execute; override;
        procedure Unexecute; override;
    end;

    THstoryCommand = class(TCommand)
    private
        FCommands: TList;
        FCurrent: integer;
    public
        constructor Create;
        destructor Destroy; override;
        //---
        procedure Add(ACommand: TCommand);
        //---
        procedure Execute(); override;
        procedure Unexecute; override;
    end;

implementation

constructor TReceiver.Create(AMemo: TMemo);
begin
    FMemo := AMemo;
    FState.Count := 0;
end;

procedure TReceiver.Action;
begin
    with FState do
        Count := Count + 1;
    self.ShowState;
end;

procedure TReceiver.Unaction;
begin
    with FState do
        Count := Count - 1;
    self.ShowState;
end;

procedure TReceiver.ShowState;
begin
    FMemo.Text := IntToStr(FState.Count);
end;

constructor TConcreteCommand.Create(AReceiver: TReceiver);
begin
    inherited Create;
    //---
    FReceiver := AReceiver;
end;

procedure TConcreteCommand_1.Execute;
begin
    FReceiver.Action;
end;

procedure TConcreteCommand_1.Unexecute;
begin
    FReceiver.Unaction;
end;

procedure TConcreteCommand_2.Execute;
begin
    FReceiver.Action;
    FReceiver.Action;
end;

procedure TConcreteCommand_2.Unexecute;
begin
    FReceiver.Unaction;
    FReceiver.Unaction;
end;

constructor THstoryCommand.Create;
begin
    inherited Create;
    //---
    FCommands := TList.Create;
    FCurrent := 0;
end;

destructor THstoryCommand.Destroy;
begin
    FCommands.Free;
    //---
    inherited;
end;

procedure THstoryCommand.Add(ACommand: TCommand);
const
    CNT_MAXLEVEL = 4;
    //---
    procedure _ClearCommand;
    var
        i: integer;
    begin
        with FCommands do
        begin
            if Count > 0 then
            begin
                for i := FCurrent - 1 downto 0 do
                    Delete(i);
            end;
        end;
        //---
        FCurrent := 0;
    end;
    //---
    procedure _CheckLevel;
    begin
        with FCommands do
        begin
            if Count = CNT_MAXLEVEL then
                Delete(Count - 1);
        end;
    end;
    //---
    procedure _AddCommand;
    begin
        FCommands.Insert(FCurrent,ACommand);
    end;
begin
    _ClearCommand;
    _CheckLevel;
    _AddCommand;
end;

procedure THstoryCommand.Execute();
{向前遍历并执行命令是重执行}
var
    ACommand: TCommand;
begin
    if (FCommands.Count > 0) and (FCurrent > 0) then
    begin
        FCurrent := FCurrent - 1;
        //---
        ACommand := FCommands[FCurrent];
        ACommand.Execute;
    end;
end;

procedure THstoryCommand.Unexecute;
{向后遍历该列表并逆向执行命令是取消}
var
    ACommand: TCommand;
begin
    if (FCurrent     begin
        ACommand := FCommands[FCurrent];
        ACommand.Unexecute;
        //---
        FCurrent := FCurrent + 1;
    end;
end;

end.

unit Unit2;

interface

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

type
    TForm2 = class(TForm)
        btnCalc1: TButton;
        Memo1: TMemo;
        btnCalc2: TButton;
        btnCancel: TButton;
        btnRedo: TButton;
        procedure FormDestroy(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure btnCalc1Click(Sender: TObject);
        procedure btnCalc2Click(Sender: TObject);
        procedure btnCancelClick(Sender: TObject);
        procedure btnRedoClick(Sender: TObject);
    private
        FReceiver: TReceiver;
        FCommand1,FCommand2: TCommand;
        FHistoryCommand: THstoryCommand;
    public
    { Public declarations }
    end;

var
    Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
    FReceiver := TReceiver.Create(self.Memo1);
    FCommand1 := TConcreteCommand_1.Create(FReceiver);
    FCommand2 := TConcreteCommand_2.Create(FReceiver);
    FHistoryCommand := THstoryCommand.Create;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
    FReceiver.Free;
    FCommand1.Free;
    FCommand2.Free;
    FHistoryCommand.Free;
end;

procedure TForm2.btnCalc1Click(Sender: TObject);
begin
    FCommand1.Execute;
    FHistoryCommand.Add(FCommand1);
end;

procedure TForm2.btnCalc2Click(Sender: TObject);
begin
    FCommand2.Execute;
    FHistoryCommand.Add(FCommand2);
end;

procedure TForm2.btnCancelClick(Sender: TObject);
begin
    FHistoryCommand.Unexecute;
end;

procedure TForm2.btnRedoClick(Sender: TObject);
begin
    FHistoryCommand.Execute;
end;

end.