Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---命令模式之RemoteControlTest[转]

  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; override;
24    procedure SetCommand(aSlot: Integer; aOnCommand, aOffCommand: TCommand);
25    procedure OnButtonWasPressed(aSlot: Integer);
26    procedure OffButtonWasPressed(aSlot: Integer);
27  end;
28
29implementation
30
31{ TRemoteControl }
32
33constructor TRemoteControl.Create;
34var
35  i: Integer;
36begin
37  SetLength(FOnCommands,  7);
38  SetLength(FOffCommands, 7);
39
40  FNoCommand := TNoCommand.Create;
41  for i := 0 to 6 do
42  begin
43    FOnCommands [i] := FNoCommand;
44    FOffCommands[i] := FNoCommand;
45  end;
46end;
47
48destructor TRemoteControl.Destroy;
49begin
50  FNoCommand.Free;
51  inherited;
52end;
53
54procedure TRemoteControl.OffButtonWasPressed(aSlot: Integer);
55begin
56  FOffCommands[aSlot].Execute;
57end;
58
59procedure TRemoteControl.OnButtonWasPressed(aSlot: Integer);
60begin
61  FOnCommands [aSlot].Execute;
62end;
63
64procedure TRemoteControl.SetCommand(aSlot: Integer; aOnCommand, aOffCommand: TCommand);
65begin
66  FOnCommands [aSlot] := aOnCommand;
67  FOffCommands[aSlot] := aOffCommand;
68end;
69
70end.

 1
 2{《HeadFirst设计模式》之命令模式 }
 3{ 客户端负责创建具体的命令对象   }
 4{ 编译工具 ：Delphi7.0           }
 5{ 联系方式 ：guzh-0417@163.com   }
 6
 7program pRemoteControlTest;
 8
 9{$APPTYPE CONSOLE}
10
11uses
12  uReceiveObject in 'uReceiveObject.pas',
13  uCommandObject in 'uCommandObject.pas',
14  uInvoker in 'uInvoker.pas';
15
16var
17  RemoteControl  : TRemoteControl;
18
19  LivingRoomLight: TLight;
20  KitchenLight   : TLight;
21  CeilingFan     : TCeilingFan;
22  GarageDoor     : TGarageDoor;
23  Stereo         : TStereo;
24
25  LivingRoomLightOnCommand : TLightOnCommand;
26  LivingRoomLightOffCommand: TLightOffCommand;
27  KitchenLightOnCommand    : TLightOnCommand;
28  KitchenLightOffCommand   : TLightOffCommand;
29
30  CeilingFanOnCommand      : TCeilingFanOnCommand;
31  CeilingFanOffCommand     : TCeilingFanOffCommand;
32
33  GarageDoorUpCommand      : TGarageDoorUpCommand;
34  GarageDoorDownCommand    : TGarageDoorDownCommand;
35
36  StereoOnWithCDCommand    : TStereoOnWithCDCommand;
37  StereoOffCommand         : TStereoOffCommand;
38
39begin
40  RemoteControl   := TRemoteControl.Create;
41
42  LivingRoomLight := TLight.Create('Living Room');
43  KitchenLight    := TLight.Create('Kitchen');
44  CeilingFan      := TCeilingFan.Create('Living Room ');
45  GarageDoor      := TGarageDoor.Create('');;
46  Stereo          := TStereo.Create('Living Room');
47
48  LivingRoomLightOnCommand  := TLightOnCommand.Create(LivingRoomLight);
49  LivingRoomLightOffCommand := TLightOffCommand.Create(LivingRoomLight);
50  KitchenLightOnCommand     := TLightOnCommand.Create(KitchenLight);
51  KitchenLightOffCommand    := TLightOffCommand.Create(KitchenLight);
52
53  CeilingFanOnCommand       := TCeilingFanOnCommand.Create(CeilingFan);
54  CeilingFanOffCommand      := TCeilingFanOffCommand.Create(CeilingFan);
55
56  GarageDoorUpCommand       := TGarageDoorUpCommand.Create(GarageDoor);
57  GarageDoorDownCommand     := TGarageDoorDownCommand.Create(GarageDoor);
58
59  StereoOnWithCDCommand     := TStereoOnWithCDCommand.Create(Stereo);
60  StereoOffCommand          := TStereoOffCommand.Create(Stereo);
61
62  RemoteControl.SetCommand(0, LivingRoomLightOnCommand, LivingRoomLightOffCommand);
63  RemoteControl.SetCommand(1, KitchenLightOnCommand, KitchenLightOffCommand);
64  RemoteControl.SetCommand(2, CeilingFanOnCommand, CeilingFanOffCommand);
65  RemoteControl.SetCommand(3, StereoOnWithCDCommand, StereoOffCommand);
66  RemoteControl.SetCommand(4, GarageDoorUpCommand, GarageDoorDownCommand);
67
68  RemoteControl.OnButtonWasPressed (0);
69  RemoteControl.OffButtonWasPressed(0);
70  RemoteControl.OnButtonWasPressed (1);
71  RemoteControl.OffButtonWasPressed(1);
72  RemoteControl.OnButtonWasPressed (2);
73  RemoteControl.OffButtonWasPressed(2);
74  RemoteControl.OnButtonWasPressed (3);
75  RemoteControl.OffButtonWasPressed(3);
76  RemoteControl.OnButtonWasPressed (4);
77  RemoteControl.OffButtonWasPressed(4);
78
79  RemoteControl.Free;
80  LivingRoomLight.Free;
81  KitchenLight.Free;
82  CeilingFan.Free;
83  GarageDoor.Free;
84  Stereo.Free;
85  LivingRoomLightOnCommand.Free;
86  LivingRoomLightOffCommand.Free;
87  KitchenLightOnCommand.Free;
88  KitchenLightOffCommand.Free;
89  CeilingFanOnCommand.Free;
90  CeilingFanOffCommand.Free;
91  GarageDoorUpCommand.Free;
92  GarageDoorDownCommand.Free;
93  StereoOnWithCDCommand.Free;
94  StereoOffCommand.Free;
95
96  Readln;
97end.

运行结果：