码农公寓

 1
 2{《HeadFirst设计模式》之策略模式 }
 3{ 本单元中的类为策略类           }
 4{ 编译工具: Delphi7.0           }
 5{ E-Mail : guzh-0417@163.com   }
 6
 7unit uStrategy;
 8
 9interface
10
11type
12  {飞行接口，及其实现类 }
13
14  IFlyBehavior = Interface(IInterface)
15    procedure Fly;
16  end;
17
18  TFlyWithWings = class(TInterfacedObject, IFlyBehavior)
19  public
20    procedure Fly;
21  end;
22
23  TFlyNoWay = class(TInterfacedObject, IFlyBehavior)
24  public
25    procedure Fly;
26  end;
27
28  TFlyRocketPowered = class(TInterfacedObject, IFlyBehavior)
29  public
30    procedure Fly;
31  end;
32
33  {叫声接口，及其实现类}
34
35  IQuackBehavior = Interface(IInterface)
36    procedure Quack;
37  end;
38
39  TQuack = class(TInterfacedObject, IQuackBehavior)
40  public
41    procedure Quack;
42  end;
43
44  TMuteQuack = class(TInterfacedObject, IQuackBehavior)
45  public
46    procedure Quack;
47  end;
48
49  TSqueak = class(TInterfacedObject, IQuackBehavior)
50  public
51    procedure Quack;
52  end;
53
54implementation
55
56{ TFlyWithWings }
57
58procedure TFlyWithWings.Fly;
59begin
60  Writeln(‘I am flying!‘);
61end;
62
63{ TFlyNoWay }
64
65procedure TFlyNoWay.Fly;
66begin
67  Writeln(‘I can not fly!‘);
68end;
69
70{ TFlyRocketPowered }
71
72procedure TFlyRocketPowered.Fly;
73begin
74  Writeln(‘I am flying with a rocket!‘);
75end;
76
77{ TQuack }
78
79procedure TQuack.Quack;
80begin
81  Writeln(‘Quack‘);
82end;
83
84{ TMuteQuack }
85
86procedure TMuteQuack.Quack;
87begin
88  Writeln(‘<Silence>‘);
89end;
90
91{ TSqueak }
92
93procedure TSqueak.Quack;
94begin
95  Writeln(‘Squeak‘);
96end;
97
98end.

 

  1
  2{《HeadFirst设计模式》之策略模式           }
  3{ 本单元中的类为策略的用户，                }
  4{ 一般策略模式中的上下文接口已包含在用户类中。}
  5{ 编译工具: Delphi7.0                     }
  6{ E-Mail : guzh-0417@163.com             }
  7
  8unit uDuck;
  9
 10interface
 11
 12uses
 13  uStrategy;
 14
 15type
 16  { 鸭子抽象类 }
 17
 18  TDuck = class(TObject)
 19  protected
 20    FFlyBehavior  : IFlyBehavior;
 21    FQuackBehavior: IQuackBehavior;
 22  public
 23    procedure Display; virtual; abstract;
 24    procedure PerformFly;
 25    procedure PerformQuack;
 26    procedure Swim;
 27    procedure SetFlyBehavior(FlyBehavior: IFlyBehavior);
 28    procedure SetQuackBehavior(QuackBehavior: IQuackBehavior);
 29  end;
 30
 31  { 绿头鸭具体类 }
 32
 33  TMallardDuck = class(TDuck)
 34  public
 35    constructor Create;
 36    destructor Destroy; override;
 37    procedure Display; override;
 38  end;
 39
 40  { 模型鸭具体类 }
 41  
 42  TModelDuck = class(TDuck)
 43  public
 44    constructor Create;
 45    destructor Destroy; override;
 46    procedure Display; override;
 47  end;
 48
 49implementation
 50
 51{ TDuck }
 52
 53procedure TDuck.PerformFly;
 54begin
 55  FFlyBehavior.Fly;
 56end;
 57
 58procedure TDuck.PerformQuack;
 59begin
 60  FQuackBehavior.Quack;
 61end;
 62
 63procedure TDuck.SetFlyBehavior(FlyBehavior: IFlyBehavior);
 64begin
 65  FFlyBehavior := FlyBehavior;
 66end;
 67
 68procedure TDuck.SetQuackBehavior(QuackBehavior: IQuackBehavior);
 69begin
 70  FQuackBehavior := QuackBehavior;
 71end;
 72
 73procedure TDuck.Swim;
 74begin
 75  Writeln(‘All ducks float, even decoys!‘);
 76end;
 77
 78{ TMallardDuck }
 79
 80constructor TMallardDuck.Create;
 81begin
 82  FQuackBehavior := TQuack.Create;
 83  FFlyBehavior   := TFlyWithWings.Create;
 84end;
 85
 86destructor TMallardDuck.Destroy;
 87begin
 88  FQuackBehavior := nil;
 89  FFlyBehavior   := nil;
 90  inherited;
 91end;
 92
 93procedure TMallardDuck.Display;
 94begin
 95  Writeln(‘I am a real mallard duck‘);
 96end;
 97
 98{ TModelDuck }
 99
100constructor TModelDuck.Create;
101begin
102  FFlyBehavior   := TFlyNoWay.Create;
103  FQuackBehavior := TQuack.Create;
104end;
105
106destructor TModelDuck.Destroy;
107begin
108  FQuackBehavior := nil;
109  FFlyBehavior   := nil;
110  inherited;
111end;
112
113procedure TModelDuck.Display;
114begin
115  Writeln(‘I am a model duck‘);
116end;
117
118end.
119 

 

 1
 2{《HeadFirst设计模式》之策略模式 }
 3{ 客户端                       }
 4{ 编译工具: Delphi7.0          }
 5{ E-Mail : guzh-0417@163.com  }
 6
 7program pMiniDuckSimulator;
 8
 9{$APPTYPE CONSOLE}
10
11uses
12  SysUtils,
13  uDuck in ‘uDuck.pas‘,
14  uStrategy in ‘uStrategy.pas‘;
15
16var
17  Mallard: TDuck;
18  Model  : TDuck;
19  FlyRocketPowered: IFlyBehavior;
20  
21begin
22  Mallard := TMallardDuck.Create;
23  Mallard.PerformQuack;
24  Mallard.PerformFly;
25  FreeAndNil(Mallard);
26
27  Model := TModelDuck.Create;
28  Model.PerformFly;
29
30  FlyRocketPowered := TFlyRocketPowered.Create;
31  Model.SetFlyBehavior(FlyRocketPowered);
32  Model.PerformFly;
33  FlyRocketPowered := nil;
34  FreeAndNil(Model);
35
36  Readln;
37end.

 

运行结果：