Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---门面模式之HomeTheater[转]

  1unit uSubObject;
  2
  3interface
  4
  5type
  6
  7  { TAmplifier与TTuner，TCDPlayer，TDVDPlayer相互依赖。            }
  8  { 在TTuner等的简单实现时用不到对TAmplifier的引用，               }
  9  { 但现实生活中就应该让TAmplifier提供服务，所以这里保留了。       }
 10  { TProjector对TDVDPlayer的引用也是同样道理。                     }
 11  { 前置TAmplifier也可以，把TAmplifier的声明放在TTuner等声明的后面 }
 12
 13  TTuner     = class;
 14  TCDPlayer  = class;
 15  TDVDPlayer = class;
 16
 17  TAmplifier = class(TObject)
 18  private
 19    FTuner: TTuner;
 20    FCD : TCDPlayer;
 21    FDVD: TDVDPlayer;
 22    FDescription: String;
 23  public
 24    constructor Create(aDescription: String);
 25    procedure Open;
 26    procedure Off;
 27    procedure SetStereoSound;
 28    procedure SetSurroundSound;
 29    procedure SetVolume(aLevel: Integer);
 30    procedure SetTuner (aTuner: TTuner);
 31    procedure SetCD (aCD : TCDPlayer);
 32    procedure SetDVD(aDVD: TDVDPlayer);
 33    function ToString: String;
 34  end;
 35
 36  TTuner = class(TObject)
 37  private
 38    FAmplifier: TAmplifier;
 39    FDescription: String;
 40    FFrequency: Double;
 41  public
 42    constructor Create(aDescription: String; aAmplifier: TAmplifier);
 43    procedure Open;
 44    procedure Off;
 45    procedure SetAm;
 46    procedure SetFm;
 47    procedure SetFrequency(aFrequency: Double);
 48    function ToString: String;
 49  end;
 50
 51  TCDPlayer = class(TObject)
 52  private
 53    FAmplifier: TAmplifier;
 54    FDescription: String;
 55    FCurrentTrack: Integer;
 56    FTitle: String;
 57  public
 58    constructor Create(aDescription: String; aAmplifier: TAmplifier);
 59    procedure Open;
 60    procedure Off;
 61    procedure Eject;
 62    procedure Play(aTitle: String ); overload;
 63    procedure Play(aTrack: Integer); overload;
 64    procedure Stop;
 65    procedure Pause;
 66    function ToString: String;
 67  end;
 68
 69  TDVDPlayer = class(TObject)
 70  private
 71    FAmplifier: TAmplifier;
 72    FDescription: String;
 73    FCurrentTrack: Integer;
 74    FMovie: String;
 75  public
 76    constructor Create(aDescription: String; aAmplifier: TAmplifier);
 77    procedure Open;
 78    procedure Off;
 79    procedure Eject;
 80    procedure Play(aMovie: String ); overload;
 81    procedure Play(aTrack: Integer); overload;
 82    procedure Stop;
 83    procedure Pause;
 84    procedure SetTwoChannelAudio;
 85    procedure SetSurroundAudio;
 86    function ToString: String;
 87  end;
 88
 89  TScreen = class(TObject)
 90  private
 91    FDescription: String;
 92  public
 93    constructor Create(aDescription: String);
 94    procedure UP;
 95    procedure Down;
 96    function ToString: String;
 97  end;
 98
 99  TPopcornPopper = class(TObject)
100  private
101    FDescription: String;
102  public
103    constructor Create(aDescription: String);
104    procedure Open;
105    procedure Off;
106    procedure Pop;
107    function ToString: String;
108  end;
109
110  TTheaterLights = class(TObject)
111  private
112    FDescription: String;
113  public
114    constructor Create(aDescription: String);
115    procedure Open;
116    procedure Off;
117    procedure Dim(aLevel: Integer);
118    function ToString: String;
119  end;
120
121  TProjector = class(TObject)
122  private
123    FDescription: String;
124    FDVD: TDVDPlayer;
125  public
126    constructor Create(aDescription: String; aDVD: TDVDPlayer);
127    procedure Open;
128    procedure Off;
129    procedure WideScreenMode;
130    procedure TVMode;
131    function ToString: String;
132  end;
133
134implementation
135
136{ TAmplifier }
137
138constructor TAmplifier.Create(aDescription: String);
139begin
140  FDescription := aDescription;
141end;
142
143procedure TAmplifier.Off;
144begin
145  Writeln(FDescription + ' off');
146end;
147
148procedure TAmplifier.Open;
149begin
150  Writeln(FDescription + ' on');
151end;
152
153procedure TAmplifier.SetCD(aCD: TCDPlayer);
154begin
155  Writeln(FDescription + ' setting CD player to ' + aCD.ToString);
156  FCD := aCD;
157end;
158
159procedure TAmplifier.SetDVD(aDVD: TDVDPlayer);
160begin
161  Writeln(FDescription + ' setting DVD player to ' + aDVD.ToString);
162  FDVD := aDVD;
163end;
164
165procedure TAmplifier.SetStereoSound;
166begin
167  Writeln(FDescription + ' stereo mode on');
168end;
169
170procedure TAmplifier.SetSurroundSound;
171begin
172  Writeln(FDescription + ' surround sound on (5 speakers, 1 subwoofer)');
173end;
174
175procedure TAmplifier.SetTuner(aTuner: TTuner);
176begin
177  Writeln(FDescription + ' setting Tuner player to ', aTuner.ToString);
178  FTuner := aTuner;
179end;
180
181procedure TAmplifier.SetVolume(aLevel: Integer);
182begin
183  Writeln(FDescription +  ' setting volume to ' , aLevel);
184end;
185
186function TAmplifier.ToString: String;
187begin
188  Result := FDescription;
189end;
190
191{ TTuner }
192
193constructor TTuner.Create(aDescription: String; aAmplifier: TAmplifier);
194begin
195  FDescription := aDescription;
196  FAmplifier   := aAmplifier;
197end;
198
199procedure TTuner.Off;
200begin
201  Writeln(FDescription + ' off');
202end;
203
204procedure TTuner.Open;
205begin
206  Writeln(FDescription + ' on');
207end;
208
209procedure TTuner.SetAm;
210begin
211  Writeln(FDescription + ' setting AM mode');
212end;
213
214procedure TTuner.SetFm;
215begin
216  Writeln(FDescription + ' setting FM mode');
217end;
218
219procedure TTuner.SetFrequency(aFrequency: Double);
220begin
221  Writeln(FDescription + ' setting frequency to ', aFrequency);
222  FFrequency := aFrequency;
223end;
224
225function TTuner.ToString: String;
226begin
227  Result := FDescription;
228end;
229
230{ TCDPlayer }
231
232constructor TCDPlayer.Create(aDescription: String; aAmplifier: TAmplifier);
233begin
234  FDescription := aDescription;
235  FAmplifier   := aAmplifier;
236end;
237
238procedure TCDPlayer.Eject;
239begin
240  FTitle := '';
241  Writeln(FDescription + ' eject');
242end;
243
244procedure TCDPlayer.Off;
245begin
246  Writeln(FDescription + ' off');
247end;
248
249procedure TCDPlayer.Open;
250begin
251  Writeln(FDescription + ' on');
252end;
253
254procedure TCDPlayer.Pause;
255begin
256  Writeln(FDescription + ' paused <' + FTitle + '>');
257end;
258
259procedure TCDPlayer.Play(aTitle: String);
260begin
261  FTitle := aTitle;
262  FCurrentTrack := 0;
263  Writeln(FDescription + ' playing <' + FTitle + '>');
264end;
265
266procedure TCDPlayer.Play(aTrack: Integer);
267begin
268  if FTitle = '' then
269    begin
270      Writeln(FDescription + ' can'' t play track ', aTrack, ', no CD inserted');
271    end
272  else
273    begin
274      FCurrentTrack := aTrack;
275      Writeln(FDescription + ' playing track ', FCurrentTrack);
276    end;
277end;
278
279procedure TCDPlayer.Stop;
280begin
281  FCurrentTrack := 0;
282  Writeln(FDescription + ' stopped');
283end;
284
285function TCDPlayer.ToString: String;
286begin
287  Result := FDescription;
288end;
289
290{ TDVDPlayer }
291
292constructor TDVDPlayer.Create(aDescription: String; aAmplifier: TAmplifier);
293begin
294  FDescription := aDescription;
295  FAmplifier   := aAmplifier;
296end;
297
298procedure TDVDPlayer.Eject;
299begin
300  Writeln(FDescription + ' eject');
301end;
302
303procedure TDVDPlayer.Off;
304begin
305  Writeln(FDescription + ' off');
306end;
307
308procedure TDVDPlayer.Open;
309begin
310  Writeln(FDescription + ' on');
311end;
312
313procedure TDVDPlayer.Pause;
314begin
315  Writeln(FDescription + ' paused <' + FMovie + '>');
316end;
317
318procedure TDVDPlayer.Play(aTrack: Integer);
319begin
320  if FMovie = '' then
321    begin
322      Writeln(FDescription + ' can'' t play track ', aTrack, ', no DVD inserted');
323    end
324  else
325    begin
326      FCurrentTrack := aTrack;
327      Writeln(FDescription + ' playing track ', FCurrentTrack, ' of <', FMovie, '>');
328    end;
329end;
330
331procedure TDVDPlayer.Play(aMovie: String);
332begin
333  FMovie := aMovie;
334  FCurrentTrack := 0;
335  Writeln(FDescription + ' playing <' + FMovie + '>');
336end;
337
338procedure TDVDPlayer.SetSurroundAudio;
339begin
340  Writeln(FDescription + ' set surround audio');
341end;
342
343procedure TDVDPlayer.SetTwoChannelAudio;
344begin
345  Writeln(FDescription + ' set two channel audio');
346end;
347
348procedure TDVDPlayer.Stop;
349begin
350  FCurrentTrack := 0;
351  Writeln(FDescription + ' <' + FMovie + '> stopped');
352end;
353
354function TDVDPlayer.ToString: String;
355begin
356  Result := FDescription;
357end;
358
359{ TScreen }
360
361constructor TScreen.Create(aDescription: String);
362begin
363  FDescription := aDescription;
364end;
365
366procedure TScreen.Down;
367begin
368  Writeln(FDescription, ' going down');
369end;
370
371function TScreen.ToString: String;
372begin
373  Result := FDescription;
374end;
375
376procedure TScreen.UP;
377begin
378  Writeln(FDescription, ' going up');
379end;
380
381{ TPopcornPopper }
382
383constructor TPopcornPopper.Create(aDescription: String);
384begin
385  FDescription := aDescription;
386end;
387
388procedure TPopcornPopper.Off;
389begin
390  Writeln(FDescription, ' off');
391end;
392
393procedure TPopcornPopper.Open;
394begin
395  Writeln(FDescription, ' on');
396end;
397
398procedure TPopcornPopper.Pop;
399begin
400  Writeln(FDescription, ' popping popcorn!');
401end;
402
403function TPopcornPopper.ToString: String;
404begin
405  Result := FDescription;
406end;
407
408{ TTheaterLights }
409
410constructor TTheaterLights.Create(aDescription: String);
411begin
412  FDescription := aDescription;
413end;
414
415procedure TTheaterLights.Dim(aLevel: Integer);
416begin
417  Writeln(FDescription, ' dimming to ', aLevel, '%');
418end;
419
420procedure TTheaterLights.Off;
421begin
422  Writeln(FDescription, ' off');
423end;
424
425procedure TTheaterLights.Open;
426begin
427  Writeln(FDescription, ' on');
428end;
429
430function TTheaterLights.ToString: String;
431begin
432  Result := FDescription;
433end;
434
435{ TProjector }
436
437constructor TProjector.Create(aDescription: String; aDVD: TDVDPlayer);
438begin
439  FDescription := aDescription;
440  FDVD := aDVD;
441end;
442
443procedure TProjector.Off;
444begin
445  Writeln(FDescription, ' off');
446end;
447
448procedure TProjector.Open;
449begin
450  Writeln(FDescription, ' on');
451end;
452
453function TProjector.ToString: String;
454begin
455  Result := FDescription;
456end;
457
458procedure TProjector.TVMode;
459begin
460  Writeln(FDescription + ' in tv mode (4x3 aspect ratio)');
461end;
462
463procedure TProjector.WideScreenMode;
464begin
465  Writeln(FDescription + ' in widescreen mode (16x9 aspect ratio)');
466end;
467
468end.

 

 

  1unit uFacadeObject;
  2
  3interface
  4
  5uses
  6  uSubObject;
  7
  8type
  9  THomeTheaterFacade = class(TObject)
 10  private
 11    FAmp: TAmplifier;
 12    FTuner: TTuner;
 13    FDVD: TDVDPlayer;
 14    FCD: TCDPlayer;
 15    FProjector: TProjector;
 16    FLights: TTheaterLights;
 17    FScreen: TScreen;
 18    FPopper: TPopcornPopper;
 19  public
 20    constructor Create(aAmp   : TAmplifier;
 21                       aTuner : TTuner;
 22                       aDVD   : TDVDPlayer;
 23                       aCD    : TCDPlayer;
 24                       aProjector: TProjector;
 25                       aLights: TTheaterLights;
 26                       aScreen: TScreen;
 27                       aPopper: TPopcornPopper);
 28    procedure WatchMovie(aMovie: String);
 29    procedure EndMovie;
 30    procedure ListenToCD(CDTitle: String);
 31    procedure EndCD;
 32    procedure ListenToRadio(aFrequency: Double);
 33    procedure EndRadio;
 34  end;
 35
 36implementation
 37
 38{ THomeTheaterFacade }
 39
 40constructor THomeTheaterFacade.Create(aAmp   : TAmplifier;
 41                                      aTuner : TTuner;
 42                                      aDVD   : TDVDPlayer;
 43                                      aCD    : TCDPlayer;
 44                                      aProjector: TProjector;
 45                                      aLights: TTheaterLights;
 46                                      aScreen: TScreen;
 47                                      aPopper: TPopcornPopper);
 48begin
 49  FAmp    := aAmp;
 50  FTuner  := aTuner;
 51  FDVD    := aDVD;
 52  FCD     := aCD;
 53  FProjector := aProjector;
 54  FLights := aLights;
 55  FScreen := aScreen;
 56  FPopper := aPopper;
 57end;
 58
 59procedure THomeTheaterFacade.EndCD;
 60begin
 61  Writeln('Shutting down CD');
 62  FAmp.Off;
 63  FAmp.SetCD(FCD);
 64  FCD.Eject;
 65  FCD.Off;
 66end;
 67
 68procedure THomeTheaterFacade.EndMovie;
 69begin
 70  Writeln('Shutting movie theater down');
 71  FPopper.Off;
 72  FLights.Open;
 73  FScreen.UP;
 74  FProjector.Off;
 75  FAmp.Off;
 76  FDVD.Stop;
 77  FDVD.Eject;
 78  FDVD.Off;
 79end;
 80
 81procedure THomeTheaterFacade.EndRadio;
 82begin
 83  Writeln('Shutting down the tuner');
 84  FTuner.Off;
 85  FAmp.Off;
 86end;
 87
 88procedure THomeTheaterFacade.ListenToCD(CDTitle: String);
 89begin
 90  Writeln('Get ready for an audiopile experence');
 91  FLights.Open;
 92  FAmp.Open;
 93  FAmp.SetVolume(5);
 94  FAmp.SetCD(FCD);
 95  FAmp.SetStereoSound;
 96  FCD.Open;
 97  FCD.Play(CDTitle);
 98end;
 99
100procedure THomeTheaterFacade.ListenToRadio(aFrequency: Double);
101begin
102  Writeln('Tuning in the airwaves');
103  FTuner.Open;
104  FTuner.SetFrequency(aFrequency);
105  FAmp.Open;
106  FAmp.SetVolume(5);
107  FAmp.SetTuner(FTuner);
108end;
109
110procedure THomeTheaterFacade.WatchMovie(aMovie: String);
111begin
112  Writeln('Get ready to watch a movie');
113  FPopper.Open;
114  FPopper.Pop;
115  FLights.Dim(10);
116  FScreen.Down;
117  FProjector.Open;
118  FProjector.WideScreenMode;
119  FAmp.Open;
120  FAmp.SetDVD(FDVD);
121  FAmp.SetSurroundSound;
122  FAmp.SetVolume(5);
123  FDVD.Open;
124  FDVD.Play(aMovie);
125end;
126
127end.

 

 

 1program pHomeTheaterTestDrive;
 2
 3{$APPTYPE CONSOLE}
 4
 5uses
 6  SysUtils,
 7  uFacadeObject in 'uFacadeObject.pas',
 8  uSubObject in 'uSubObject.pas';
 9
10var
11  Amp   : TAmplifier;
12  Tuner : TTuner;
13  DVD   : TDVDPlayer;
14  CD    : TCDPlayer;
15  Projector: TProjector;
16  Lights: TTheaterLights;
17  Screen: TScreen;
18  Popper: TPopcornPopper;
19
20  HomeTheater: THomeTheaterFacade;
21   
22begin
23  Amp    := TAmplifier.Create('Top-O-Line Amplifier');
24  Tuner  := TTuner.Create('Top-O-Line AM/FM Tuner', Amp);
25  DVD    := TDVDPlayer.Create('Top-O-Line DVD Player', Amp);
26  CD     := TCDPlayer.Create('Top-O-Line CD Player', Amp);
27  Projector := TProjector.Create('Top-O-Line Projector', DVD);
28  Lights := TTheaterLights.Create('Theater Ceiling Lights');
29  Screen := TScreen.Create('Theater Screen');
30  Popper := TPopcornPopper.Create('Popcorn Popper');
31
32  HomeTheater := THomeTheaterFacade.Create(Amp, Tuner, DVD, CD, Projector,
33                                           Lights, Screen, Popper);
34
35  HomeTheater.WatchMovie('Raiders of the Lost Ark');
36  Writeln;
37  HomeTheater.EndMovie;
38
39  FreeAndNil(Amp);
40  FreeAndNil(Tuner);
41  FreeAndNil(DVD);
42  FreeAndNil(CD);
43  FreeAndNil(Projector);
44  FreeAndNil(Lights);
45  FreeAndNil(Screen);
46  FreeAndNil(Popper);
47  FreeAndNil(HomeTheater);
48
49  Readln;
50end.

 

运行结果：