1

 2{《HeadFirst设计模式》之策略模式 }

 3{ 本单元中的类为策略类           }

 4{ 编译工具: Delphi7.0           }

 5{ E-Mail : guzh-0417@163.com   }

 6

 7unit uStrategy;

 8

 9interface

10

11type

12  {飞行接口，及其实现类 }

13

14  IFlyBehavior = Interface(IInterface)

15    procedure Fly;

16  end;

17

18  TFlyWithWings = class(TInterfacedObject, IFlyBehavior)

19  public

20    procedure Fly;

21  end;

22

23  TFlyNoWay = class(TInterfacedObject, IFlyBehavior)

24  public

25    procedure Fly;

26  end;

27

28  TFlyRocketPowered = class(TInterfacedObject, IFlyBehavior)

29  public

30    procedure Fly;

31  end;

32

33  {叫声接口，及其实现类}

34

35  IQuackBehavior = Interface(IInterface)

36    procedure Quack;

37  end;

38

39  TQuack = class(TInterfacedObject, IQuackBehavior)

40  public

41    procedure Quack;

42  end;

43

44  TMuteQuack = class(TInterfacedObject, IQuackBehavior)

45  public

46    procedure Quack;

47  end;

48

49  TSqueak = class(TInterfacedObject, IQuackBehavior)

50  public

51    procedure Quack;

52  end;

53

54implementation

55

56{ TFlyWithWings }

57

58procedure TFlyWithWings.Fly;

59begin

60  Writeln('I am flying!');

61end;

62

63{ TFlyNoWay }

64

65procedure TFlyNoWay.Fly;

66begin

67  Writeln('I can not fly!');

68end;

69

70{ TFlyRocketPowered }

71

72procedure TFlyRocketPowered.Fly;

73begin

74  Writeln('I am flying with a rocket!');

75end;

76

77{ TQuack }

78

79procedure TQuack.Quack;

80begin

81  Writeln('Quack');

82end;

83

84{ TMuteQuack }

85

86procedure TMuteQuack.Quack;

87begin

88  Writeln('<Silence>');

89end;

90

91{ TSqueak }

92

93procedure TSqueak.Quack;

94begin

95  Writeln('Squeak');

96end;

97

98end.

  1

  2{《HeadFirst设计模式》之策略模式           }

  3{ 本单元中的类为策略的用户，                }

  4{ 一般策略模式中的上下文接口已包含在用户类中。}

  5{ 编译工具: Delphi7.0                     }

  6{ E-Mail : guzh-0417@163.com             }

  7

  8unit uDuck;

  9

 10interface

 11

 12uses

 13  uStrategy;

 14

 15type

 16  { 鸭子抽象类 }

 17

 18  TDuck = class(TObject)

 19  protected

 20    FFlyBehavior  : IFlyBehavior;

 21    FQuackBehavior: IQuackBehavior;

 22  public

 23    procedure Display; virtual; abstract;

 24    procedure PerformFly;

 25    procedure PerformQuack;

 26    procedure Swim;

 27    procedure SetFlyBehavior(FlyBehavior: IFlyBehavior);

 28    procedure SetQuackBehavior(QuackBehavior: IQuackBehavior);

 29  end;

 30

 31  { 绿头鸭具体类 }

 32

 33  TMallardDuck = class(TDuck)

 34  public

 35    constructor Create;

 36    destructor Destroy; override;

 37    procedure Display; override;

 38  end;

 39

 40  { 模型鸭具体类 }

 41  

 42  TModelDuck = class(TDuck)

 43  public

 44    constructor Create;

 45    destructor Destroy; override;

 46    procedure Display; override;

 47  end;

 48

 49implementation

 50

 51{ TDuck }

 52

 53procedure TDuck.PerformFly;

 54begin

 55  FFlyBehavior.Fly;

 56end;

 57

 58procedure TDuck.PerformQuack;

 59begin

 60  FQuackBehavior.Quack;

 61end;

 62

 63procedure TDuck.SetFlyBehavior(FlyBehavior: IFlyBehavior);

 64begin

 65  FFlyBehavior := FlyBehavior;

 66end;

 67

 68procedure TDuck.SetQuackBehavior(QuackBehavior: IQuackBehavior);

 69begin

 70  FQuackBehavior := QuackBehavior;

 71end;

 72

 73procedure TDuck.Swim;

 74begin

 75  Writeln('All ducks float, even decoys!');

 76end;

 77

 78{ TMallardDuck }

 79

 80constructor TMallardDuck.Create;

 81begin

 82  FQuackBehavior := TQuack.Create;

 83  FFlyBehavior   := TFlyWithWings.Create;

 84end;

 85

 86destructor TMallardDuck.Destroy;

 87begin

 88  FQuackBehavior := nil;

 89  FFlyBehavior   := nil;

 90  inherited;

 91end;

 92

 93procedure TMallardDuck.Display;

 94begin

 95  Writeln('I am a real mallard duck');

 96end;

 97

 98{ TModelDuck }

 99

100constructor TModelDuck.Create;

101begin

102  FFlyBehavior   := TFlyNoWay.Create;

103  FQuackBehavior := TQuack.Create;

104end;

105

106destructor TModelDuck.Destroy;

107begin

108  FQuackBehavior := nil;

109  FFlyBehavior   := nil;

110  inherited;

111end;

112

113procedure TModelDuck.Display;

114begin

115  Writeln('I am a model duck');

116end;

117

118end.

119 

 1

 2{《HeadFirst设计模式》之策略模式 }

 3{ 客户端                       }

 4{ 编译工具: Delphi7.0          }

 5{ E-Mail : guzh-0417@163.com  }

 6

 7program pMiniDuckSimulator;

 8

 9{$APPTYPE CONSOLE}

10

11uses

12  SysUtils,

13  uDuck in 'uDuck.pas',

14  uStrategy in 'uStrategy.pas';

15

16var

17  Mallard: TDuck;

18  Model  : TDuck;

19  FlyRocketPowered: IFlyBehavior;

20  

21begin

22  Mallard := TMallardDuck.Create;

23  Mallard.PerformQuack;

24  Mallard.PerformFly;

25  FreeAndNil(Mallard);

26

27  Model := TModelDuck.Create;

28  Model.PerformFly;

29

30  FlyRocketPowered := TFlyRocketPowered.Create;

31  Model.SetFlyBehavior(FlyRocketPowered);

32  Model.PerformFly;

33  FlyRocketPowered := nil;

34  FreeAndNil(Model);

35

36  Readln;

37end.

运行结果：