Delphi 设计模式：《HeadFirst设计模式》Delphi7代码---适配器模式之TurkeyAdapter

     适配器模式的主要意图是对现有类的接口进行转换，以满足目标类的需求。其次，可以给目标类的接口添加新的行为（主要指方法）。这一点容易与装饰模式混淆。从意图方面来看，装饰模式不改变（通常指增加）接口中的行为（主要指方法），而是在原有行为（主要指方法）的基础上添加新的功能；从类结构方面来看，装饰模式中的装饰者既继承又组合被装饰者。类适配器同时继承现有类和目标类，对象适配器继承目标类组合现有类。

 

1.现有类，被转换接口者

{《HeadFirst设计模式》之适配器模式 } { 现有类 } { 编译工具：Delphi7.0 } { E-Mail ：xshlife@163.com } unit uAdaptee; interface type TTurkey = class(TObject) public procedure Gobble; virtual; abstract; procedure Fly; virtual; abstract; end; TWildTurkey = class(TTurkey) public procedure Gobble; override; procedure Fly; override; end; implementation { TWildTurkey } procedure TWildTurkey.Fly; begin Writeln('I''m flying a short distance.'); end; procedure TWildTurkey.Gobble; begin Writeln('Gobble gobble.'); end; end.

2.目标类

{《HeadFirst设计模式》之适配器模式 } { 目标类 } { 编译工具：Delphi7.0 } { E-Mail ：xshlife@163.com } unit uTarget; interface type TDuck = class(TObject) public procedure Quack; virtual; abstract; procedure Fly; virtual; abstract; end; TMallarDuck = class(TDuck) public procedure Quack; override; procedure Fly; override; end; implementation { TMallarDuck } procedure TMallarDuck.Fly; begin Writeln('I''m flying.'); end; procedure TMallarDuck.Quack; begin Writeln('Quack.'); end; end.

3.适配器

{《HeadFirst设计模式》之适配器模式 } { 适配器，转换现有类的接口 } { 编译工具：Delphi7.0 } { E-Mail ：xshlife@163.com } unit uAdapter; interface uses uTarget, uAdaptee; type TTurkeyAdapter = class(TDuck) private FTurkey: TTurkey; public constructor Create(aTurkey: TTurkey); procedure Quack; override; procedure Fly; override; end; implementation { TTurkeyAdapter } constructor TTurkeyAdapter.Create(aTurkey: TTurkey); begin FTurkey := aTurkey; end; procedure TTurkeyAdapter.Fly; var i: Integer; begin for i := 0 to 4 do begin FTurkey.Fly; end; end; procedure TTurkeyAdapter.Quack; begin FTurkey.Gobble; end; end.

4.客户端

{《HeadFirst设计模式》之适配器模式 } { 客户端 } { 编译工具：Delphi7.0 } { E-Mail ：xshlife@163.com } program pDuckTestDrive; {$APPTYPE CONSOLE} uses SysUtils, uAdaptee in 'uAdaptee.pas', uAdapter in 'uAdapter.pas', uTarget in 'uTarget.pas'; var Duck : TMallarDuck; Turkey: TWildTurkey; TurkeyAdapter: TTurkeyAdapter; procedure TestDuck(aDuck: TDuck); begin aDuck.Quack; aDuck.Fly; end; begin Duck := TMallarDuck.Create; Turkey := TWildTurkey.Create; TurkeyAdapter := TTurkeyAdapter.Create(Turkey); Writeln('The turkey says:'); Turkey.Gobble; Turkey.Fly; Writeln; Writeln('The duck says:'); TestDuck(Duck); Writeln; Writeln('The turkeyAdapter says:'); TestDuck(TurkeyAdapter); FreeAndNil(Duck); FreeAndNil(Turkey); FreeAndNil(TurkeyAdapter); Readln; end.

运行结果：