Delphi 设计模式:《HeadFirst设计模式》Delphi7代码---命令模式之RemoteControlTest[转]
2020-12-13 15:36
标签:des blog http io ar os for sp div
1
2{《HeadFirst设计模式》之命令模式 }
3{ 本单元中的类为命令的接收者 }
4{ 编译工具 :Delphi7.0 }
5{ 联系方式 :guzh-0417@163.com }
6
7unit uReceiveObject;
8
9interface
10
11type
12 TLight = class(TObject)
13 private
14 FLocation: String;
15 public
16 constructor Create(aLocation: String);
17 procedure Open;
18 procedure Off;
19 end;
20
21 TCeilingFan = class(TObject)
22 private
23 FLevel : Integer;
24 FLocation: String;
25 function GetSpeed: Integer;
26 public
27 constructor Create(aLocation: String);
28 procedure High;
29 procedure Medium;
30 procedure Low;
31 procedure Off;
32 property Speed: Integer read GetSpeed;
33 end;
34
35 TGarageDoor = class(TObject)
36 private
37 FLocation: String;
38 public
39 constructor Create(aLocation: String);
40 procedure Up;
41 procedure Down;
42 procedure Stop;
43 procedure LightOn;
44 procedure LightOff;
45 end;
46
47 TStereo = class(TObject)
48 private
49 FLocation: String;
50 public
51 constructor Create(aLocation: String);
52 procedure Play;
53 procedure Off;
54 procedure SetCD;
55 procedure SetDVD;
56 procedure SetRadio;
57 procedure SetVolume(aVolume: Integer);
58 end;
59
60 TTV = class(TObject)
61 private
62 FLocation: String;
63 FChannel : Integer;
64 public
65 constructor Create(aLocation: String);
66 procedure Open;
67 procedure Off;
68 procedure SetInputChannel;
69 end;
70
71 THottub = class(TObject)
72 private
73 FOpen: Boolean;
74 FTemp: Integer;
75 function GetTemp: Integer;
76 procedure SetTemp(const Value: Integer);
77 public
78 function Open: Boolean;
79 function Off : Boolean;
80 procedure BubblesOpen;
81 procedure BubblesOff;
82 procedure JetsOpen;
83 procedure JetsOff;
84 procedure Heat;
85 procedure Cool;
86 property Temp: Integer read GetTemp write SetTemp;
87 end;
88
89implementation
90
91const
92 SPEED_HIGH = 2;
93 SPEED_MEDIUM = 1;
94 SPEED_LOW = 0;
95
96{ TLight }
97
98constructor TLight.Create(aLocation: String);
99begin
100 FLocation := aLocation;
101end;
102
103procedure TLight.Off;
104begin
105 Writeln(FLocation + ‘Light is off.‘);
106end;
107
108procedure TLight.Open;
109begin
110 Writeln(FLocation + ‘Light is on.‘);
111end;
112
113{ TCeilingFan }
114
115constructor TCeilingFan.Create(aLocation: String);
116begin
117 FLocation := aLocation;
118end;
119
120function TCeilingFan.GetSpeed: Integer;
121begin
122 Result := FLevel;
123end;
124
125procedure TCeilingFan.High;
126begin
127 FLevel := SPEED_HIGH;
128 Writeln(FLocation + ‘Ceiling fan is on high.‘);
129end;
130
131procedure TCeilingFan.Low;
132begin
133 FLevel := SPEED_LOW;
134 Writeln(FLocation + ‘Ceiling fan is on low.‘);
135end;
136
137procedure TCeilingFan.Medium;
138begin
139 FLevel := SPEED_MEDIUM;
140 Writeln(FLocation + ‘Ceiling fan is on medium.‘);
141end;
142
143procedure TCeilingFan.Off;
144begin
145 FLevel := 0;
146 Writeln(FLocation + ‘Ceiling fan is on off.‘);
147end;
148
149{ TGarageDoor }
150
151constructor TGarageDoor.Create(aLocation: String);
152begin
153 FLocation := aLocation;
154end;
155
156procedure TGarageDoor.Down;
157begin
158 Writeln(FLocation + ‘Garage door is down.‘);
159end;
160
161procedure TGarageDoor.LightOff;
162begin
163 Writeln(FLocation + ‘Garage light is off.‘);
164end;
165
166procedure TGarageDoor.LightOn;
167begin
168 Writeln(FLocation + ‘Garage light is on.‘);
169end;
170
171procedure TGarageDoor.Stop;
172begin
173 Writeln(FLocation + ‘Garage door is stopped.‘);
174end;
175
176procedure TGarageDoor.Up;
177begin
178 Writeln(FLocation + ‘Garage door is up.‘);
179end;
180
181{ TStereo }
182
183constructor TStereo.Create(aLocation: String);
184begin
185 FLocation := aLocation;
186end;
187
188procedure TStereo.Off;
189begin
190 Writeln(FLocation + ‘Stereo is off.‘);
191end;
192
193procedure TStereo.Play;
194begin
195 Writeln(FLocation + ‘Stereo is on.‘);
196end;
197
198procedure TStereo.SetCD;
199begin
200 Writeln(FLocation + ‘Stereo is set for CD input.‘);
201end;
202
203procedure TStereo.SetDVD;
204begin
205 Writeln(FLocation + ‘Stereo is set for DVD input.‘);
206end;
207
208procedure TStereo.SetRadio;
209begin
210 Writeln(FLocation + ‘Stereo is set for radio.‘);
211end;
212
213procedure TStereo.SetVolume(aVolume: Integer);
214begin
215 Writeln(FLocation + ‘Stereo volume set to ‘, aVolume);
216end;
217
218{ TTV }
219
220constructor TTV.Create(aLocation: String);
221begin
222 FLocation := aLocation;
223end;
224
225procedure TTV.Off;
226begin
227 Writeln(FLocation + ‘TV is off.‘);
228end;
229
230procedure TTV.Open;
231begin
232 Writeln(FLocation + ‘TV is on.‘);
233end;
234
235procedure TTV.SetInputChannel;
236begin
237 FChannel := 3;
238 Writeln(‘Channel is set for VCR.‘);
239end;
240
241{ THottub }
242
243procedure THottub.BubblesOff;
244begin
245 if Off then
246 Writeln(‘Hottub is not bubbling.‘);
247end;
248
249procedure THottub.BubblesOpen;
250begin
251 if Open then
252 Writeln(‘Hottub is bubbling.‘);
253end;
254
255procedure THottub.Cool;
256begin
257 FTemp := 98;
258 Writeln(‘Hottub is cooling to 98 degrees.‘);
259end;
260
261function THottub.GetTemp: Integer;
262begin
263 Result := FTemp;
264end;
265
266procedure THottub.Heat;
267begin
268 FTemp := 105;
269 Writeln(‘Hottub is heating to a steaming 105 degrees.‘);
270end;
271
272procedure THottub.JetsOff;
273begin
274 if Off then
275 Writeln(‘Hottub jets are off.‘);
276end;
277
278procedure THottub.JetsOpen;
279begin
280 if Open then
281 Writeln(‘Hottub jets are open.‘);
282end;
283
284function THottub.Off: Boolean;
285begin
286 FOpen := False;
287 Result := FOpen;
288end;
289
290function THottub.Open: Boolean;
291begin
292 FOpen := True;
293 Result := FOpen;
294end;
295
296procedure THottub.SetTemp(const Value: Integer);
297begin
298 FTemp := Value;
299end;
300
301end.
1
2{《HeadFirst设计模式》之命令模式 }
3{ 将命令接收者中的动作包装成命令对象 }
4{ 编译工具 :Delphi7.0 }
5{ 联系方式 :guzh-0417@163.com }
6
7unit uCommandObject;
8
9interface
10
11uses
12 uReceiveObject;
13
14type
15 TCommand = class(TObject)
16 public
17 procedure Execute; virtual; abstract;
18 end;
19
20 TNoCommand = class(TCommand)
21 public
22 procedure Execute; override;
23 end;
24
25 TLightOnCommand = class(TCommand)
26 private
27 FLight: TLight;
28 public
29 constructor Create(aLight: TLight);
30 procedure Execute; override;
31 end;
32
33 TLightOffCommand = class(TCommand)
34 protected
35 FLight: TLight;
36 public
37 constructor Create(aLight: TLight);
38 procedure Execute; override;
39 end;
40
41 TLivingRoomLightOnCommand = class(TLightOnCommand)
42 end;
43
44 TLivingRoomLightOffCommand = class(TLightOffCommand)
45 end;
46
47 TKitchenLightOnCommand = class(TLightOnCommand)
48 end;
49
50 TKitchenLightOffCommand = class(TLightOffCommand)
51 end;
52
53 TCeilingFanOnCommand = class(TCommand)
54 private
55 FCeilingFan: TCeilingFan;
56 public
57 constructor Create(aCeilingFan: TCeilingFan);
58 procedure Execute; override;
59 end;
60
61 TCeilingFanOffCommand = class(TCommand)
62 private
63 FCeilingFan: TCeilingFan;
64 public
65 constructor Create(aCeilingFan: TCeilingFan);
66 procedure Execute; override;
67 end;
68
69 TGarageDoorUpCommand = class(TCommand)
70 private
71 FGarageDoor: TGarageDoor;
72 public
73 constructor Create(aGarageDoor: TGarageDoor);
74 procedure Execute; override;
75 end;
76
77 TGarageDoorDownCommand = class(TCommand)
78 private
79 FGarageDoor: TGarageDoor;
80 public
81 constructor Create(aGarageDoor: TGarageDoor);
82 procedure Execute; override;
83 end;
84
85 TStereoOnWithCDCommand = class(TCommand)
86 private
87 FStereo: TStereo;
88 public
89 constructor Create(aStereo: TStereo);
90 procedure Execute; override;
91 end;
92
93 TStereoOffCommand = class(TCommand)
94 private
95 FStereo: TStereo;
96 public
97 constructor Create(aStereo: TStereo);
98 procedure Execute; override;
99 end;
100
101 THottubOnCommand = class(TCommand)
102 private
103 FHottub: THottub;
104 public
105 constructor Create(aHottub: THottub);
106 procedure Execute; override;
107 end;
108
109 THottubOffCommand = class(TCommand)
110 private
111 FHottub: THottub;
112 public
113 constructor Create(aHottub: THottub);
114 procedure Execute; override;
115 end;
116
117implementation
118
119{ TNoCommand }
120
121procedure TNoCommand.Execute;
122begin
123end;
124
125{ TLightOnCommand }
126
127constructor TLightOnCommand.Create(aLight: TLight);
128begin
129 FLight := aLight;
130end;
131
132procedure TLightOnCommand.Execute;
133begin
134 FLight.Open;
135end;
136
137{ TLightOffCommand }
138
139constructor TLightOffCommand.Create(aLight: TLight);
140begin
141 FLight := aLight;
142end;
143
144procedure TLightOffCommand.Execute;
145begin
146 FLight.Off;
147end;
148
149
150
151{ TLivingRoomLightOnCommand }
152
153{ TLivingRoomLightOffCommand }
154
155{ TKitchenLightOnCommand }
156
157{ TKitchenLightOffCommand }
158
159
160
161{ TCeilingFanOnCommand }
162
163constructor TCeilingFanOnCommand.Create(aCeilingFan: TCeilingFan);
164begin
165 FCeilingFan := aCeilingFan;
166end;
167
168procedure TCeilingFanOnCommand.Execute;
169begin
170 FCeilingFan.High;
171end;
172
173{ TCeilingFanOffCommand }
174
175constructor TCeilingFanOffCommand.Create(aCeilingFan: TCeilingFan);
176begin
177 FCeilingFan := aCeilingFan;
178end;
179
180procedure TCeilingFanOffCommand.Execute;
181begin
182 FCeilingFan.Off;
183end;
184
185{ TGarageDoorUpCommand }
186
187constructor TGarageDoorUpCommand.Create(aGarageDoor: TGarageDoor);
188begin
189 FGarageDoor := aGarageDoor;
190end;
191
192procedure TGarageDoorUpCommand.Execute;
193begin
194 FGarageDoor.Up;
195 FGarageDoor.LightOn;
196end;
197
198{ TGarageDoorDownCommand }
199
200constructor TGarageDoorDownCommand.Create(aGarageDoor: TGarageDoor);
201begin
202 FGarageDoor := aGarageDoor;
203end;
204
205procedure TGarageDoorDownCommand.Execute;
206begin
207 FGarageDoor.Down;
208 FGarageDoor.LightOff;
209end;
210
211{ TStereoOnWithCDCommand }
212
213constructor TStereoOnWithCDCommand.Create(aStereo: TStereo);
214begin
215 FStereo := aStereo;
216end;
217
218procedure TStereoOnWithCDCommand.Execute;
219begin
220 FStereo.Play;
221 FStereo.SetCD;
222 FStereo.SetVolume(11);
223end;
224
225{ TStereoOffCommand }
226
227constructor TStereoOffCommand.Create(aStereo: TStereo);
228begin
229 FStereo := aStereo;
230end;
231
232procedure TStereoOffCommand.Execute;
233begin
234 FStereo.Off;
235end;
236
237{ THottubOnCommand }
238
239constructor THottubOnCommand.Create(aHottub: Thottub);
240begin
241 FHottub := aHottub;
242end;
243
244procedure THottubOnCommand.Execute;
245begin
246 FHottub.Open;
247 FHottub.Heat;
248 FHottub.BubblesOpen;
249 FHottub.JetsOpen;
250end;
251
252{ THottubOffCommand }
253
254constructor THottubOffCommand.Create(aHottub: THottub);
255begin
256 FHottub := aHottub;
257end;
258
259procedure THottubOffCommand.Execute;
260begin
261 FHottub.Cool;
262 FHottub.Off;
263end;
264
265end.
1
2{《HeadFirst设计模式》之命令模式 }
3{ 本单元中的类为命令的请求者,向命令对象发出请求,}
4{ 命令对象通过委托,执行命令接收者中的动作。 }
5{ 编译工具 :Delphi7.0 }
6{ 联系方式 :guzh-0417@163.com }
7
8unit uInvoker;
9
10interface
11
12uses
13 uCommandObject;
14
15type
16 TRemoteControl = class(TObject)
17 private
18 FOnCommands : array of TCommand;
19 FOffCommands: array of TCommand;
20 FNoCommand : TCommand;
21 public
22 constructor Create;
23 destructor Destroy;
文章标题:Delphi 设计模式:《HeadFirst设计模式》Delphi7代码---命令模式之RemoteControlTest[转]
文章链接:http://soscw.com/index.php/essay/35272.html