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.

运行结果：

 
 

Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---门面模式之HomeTheater[转]的更多相关文章

  1. Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---工厂模式之简单工厂

    简单工厂:工厂依据传进的参数创建相应的产品. http://www.cnblogs.com/DelphiDesignPatterns/archive/2009/07/24/1530536.html { ...

  2. Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---模板方法模式之CoffeineBeverageWithHook[转]

    模板方法模式定义了一个算法骨架,允许子类对算法的某个或某些步骤进行重写(override).   1   2{<HeadFirst设计模式>之模板方法模式 }   3{ 编译工具: Del ...

  3. Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---迭代器模式之DinerMenu[转]

    容器的主要职责有两个:存放元素和浏览元素.根据单一职责原则(SRP)要将二者分开,于是将浏览功能打包封装就有了迭代器. 用迭代器封装对动态数组的遍历:  1  2{<HeadFirst设计模式& ...

  4. Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---策略模式之MiniDuckSimulator[转]

     1  2{<HeadFirst设计模式>之策略模式 }  3{ 本单元中的类为策略类           }  4{ 编译工具: Delphi7.0           }  5{ E- ...

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

      1   2{<HeadFirst设计模式>之命令模式 }   3{ 本单元中的类为命令的接收者      }   4{ 编译工具 :Delphi7.0         }   5{ 联 ...

  6. Java设计模式之（九）——门面模式

    1.什么是门面模式? Provide a unified interface to a set of interfaces in a subsystem.Facade defines a higher ...

  7. Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---状态模式[转]

    {没有应用状态模式的代码} //工程文件 program Project1; {$APPTYPE CONSOLE} uses  uGumballMachine in 'uGumballMachine. ...

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

    命令模式可以很轻松的实现撤销(Undo)功能. 命令的接受者:  1unit uReceiveObject;  2  3interface  4  5type  6  TLight = class(T ...

  9. Delphi 设计模式：《HeadFirst设计模式》Delphi代码---模式小结之一个叫声接口和几只鸭子[转]

    一.一个叫声接口和几只鸭子 从一个叫声接口开始. {<HeadFirst设计模式>Delphi代码之模式小结 } { 一个叫声接口                            } ...

随机推荐

  1. LoadRunner内部结构（2）

    LoadRunner内部结构(2) 接着(1)的内容: 17.默认的LRReport文件夹创建在本地分析机器的My Documents文件夹下来存储分析会话文件. 18.可以使用HTML格式 19.格 ...

  2. python requests 高级用法

    高级用法 本篇文档涵盖了 Requests 的一些高级特性. 会话对象 会话对象让你能够跨请求保持某些参数.它也会在同一个 Session 实例发出的所有请求之间保持 cookie, 期间使用 url ...

  3. 二分+2-sat——hdu3062

    hdu3622升级版 注意要保留两位小数 /* 给定n对圆心(x,y),要求从每对里找到一个点画圆,不可相交 使得最小半径最大 二分答案,设最小半径为r 然后两两配对一次进行判断,在2-sat上连边即 ...

  4. LUOGU P4777 【模板】扩展中国剩余定理（EXCRT）

    传送门 解题思路 扩展 $crt​$,就是中国剩余定理在模数不互质的情况下,首先对于方程 ​     $\begin{cases} x\equiv a_1\mod m_1\\x\equiv a_2\m ...

  5. atoi和itoa函数的实现方法

    atoi的实现: #include<iostream> using namespace std; int atio1(char *s) { int sign=1,num=0; if(*s= ...

  6. sip会话流程以及sip介绍（2）

    下面我们通过一个简单的场景例子来简单介绍一下 SIP 会话流程. Tom 和 Jerry 是非常好的伙伴,Tom 在他的 PC 上使用一个 SIP 的应用程序呼叫 Internet 上另一个 SIP ...

  7. 凉凉了，Eureka 2.x 停止维护，Spring Cloud 何去何从？

    今年 Dubbo 活了,并且被 Apache 收了.同时很不幸,Spring Cloud 下的 Netflix Eureka 组件项目居然宣布停止开发了.. 已经从 Dubbo 迁移至 Spring ...

  8. STL与泛型编程-练习2-GeekBand

    练习题目: struct Programmer{ Programmer(const int id, const std::wstring name): Id(id), Name(name){ } vo ...

  9. 2018-8-10-win10-uwp-手把手教你使用-asp-dotnet-core-做-cs-程序

    title author date CreateTime categories win10 uwp 手把手教你使用 asp dotnet core 做 cs 程序 lindexi 2018-08-10 ...

  10. 2019-8-30-C#-如何在项目引用x86-x64的非托管代码

    title author date CreateTime categories C# 如何在项目引用x86 x64的非托管代码 lindexi 2019-08-30 08:53:52 +0800 20 ...