1
2{"Headfirst design mode" strategy mode}
3{the class in this unit is a policy class}
4{compiler tool: Delphi7.0}
5{e-mail: [Email protected]}
6
7unit Ustrategy;
8
9interface
10
11type
12 {Flight interface, and its implementation class}
13
Iflybehavior = Interface (iinterface)
Procedure Fly;
The end;
17
Tflywithwings = Class (Tinterfacedobject, Iflybehavior)
Public
Procedure Fly;
The end;
22
Tflynoway = Class (Tinterfacedobject, Iflybehavior)
Public
Procedure Fly;
The end;
27
Tflyrocketpowered = Class (Tinterfacedobject, Iflybehavior)
Public
Procedure Fly;
The end;
32
33 {Barking interface, and its implementation class}
34
Iquackbehavior = Interface (iinterface)
Procedure Quack;
Panax Notoginseng end;
38
Tquack = Class (Tinterfacedobject, Iquackbehavior)
+ Public
Procedure Quack;
The end;
43
Tmutequack = Class (Tinterfacedobject, Iquackbehavior)
Public
Procedure Quack;
The end;
48
Tsqueak = Class (Tinterfacedobject, Iquackbehavior)
Public
Wuyi procedure Quack;
The end;
53
54implementation
55
56{Tflywithwings}
57
58procedure Tflywithwings.fly;
59begin
Writeln (' I am flying! ');
61end;
62
63{Tflynoway}
64
65procedure Tflynoway.fly;
66begin
Writeln (' I can not fly! ');
68end;
69
70{tflyrocketpowered}
71
72procedure Tflyrocketpowered.fly;
73begin
Writeln (' I am flying with a rocket! ');
75end;
76
77{Tquack}
78
79procedure Tquack.quack;
80begin
Bayi writeln (' quack ');
82end;
83
84{Tmutequack}
85
86procedure Tmutequack.quack;
87begin
Writeln (' <Silence> ');
89end;
90
91{Tsqueak}
92
93procedure Tsqueak.quack;
94begin
Writeln (' Squeak ');
96end;
97
98end.
1
2{"Headfirst design mode" strategy mode}
3{the class in this unit is a user of policy,}
4{the context interface in general policy mode is already included in the user class. }
5{compiler tool: Delphi7.0}
6{e-mail: [Email protected]}
7
8unit Uduck;
9
10interface
11
12uses
Ustrategy;
14
15type
16 {Duck Abstract class}
17
Tduck = Class (TObject)
Protected
Fflybehavior:iflybehavior;
Fquackbehavior:iquackbehavior;
Public
Procedure Display; Virtual Abstract
Procedure Performfly;
Procedure Performquack;
Procedure Swim;
Procedure Setflybehavior (Flybehavior:iflybehavior);
Procedure Setquackbehavior (Quackbehavior:iquackbehavior);
The end;
30
31 {Green Head Duck specific class}
32
Tmallardduck = Class (Tduck)
Public
Constructor Create;
destructor Destroy; Override
PNS procedure Display; Override
The end;
39
40 {Model Duck specific class}
41
Tmodelduck = Class (Tduck)
Public
Constructor Create;
destructor Destroy; Override
Procedure Display; Override
The end;
48
49implementation
50
51{Tduck}
52
53procedure Tduck.performfly;
54begin
Fflybehavior.fly;
56end;
57
58procedure Tduck.performquack;
59begin
Fquackbehavior.quack;
61end;
62
63procedure Tduck.setflybehavior (Flybehavior:iflybehavior);
64begin
Fflybehavior: = Flybehavior;
66end;
67
68procedure Tduck.setquackbehavior (Quackbehavior:iquackbehavior);
69begin
Fquackbehavior: = Quackbehavior;
71end;
72
73procedure Tduck.swim;
74begin
Writeln (' All ducks float, even decoys! ');
76end;
77
78{Tmallardduck}
79
80constructor tmallardduck.create;
81begin
Fquackbehavior: = tquack.create;
Fflybehavior: = tflywithwings.create;
84end;
85
86destructor Tmallardduck.destroy;
87begin
Fquackbehavior: = nil;
Fflybehavior: = nil;
inherited;
91end;
92
93procedure Tmallardduck.display;
94begin
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;
inherited;
111end;
112
113procedure Tmodelduck.display;
114begin
Writeln (' I am a model duck ');
116end;
117
118end.
119
1
2{"Headfirst design mode" strategy mode}
3{Client}
4{compiler tool: Delphi7.0}
5{e-mail: [Email protected]}
6
7program Pminiducksimulator;
8
9{$APPTYPE CONSOLE}
10
11uses
Sysutils,
Uduck in ' Uduck.pas ',
Ustrategy in ' Ustrategy.pas ';
15
16var
Mallard:tduck;
Model:tduck;
Flyrocketpowered:iflybehavior;
20
21begin
Mallard: = tmallardduck.create;
Mallard.performquack;
Mallard.performfly;
Freeandnil (Mallard);
26
Model: = tmodelduck.create;
Model.performfly;
29
flyrocketpowered: = tflyrocketpowered.create;
Model.setflybehavior (flyrocketpowered);
Model.performfly;
Flyrocketpowered: = nil;
Freeandnil (Model);
35
READLN;
37end.
Operation Result:
Delphi design mode: "Headfirst design mode" DELPHI7 Code---strategy mode miniducksimulator[]
