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)
  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.

 

 

  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
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.

 

 

 1program pHomeTheaterTestDrive;
 2
 3{$APPTYPE CONSOLE}
 4
 5uses
 6  SysUtils,
 7  uFacadeObject in 'uFacadeObject.pas',
 8  uSubObject in 'uSubObject.pas';
 9
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.

 

运行结果：