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

示例：一次取消
说明：
若应用只支持一次取消操作，那么只需存储最近一次被执行的命令。
界面：
 
object Form2: TForm2
  Left = 192
  Top = 110
  Width = 344
  Height = 219
  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 = 64
    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 = 152
    Top = 128
    Width = 75
    Height = 25
    Caption = '计算2'
    TabOrder = 2
    OnClick = btnCalc2Click
  end
  object btnCancel: TButton
    Left = 240
    Top = 128
    Width = 75
    Height = 25
    Caption = '取消'
    TabOrder = 3
    OnClick = btnCancelClick
  end
end

代码：
unit uCommand3;

interface

uses
    SysUtils,Controls,StdCtrls;

type
    TReceiverState = record
        Count: Integer;
    end;

    TReceiver = class
    private
        FState: TReceiverState;
        FMemo: TMemo;
        procedure SetState(const Value: TReceiverState);
        procedure ShowState;
    public
        constructor Create(AMemo: TMemo);
        //---
        procedure Action();
        //---
        property State: TReceiverState read FState write SetState;
    end;

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

    TConcreteCommand = class(TCommand)
    private
        FReceiver: TReceiver;
        FState: TReceiverState;
    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;

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.SetState(const Value: TReceiverState);
begin
    FState := Value;
    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
    FState := FReceiver.State;
    FReceiver.Action;
end;

procedure TConcreteCommand_1.Unexecute;
begin
    FReceiver.State := FState;
end;

procedure TConcreteCommand_2.Execute;
begin
    FState := FReceiver.State;
    FReceiver.Action;
    FReceiver.Action;
end;

procedure TConcreteCommand_2.Unexecute;
begin
    FReceiver.State := FState;
end;

end.

unit Unit2;

interface

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

type
    TForm2 = class(TForm)
        btnCalc1: TButton;
        Memo1: TMemo;
        btnCalc2: TButton;
        btnCancel: TButton;
        procedure FormDestroy(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure btnCalc1Click(Sender: TObject);
        procedure btnCalc2Click(Sender: TObject);
        procedure btnCancelClick(Sender: TObject);
    private
        FReceiver: TReceiver;
        FCommand1,FCommand2,FHistoryCommand: TCommand;
    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);
end;

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

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

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

procedure TForm2.btnCancelClick(Sender: TObject);
begin
    if FHistoryCommand <> nil then
        FHistoryCommand.Unexecute;
end;

end.