Delphi 设计模式：《HeadFirst设计模式》Delphi7代码
没有应用状态模式的代码
1. 工程文件
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.
2.单元文件
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 TGumballMa
相关文档：
Python , Delphi , Loki 三个单词有趣的来源
许多程序设计语言和开发工具以及库的名字都来源与神话，颇有意思：
阿波罗是同时出现在希腊和罗马神话中的奥林帕斯十二大神之一。他除了拥有太阳神的身分，同时还有预言、艺术、医术之神的称号。阿波罗是宙斯和乐朵的儿子，和阿蒂蜜斯是� ......
什么是多态，字面意思就是“多种形态”，用对象来讲就是子类继承基类，而不同的子类又分别对基类进行功能的扩展。
多态在Object Pascal中是通过虚方法实现的（Virtual Method）,在Object Pascal中基类的虚方法是可以被派生类覆盖（Override）的 ......
1. 复杂的子系统
unit uSubObject;
interface
type
{ TAmplifier与TTuner，TCDPlayer，TDVDPlayer相互依赖。 }
{ 在TTuner等的简单实现时用不到对TAmplifier的引用， }
{ 但现实生活中就应该让TAmplifier提供服务，所以这里保留了。 }
{ TProjector对T ......
命令模式可以很轻松的实现撤销（Undo）功能。
1. 命令的接受者
unit uReceiveObject;
interface
type
TLight = class(TObject)
public
procedure Open;
procedure Off;
end;
implementation
{ TLight }
procedure TLight.Off;
begin
Writeln('Light is off.');
......
1. 命令的接受者
unit uReceiveObject;
interface
type
TLight = class(TObject)
public
procedure Open;
procedure Off;
end;
TGarageDoor = class(TObject)
public
procedure Up;
procedure Down;
procedure Stop;
procedure LightOn;
procedure LightOff;
end; ......
