Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---状态模式[转]

{没有应用状态模式的代码}

//工程文件

program Project1;

{$APPTYPE CONSOLE}

uses
  uGumballMachine in 'uGumballMachine.pas';

var
  aGumballMachine: TGumballMachine;

begin
  aGumballMachine := TGumballMachine.Create(5);

aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;

Writeln;

aGumballMachine.InsertQuarter;
  aGumballMachine.EjectQuarter;
  aGumballMachine.TurnCrank;

Writeln;

aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;
  aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;
  aGumballMachine.EjectQuarter;

Writeln;

aGumballMachine.InsertQuarter;
  aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;
  aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;
  aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;

aGumballMachine.Free;

Readln;
end.

//单元文件

unit uGumballMachine;

interface

type
  TGumballMachine = class(TObject)
  private
    FState: Integer;
    FCount: Integer;
  public
    constructor Create(aCount: Integer);
    procedure InsertQuarter;
    procedure EjectQuarter;
    procedure TurnCrank;
    procedure Dispense;
  end;

implementation

const
  SOLD_OUT = 0;
  NO_QUARTER = 1;
  HAS_QUARTER = 2;
  SOLD = 3;

{ TGumballMachine }

constructor TGumballMachine.Create(aCount: Integer);
begin
  FCount := aCount;
  FState := SOLD_OUT;
  if FCount > 0 then
    FState := NO_QUARTER;
end;

procedure TGumballMachine.Dispense;
begin
  if FState = SOLD then
  begin
    Writeln('A gumball comes rolling out the slot');
    FCount := FCount - 1;
    if FCount = 0 then
      begin
        Writeln('Oops, out of Gumballs');
        FState := SOLD_OUT;
      end
    else
      FState := NO_QUARTER;
  end;

if FState = NO_QUARTER then
    Writeln('You need to pay first');

if FState = SOLD_OUT then
    Writeln('No gumball dispensed');

if FState = HAS_QUARTER then
    Writeln('No gumball dispensed');
end;

procedure TGumballMachine.EjectQuarter;
begin
  if FState = HAS_QUARTER then
  begin
    Writeln('Quarter returned');
    FState := NO_QUARTER;
  end;

if FState = NO_QUARTER then
    Writeln('You haven''t inserted a quarter');

if FState = SOLD then
    Writeln('Sorry, you already turned the crank');

if FState = SOLD_OUT then
    Writeln('You can''t eject, you haven''t inserted a quarter yet'); 
end;

procedure TGumballMachine.InsertQuarter;
begin
  if FState = HAS_QUARTER then
    Writeln('You can''t insert another quarter');

if FState = NO_QUARTER then
  begin
    FState := HAS_QUARTER;
    Writeln('You inserted a quarter');
  end;

if FState = SOLD_OUT then
    Writeln('You can''t insert a quarter, the machine is sold out');

if FState = SOLD then
    Writeln('Please Wait, we''re already giving you a gumball');   
end;

procedure TGumballMachine.TurnCrank;
begin
  if FState = SOLD then
    Writeln('Turning twice doesn''t get you another gumball');

if FState = NO_QUARTER then
    Writeln('You turned, but there''s no quarter');

if FState = SOLD_OUT then
    Writeln('You turned, but there''s no gumballs');

if FState = HAS_QUARTER then
  begin
    Writeln('You turned...');
    FState := SOLD;
    Dispense;
  end;
end;

end.

{应用状态模式的代码}

//工程文件

program Project1;

{$APPTYPE CONSOLE}

uses
  uGumballMachine in 'uGumballMachine.pas';

var
  aGumballMachine: TGumballMachine;

begin
  aGumballMachine := TGumballMachine.Create(5);

aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;

Writeln;

aGumballMachine.InsertQuarter;
  aGumballMachine.EjectQuarter;
  aGumballMachine.TurnCrank;

Writeln;

aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;
  aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;
  aGumballMachine.EjectQuarter;

Writeln;

aGumballMachine.InsertQuarter;
  aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;
  aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;
  aGumballMachine.InsertQuarter;
  aGumballMachine.TurnCrank;

aGumballMachine.Free;

Readln;
end.

//单元文件

unit uGumballMachine;

interface

type
  TState = class; //Forward声明，创建两个相互依赖的类。
  TGumballMachine = class(TObject)
  private
    FSoldOutState: TState;
    FNoQuarterState: TState;
    FHasQuarterState: TState;
    FSoldState: TState;
    FState: TState;
    FCount: Integer;
    function GetSoldOutState: TState;
    function GetNoQuarterState: TState;
    function GetHasQuarterState: TState;
    function GetSoldState: TState;
    function GetCount: Integer;
  public
    constructor Create(aNumberGumballs: Integer);
    destructor Destroy; override;
    procedure InsertQuarter;
    procedure EjectQuarter;
    procedure TurnCrank;
    procedure SetState(aState: TState);
    procedure ReleaseBall;
  end;

TState = class(TObject)
  public
    procedure InsertQuarter; virtual; abstract;
    procedure EjectQuarter; virtual; abstract;
    procedure TurnCrank; virtual; abstract;
    procedure Dispense; virtual; abstract;
  end;

TNoQuarterState = class(TState)
  private
    FGumballMachine: TGumballMachine;
  public
    constructor Create(aGumballMachine: TGumballMachine);
    procedure InsertQuarter; override;
    procedure EjectQuarter; override;
    procedure TurnCrank; override;
    procedure Dispense; override;
  end;

THasQuarterState = class(TState)
  private
    FGumballMachine: TGumballMachine;
  public
    constructor Create(aGumballMachine: TGumballMachine);
    procedure InsertQuarter; override;
    procedure EjectQuarter; override;
    procedure TurnCrank; override;
    procedure Dispense; override;
  end;

TSoldState = class(TState)
  private
    FGumballMachine: TGumballMachine;
  public
    constructor Create(aGumballMachine: TGumballMachine);
    procedure InsertQuarter; override;
    procedure EjectQuarter; override;
    procedure TurnCrank; override;
    procedure Dispense; override;
  end;

TSoldOutState = class(TState)
  private
    FGumballMachine: TGumballMachine;
  public
    constructor Create(aGumballMachine: TGumballMachine);
    procedure InsertQuarter; override;
    procedure EjectQuarter; override;
    procedure TurnCrank; override;
    procedure Dispense; override;
  end;

implementation

{ TNoQuarterState }

constructor TNoQuarterState.Create(aGumballMachine: TGumballMachine);
begin
  FGumballMachine := aGumballMachine;
end;

procedure TNoQuarterState.Dispense;
begin
  Writeln('You needed to pay first');
end;

procedure TNoQuarterState.EjectQuarter;
begin
  Writeln('You haven''t inserted a quarter');
end;

procedure TNoQuarterState.InsertQuarter;
begin
  Writeln('You inserted a quarter');
  FGumballMachine.SetState(FGumballMachine.GetHasQuarterState);
end;

procedure TNoQuarterState.TurnCrank;
begin
  Writeln('You turned, but there''s no quarter');
end;

{ THasQuarterState }

constructor THasQuarterState.Create(aGumballMachine: TGumballMachine);
begin
  FGumballMachine := aGumballMachine;
end;

procedure THasQuarterState.Dispense;
begin
  Writeln('No Gumball Dispensed');
end;

procedure THasQuarterState.EjectQuarter;
begin
  Writeln('Quarter Returned');
  FGumballMachine.SetState(FGumballMachine.GetNoQuarterState);
end;

procedure THasQuarterState.InsertQuarter;
begin
  Writeln('You can''t insert another quarter');
end;

procedure THasQuarterState.TurnCrank;
begin
  Writeln('You turned...');
  FGumballMachine.SetState(FGumballMachine.GetSoldState);
end;

{ TSoldState }

constructor TSoldState.Create(aGumballMachine: TGumballMachine);
begin
  FGumballMachine := aGumballMachine;
end;

procedure TSoldState.Dispense;
begin
  FGumballMachine.ReleaseBall;
  if FGumballMachine.GetCount > 0 then
    FGumballMachine.SetState(FGumballMachine.GetNoQuarterState)
  else
    begin
      Writeln('Oop , Out of gumballs');
      FGumballMachine.SetState(FGumballMachine.GetSoldOutState);
    end;
end;

procedure TSoldState.EjectQuarter;
begin
  Writeln('Sorry, you already turned the crank');
end;

procedure TSoldState.InsertQuarter;
begin
  Writeln('Please Wait, we''re already giving you a gumball ');
end;

procedure TSoldState.TurnCrank;
begin
  Writeln('Turning twice doesn''t get you another gumball');
end;

{ TSoldOutState }

constructor TSoldOutState.Create(aGumballMachine: TGumballMachine);
begin
  FGumballMachine := aGumballMachine;
end;

procedure TSoldOutState.Dispense;
begin
  Writeln('No gumball dispensed');
end;

procedure TSoldOutState.EjectQuarter;
begin
  Writeln('You can''t eject, you haven''t inserted a quarter yet');
end;

procedure TSoldOutState.InsertQuarter;
begin
  Writeln('You can''t insert a quarter, the machine is Sold out');
end;

procedure TSoldOutState.TurnCrank;
begin
  Writeln('You turned, but there are no gumballs');
end;

{ TGumballMachine }

constructor TGumballMachine.Create(aNumberGumballs: Integer);
begin
  FSoldOutState    := TSoldOutState.Create(Self); //var Self: TGumballMachine;
  FNoQuarterState  := TNoQuarterState.Create(Self);
  FHasQuarterState := THasQuarterState.Create(Self);
  FSoldState       := TSoldState.Create(Self);
  FCount := aNumberGumballs;
  FState := FSoldOutState;
  if aNumberGumballs > 0 then
    FState := FNoQuarterState;
end;

destructor TGumballMachine.Destroy;
begin
  FSoldOutState.Free;
  FNoQuarterState.Free;
  FHasQuarterState.Free;
  FSoldState.Free;
  inherited;
end;

procedure TGumballMachine.EjectQuarter;
begin
  FState.EjectQuarter;
end;

function TGumballMachine.GetCount: Integer;
begin
  Result := FCount;
end;

function TGumballMachine.GetHasQuarterState: TState;
begin
  Result := FHasQuarterState;
end;

function TGumballMachine.GetNoQuarterState: TState;
begin
  Result := FNoQuarterState;
end;

function TGumballMachine.GetSoldOutState: TState;
begin
  Result := FSoldOutState;
end;

function TGumballMachine.GetSoldState: TState;
begin
  Result := FSoldState;
end;

procedure TGumballMachine.InsertQuarter;
begin
  FState.InsertQuarter;
end;

procedure TGumballMachine.ReleaseBall;
begin
  Writeln('A Gumball comes rolling out the slot...');
  if FCount <> 0 then
    FCount := FCount - 1;
end;

procedure TGumballMachine.SetState(aState: TState);
begin
  FState := aState;
end;

procedure TGumballMachine.TurnCrank;
begin
  FState.TurnCrank;
  FState.Dispense;
end;

end.

//运行结果