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.