HeadFirst设计模式——delphi版

unit Duck;

interface
type
    IDUCK = interface
    ['{E38F898D-2EA0-4995-8F8C-1886752E6BFB}']

    procedure quack;
    procedure fly;
end;

type ITurkey = interface
   ['{FB98F4F2-2243-4450-AA5C-9114A2E088E5}']
   	procedure gobble;
	  procedure fly;
end;

implementation

end.

unit WildTurkey;

interface
uses Duck;
type
  TWildTurkey = class(TInterfacedObject, ITurkey)
	public
    procedure gobble; {
		System.out.println("Gobble gobble");
	}

	  procedure fly; {
		System.out.println("I'm flying a short distance");
	}

  end;
implementation

  procedure TWildTurkey.gobble;
  begin
     writeln('Gobble gobble');
  end;


  procedure TWildTurkey.fly;
  begin
    writeln('I am flying a short distance');
  end;


end.

program DuckTestDrive;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  Duck in 'Duck.pas',
  DuckAdapter in 'DuckAdapter.pas',
  WildTurkey in 'WildTurkey.pas',
  TurkeyAdapter in 'TurkeyAdapter.pas',
  MallardDuck in 'MallardDuck.pas';

var
  gDuck: TMallardDuck;
  gTurkey : TWildTurkey;
  gTurkeyAdapter: IDUCK;
  gI: Integer;

  procedure testDuck(aDuck: IDuck);
  begin
    aDuck.quack;
		aDuck.fly;
  end;


begin
  try
    { TODO -oUser -cConsole Main : Insert code here }
     gDuck := TMallardDuck.Create;
		 gTurkey := TWildTurkey.Create;
     gTurkeyAdapter := TTurkeyAdapter.Create(gTurkey);

		 writeln('The Turkey says...');
		 gturkey.gobble();
		 gturkey.fly();

		 writeln(#10'The Duck says...');
		 testDuck(gduck);

		 writeln(#10'The TurkeyAdapter says...');
		 testDuck(gTurkeyAdapter);

    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.