Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---门面模式之HomeTheater -优快云博客

本文链接：https://blog.youkuaiyun.com/djCode/article/details/4794365

1. 复杂的子系统

unit uSubObject; interface type { TAmplifier与TTuner，TCDPlayer，TDVDPlayer相互依赖。 } { 在TTuner等的简单实现时用不到对TAmplifier的引用， } { 但现实生活中就应该让TAmplifier提供服务，所以这里保留了。 } { TProjector对TDVDPlayer的引用也是同样道理。 } { 前置TAmplifier也可以，把TAmplifier的声明放在TTuner等声明的后面 } TTuner = class; TCDPlayer = class; TDVDPlayer = class; TAmplifier = class(TObject) private FTuner: TTuner; FCD : TCDPlayer; FDVD: TDVDPlayer; FDescription: String; public constructor Create(aDescription: String); procedure Open; procedure Off; procedure SetStereoSound; procedure SetSurroundSound; procedure SetVolume(aLevel: Integer); procedure SetTuner (aTuner: TTuner); procedure SetCD (aCD : TCDPlayer); procedure SetDVD(aDVD: TDVDPlayer); function ToString: String; end; TTuner = class(TObject) private FAmplifier: TAmplifier; FDescription: String; FFrequency: Double; public constructor Create(aDescription: String; aAmplifier: TAmplifier); procedure Open; procedure Off; procedure SetAm; procedure SetFm; procedure SetFrequency(aFrequency: Double); function ToString: String; end; TCDPlayer = class(TObject) private FAmplifier: TAmplifier; FDescription: String; FCurrentTrack: Integer; FTitle: String; public constructor Create(aDescription: String; aAmplifier: TAmplifier); procedure Open; procedure Off; procedure Eject; procedure Play(aTitle: String ); overload; procedure Play(aTrack: Integer); overload; procedure Stop; procedure Pause; function ToString: String; end; TDVDPlayer = class(TObject) private FAmplifier: TAmplifier; FDescription: String; FCurrentTrack: Integer; FMovie: String; public constructor Create(aDescription: String; aAmplifier: TAmplifier); procedure Open; procedure Off; procedure Eject; procedure Play(aMovie: String ); overload; procedure Play(aTrack: Integer); overload; procedure Stop; procedure Pause; procedure SetTwoChannelAudio; procedure SetSurroundAudio; function ToString: String; end; TScreen = class(TObject) private FDescription: String; public constructor Create(aDescription: String); procedure UP; procedure Down; function ToString: String; end; TPopcornPopper = class(TObject) private FDescription: String; public constructor Create(aDescription: String); procedure Open; procedure Off; procedure Pop; function ToString: String; end; TTheaterLights = class(TObject) private FDescription: String; public constructor Create(aDescription: String); procedure Open; procedure Off; procedure Dim(aLevel: Integer); function ToString: String; end; TProjector = class(TObject) private FDescription: String; FDVD: TDVDPlayer; public constructor Create(aDescription: String; aDVD: TDVDPlayer); procedure Open; procedure Off; procedure WideScreenMode; procedure TVMode; function ToString: String; end; implementation { TAmplifier } constructor TAmplifier.Create(aDescription: String); begin FDescription := aDescription; end; procedure TAmplifier.Off; begin Writeln(FDescription + ' off'); end; procedure TAmplifier.Open; begin Writeln(FDescription + ' on'); end; procedure TAmplifier.SetCD(aCD: TCDPlayer); begin Writeln(FDescription + ' setting CD player to ' + aCD.ToString); FCD := aCD; end; procedure TAmplifier.SetDVD(aDVD: TDVDPlayer); begin Writeln(FDescription + ' setting DVD player to ' + aDVD.ToString); FDVD := aDVD; end; procedure TAmplifier.SetStereoSound; begin Writeln(FDescription + ' stereo mode on'); end; procedure TAmplifier.SetSurroundSound; begin Writeln(FDescription + ' surround sound on (5 speakers, 1 subwoofer)'); end; procedure TAmplifier.SetTuner(aTuner: TTuner); begin Writeln(FDescription + ' setting Tuner player to ', aTuner.ToString); FTuner := aTuner; end; procedure TAmplifier.SetVolume(aLevel: Integer); begin Writeln(FDescription + ' setting volume to ' , aLevel); end; function TAmplifier.ToString: String; begin Result := FDescription; end; { TTuner } constructor TTuner.Create(aDescription: String; aAmplifier: TAmplifier); begin FDescription := aDescription; FAmplifier := aAmplifier; end; procedure TTuner.Off; begin Writeln(FDescription + ' off'); end; procedure TTuner.Open; begin Writeln(FDescription + ' on'); end; procedure TTuner.SetAm; begin Writeln(FDescription + ' setting AM mode'); end; procedure TTuner.SetFm; begin Writeln(FDescription + ' setting FM mode'); end; procedure TTuner.SetFrequency(aFrequency: Double); begin Writeln(FDescription + ' setting frequency to ', aFrequency); FFrequency := aFrequency; end; function TTuner.ToString: String; begin Result := FDescription; end; { TCDPlayer } constructor TCDPlayer.Create(aDescription: String; aAmplifier: TAmplifier); begin FDescription := aDescription; FAmplifier := aAmplifier; end; procedure TCDPlayer.Eject; begin FTitle := ''; Writeln(FDescription + ' eject'); end; procedure TCDPlayer.Off; begin Writeln(FDescription + ' off'); end; procedure TCDPlayer.Open; begin Writeln(FDescription + ' on'); end; procedure TCDPlayer.Pause; begin Writeln(FDescription + ' paused <' + FTitle + '>'); end; procedure TCDPlayer.Play(aTitle: String); begin FTitle := aTitle; FCurrentTrack := 0; Writeln(FDescription + ' playing <' + FTitle + '>'); end; procedure TCDPlayer.Play(aTrack: Integer); begin if FTitle = '' then begin Writeln(FDescription + ' can'' t play track ', aTrack, ', no CD inserted'); end else begin FCurrentTrack := aTrack; Writeln(FDescription + ' playing track ', FCurrentTrack); end; end; procedure TCDPlayer.Stop; begin FCurrentTrack := 0; Writeln(FDescription + ' stopped'); end; function TCDPlayer.ToString: String; begin Result := FDescription; end; { TDVDPlayer } constructor TDVDPlayer.Create(aDescription: String; aAmplifier: TAmplifier); begin FDescription := aDescription; FAmplifier := aAmplifier; end; procedure TDVDPlayer.Eject; begin Writeln(FDescription + ' eject'); end; procedure TDVDPlayer.Off; begin Writeln(FDescription + ' off'); end; procedure TDVDPlayer.Open; begin Writeln(FDescription + ' on'); end; procedure TDVDPlayer.Pause; begin Writeln(FDescription + ' paused <' + FMovie + '>'); end; procedure TDVDPlayer.Play(aTrack: Integer); begin if FMovie = '' then begin Writeln(FDescription + ' can'' t play track ', aTrack, ', no DVD inserted'); end else begin FCurrentTrack := aTrack; Writeln(FDescription + ' playing track ', FCurrentTrack, ' of <', FMovie, '>'); end; end; procedure TDVDPlayer.Play(aMovie: String); begin FMovie := aMovie; FCurrentTrack := 0; Writeln(FDescription + ' playing <' + FMovie + '>'); end; procedure TDVDPlayer.SetSurroundAudio; begin Writeln(FDescription + ' set surround audio'); end; procedure TDVDPlayer.SetTwoChannelAudio; begin Writeln(FDescription + ' set two channel audio'); end; procedure TDVDPlayer.Stop; begin FCurrentTrack := 0; Writeln(FDescription + ' <' + FMovie + '> stopped'); end; function TDVDPlayer.ToString: String; begin Result := FDescription; end; { TScreen } constructor TScreen.Create(aDescription: String); begin FDescription := aDescription; end; procedure TScreen.Down; begin Writeln(FDescription, ' going down'); end; function TScreen.ToString: String; begin Result := FDescription; end; procedure TScreen.UP; begin Writeln(FDescription, ' going up'); end; { TPopcornPopper } constructor TPopcornPopper.Create(aDescription: String); begin FDescription := aDescription; end; procedure TPopcornPopper.Off; begin Writeln(FDescription, ' off'); end; procedure TPopcornPopper.Open; begin Writeln(FDescription, ' on'); end; procedure TPopcornPopper.Pop; begin Writeln(FDescription, ' popping popcorn!'); end; function TPopcornPopper.ToString: String; begin Result := FDescription; end; { TTheaterLights } constructor TTheaterLights.Create(aDescription: String); begin FDescription := aDescription; end; procedure TTheaterLights.Dim(aLevel: Integer); begin Writeln(FDescription, ' dimming to ', aLevel, '%'); end; procedure TTheaterLights.Off; begin Writeln(FDescription, ' off'); end; procedure TTheaterLights.Open; begin Writeln(FDescription, ' on'); end; function TTheaterLights.ToString: String; begin Result := FDescription; end; { TProjector } constructor TProjector.Create(aDescription: String; aDVD: TDVDPlayer); begin FDescription := aDescription; FDVD := aDVD; end; procedure TProjector.Off; begin Writeln(FDescription, ' off'); end; procedure TProjector.Open; begin Writeln(FDescription, ' on'); end; function TProjector.ToString: String; begin Result := FDescription; end; procedure TProjector.TVMode; begin Writeln(FDescription + ' in tv mode (4x3 aspect ratio)'); end; procedure TProjector.WideScreenMode; begin Writeln(FDescription + ' in widescreen mode (16x9 aspect ratio)'); end; end.

2.简洁的门面接口

unit uFacadeObject; interface uses uSubObject; type THomeTheaterFacade = class(TObject) private FAmp: TAmplifier; FTuner: TTuner; FDVD: TDVDPlayer; FCD: TCDPlayer; FProjector: TProjector; FLights: TTheaterLights; FScreen: TScreen; FPopper: TPopcornPopper; public constructor Create(aAmp : TAmplifier; aTuner : TTuner; aDVD : TDVDPlayer; aCD : TCDPlayer; aProjector: TProjector; aLights: TTheaterLights; aScreen: TScreen; aPopper: TPopcornPopper); procedure WatchMovie(aMovie: String); procedure EndMovie; procedure ListenToCD(CDTitle: String); procedure EndCD; procedure ListenToRadio(aFrequency: Double); procedure EndRadio; end; implementation { THomeTheaterFacade } constructor THomeTheaterFacade.Create(aAmp : TAmplifier; aTuner : TTuner; aDVD : TDVDPlayer; aCD : TCDPlayer; aProjector: TProjector; aLights: TTheaterLights; aScreen: TScreen; aPopper: TPopcornPopper); begin FAmp := aAmp; FTuner := aTuner; FDVD := aDVD; FCD := aCD; FProjector := aProjector; FLights := aLights; FScreen := aScreen; FPopper := aPopper; end; procedure THomeTheaterFacade.EndCD; begin Writeln('Shutting down CD '); FAmp.Off; FAmp.SetCD(FCD); FCD.Eject; FCD.Off; end; procedure THomeTheaterFacade.EndMovie; begin Writeln('Shutting movie theater down '); FPopper.Off; FLights.Open; FScreen.UP; FProjector.Off; FAmp.Off; FDVD.Stop; FDVD.Eject; FDVD.Off; end; procedure THomeTheaterFacade.EndRadio; begin Writeln('Shutting down the tuner '); FTuner.Off; FAmp.Off; end; procedure THomeTheaterFacade.ListenToCD(CDTitle: String); begin Writeln('Get ready for an audiopile experence '); FLights.Open; FAmp.Open; FAmp.SetVolume(5); FAmp.SetCD(FCD); FAmp.SetStereoSound; FCD.Open; FCD.Play(CDTitle); end; procedure THomeTheaterFacade.ListenToRadio(aFrequency: Double); begin Writeln('Tuning in the airwaves '); FTuner.Open; FTuner.SetFrequency(aFrequency); FAmp.Open; FAmp.SetVolume(5); FAmp.SetTuner(FTuner); end; procedure THomeTheaterFacade.WatchMovie(aMovie: String); begin Writeln('Get ready to watch a movie '); FPopper.Open; FPopper.Pop; FLights.Dim(10); FScreen.Down; FProjector.Open; FProjector.WideScreenMode; FAmp.Open; FAmp.SetDVD(FDVD); FAmp.SetSurroundSound; FAmp.SetVolume(5); FDVD.Open; FDVD.Play(aMovie); end; end.

3.客户端

program pHomeTheaterTestDrive; {$APPTYPE CONSOLE} uses SysUtils, uFacadeObject in 'uFacadeObject.pas', uSubObject in 'uSubObject.pas'; var Amp : TAmplifier; Tuner : TTuner; DVD : TDVDPlayer; CD : TCDPlayer; Projector: TProjector; Lights: TTheaterLights; Screen: TScreen; Popper: TPopcornPopper; HomeTheater: THomeTheaterFacade; begin Amp := TAmplifier.Create('Top-O-Line Amplifier'); Tuner := TTuner.Create('Top-O-Line AM/FM Tuner', Amp); DVD := TDVDPlayer.Create('Top-O-Line DVD Player', Amp); CD := TCDPlayer.Create('Top-O-Line CD Player', Amp); Projector := TProjector.Create('Top-O-Line Projector', DVD); Lights := TTheaterLights.Create('Theater Ceiling Lights'); Screen := TScreen.Create('Theater Screen'); Popper := TPopcornPopper.Create('Popcorn Popper'); HomeTheater := THomeTheaterFacade.Create(Amp, Tuner, DVD, CD, Projector, Lights, Screen, Popper); HomeTheater.WatchMovie('Raiders of the Lost Ark'); Writeln; HomeTheater.EndMovie; FreeAndNil(Amp); FreeAndNil(Tuner); FreeAndNil(DVD); FreeAndNil(CD); FreeAndNil(Projector); FreeAndNil(Lights); FreeAndNil(Screen); FreeAndNil(Popper); FreeAndNil(HomeTheater); Readln; end.

运行结果：