1
 2{《HeadFirst设计模式》Delphi代码之模式小结 }
 3{ 几只鸭子实现了声接口                    }
 4{ 编译工具：Delphi2010 for win32         }
 5{ E-Mail ：guzh-0417@163.com            }
 6
 7unit uDuck;
 8
 9interface
10
11uses
12  uQuackable;
13
14type
15  TMallardDuck = class(TInterfacedObject, IQuackable)
16  public
17    procedure Quack;
18  end;
19
20  TRedHeadDuck = class(TInterfacedObject, IQuackable)
21  public
22    procedure Quack;
23  end;
24
25  TDuckCall = class(TInterfacedObject, IQuackable)
26  public
27    procedure Quack;
28  end;
29
30  TRubberDuck = class(TInterfacedObject, IQuackable)
31  public
32    procedure Quack;
33  end;
34
35implementation
36
37{ TMallardDuck }
38
39procedure TMallardDuck.Quack;
40begin
41  Writeln('Quack');
42end;
43
44{ TRedHeadDuck }
45
46procedure TRedHeadDuck.Quack;
47begin
48  Writeln('Quack');
49end;
50
51{ TDuckCall }
52
53procedure TDuckCall.Quack;
54begin
55  Writeln('Kwak');
56end;
57
58{ TRubberDuck }
59
60procedure TRubberDuck.Quack;
61begin
62  Writeln('Squeak');
63end;
64
65end.

 1
 2{《HeadFirst设计模式》Delphi代码之模式小结 }
 3{ 鸭鸣模拟器                             }
 4{ 编译工具：Delphi2010 for win32         }
 5{ E-Mail ：guzh-0417@163.com            }
 6
 7unit uDuckSimulator;
 8
 9interface
10
11uses
12  uQuackable, uDuck;
13
14type
15  TDuckSimulator = class(TObject)
16  private
17    procedure Simulate(aDuck: IQuackable); overload;
18  public
19    procedure Simulate; overload;
20  end;
21
22implementation
23
24{ TDuckSimulator }
25
26procedure TDuckSimulator.Simulate(aDuck: IQuackable); { 此处交给多态处理 }
27begin
28  aDuck.Quack;
29end;
30
31procedure TDuckSimulator.Simulate;
32var
33  aMallardDuck: IQuackable;
34  aRedHeadDuck: IQuackable;
35  aDuckCall   : IQuackable;
36  aRubberDuck : IQuackable;
37begin
38  try
39    { 创建鸭鸣实例 }
40    aMallardDuck := TMallardDuck.Create;
41    aRedHeadDuck := TRedHeadDuck.Create;
42    aDuckCall    := TDuckCall.Create;
43    aRubberDuck  := TRubberDuck.Create;
44
45    Writeln('Duck Simulator');
46
47    { 模拟鸭鸣 }
48    Simulate(aMallardDuck);
49    Simulate(aRedHeadDuck);
50    Simulate(aDuckCall);
51    Simulate(aRubberDuck );
52  finally
53    aMallardDuck := nil;
54    aRedHeadDuck := nil;
55    aDuckCall    := nil;
56    aRubberDuck  := nil;
57  end;
58end;
59
60end.

 1
 2{《HeadFirst设计模式》Delphi代码之模式小结 }
 3{ 客户端                                   }
 4{ 编译工具：Delphi2010 for win32           }
 5{ E-Mail ：guzh-0417@163.com               }
 6
 7program pDuckSimulator;
 8
 9{$APPTYPE CONSOLE}
10
11uses
12  uDuck in 'uDuck.pas',
13  uDuckSimulator in 'uDuckSimulator.pas',
14  uQuackable in 'uQuackable.pas';
15
16var
17  aSimulator: TDuckSimulator;
18
19begin
20  aSimulator := TDuckSimulator.Create;
21
22  aSimulator.Simulate;
23
24  aSimulator.Free;
25
26  Readln;
27end.