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.

运行结果:

 
 

Delphi 设计模式:《HeadFirst设计模式》Delphi7代码---策略模式之MiniDuckSimulator[转]的更多相关文章

  1. Java设计模式(十二) 策略模式

    原创文章,同步发自作者个人博客,http://www.jasongj.com/design_pattern/strategy/ 策略模式介绍 策略模式定义 策略模式(Strategy Pattern) ...

  2. 设计模式之第8章-策略模式(Java实现)

    设计模式之第8章-策略模式(Java实现) “年前大酬宾了啊,现在理发冲500送300,冲1000送500了.鱼哥赶紧充钱啊,理发这事基本一个月一回,挺实惠的啊.不过话说那个理发店的老板好傻啊,冲10 ...

  3. Delphi 设计模式:《HeadFirst设计模式》Delphi7代码---工厂模式之简单工厂

    简单工厂:工厂依据传进的参数创建相应的产品. http://www.cnblogs.com/DelphiDesignPatterns/archive/2009/07/24/1530536.html { ...

  4. Delphi 设计模式:《HeadFirst设计模式》Delphi7代码---模板方法模式之CoffeineBeverageWithHook[转]

    模板方法模式定义了一个算法骨架,允许子类对算法的某个或某些步骤进行重写(override).   1   2{<HeadFirst设计模式>之模板方法模式 }   3{ 编译工具: Del ...

  5. Delphi 设计模式:《HeadFirst设计模式》Delphi7代码---迭代器模式之DinerMenu[转]

    容器的主要职责有两个:存放元素和浏览元素.根据单一职责原则(SRP)要将二者分开,于是将浏览功能打包封装就有了迭代器. 用迭代器封装对动态数组的遍历:  1  2{<HeadFirst设计模式& ...

  6. Delphi 设计模式:《HeadFirst设计模式》Delphi7代码---命令模式之RemoteControlTest[转]

      1   2{<HeadFirst设计模式>之命令模式 }   3{ 本单元中的类为命令的接收者      }   4{ 编译工具 :Delphi7.0         }   5{ 联 ...

  7. 我所理解的设计模式(C++实现)——策略模式(Strategy Pattern)

    概述: 每个人都要“交个人所得税”,但是“在美国交个人所得税”和“在中国交个人所得税”就有不同的算税方法. 而策略模式就是对算法进行包装,是把使用算法的责任和算法本身分割开来,委派给不同的对象管理.策 ...

  8. Python 中的设计模式详解之:策略模式

    虽然设计模式与语言无关,但这并不意味着每一个模式都能在每一门语言中使用.<设计模式:可复用面向对象软件的基础>一书中有 23 个模式,其中有 16 个在动态语言中“不见了,或者简化了”. ...

  9. 《JavaScript设计模式与开发实践》-- 策略模式

    详情个人博客:https://shengchangwei.github.io/js-shejimoshi-celue/ 策略模式 1.定义 策略模式:定义一系列的算法,把它们一个个封装起来,并且使它们 ...

随机推荐

  1. hdu5952 Counting Cliques 技巧dfs

    题意:一个有N个点M条边的图,球其中由S个点构成的团的个数.一个团是一个完全子图. 没有什么好办法,只有暴力深搜,但是这里有一个神奇的操作:将无向图转为有向图:当两个点编号u<v时才有边u-&g ...

  2. leetcode-137-只出现一次的数字②

    题目描述: 方法一:数学 class Solution: def singleNumber(self, nums: List[int]) -> int: return (sum(set(nums ...

  3. com.rabbitmq.client.ShutdownSignalException: channel error; protocol method: #method<channel.close>(reply-code=404, reply-text=NOT_FOUND - no queue 'springCloudBus.anonymous.6Xa99MDZTJyHKdPqMyoVEA' in

    项目启动报此异常,解决方式:用root权限登陆rabbitmq,admin处添加vhost

  4. PAT甲级——A1075 PAT Judge

    The ranklist of PAT is generated from the status list, which shows the scores of the submissions. Th ...

  5. Everything-启用http服务器(公网IP)会导致共享文件被搜索引擎搜索

    1. 漏洞利用成功的前提 公网ip 启用http服务器 2.产生原因 启用http服务器功能点:让用户在本地或局域网上的其他电脑使用浏览器进行搜索,并支持文件下载.若拥有公网IP的用户启用此功能,就是 ...

  6. [Ynoi2012]D1T1

    题目 套路的根号分治啊 我们设置一个值\(S\) 对于\(S\leq x\)的操作,我们直接暴力修改,显然这样只会修改\(\frac{n}{S}\)次,所以我们需要一个能够\(O(1)\)修改的数据结 ...

  7. 目标检测从入门到精通—SPP-Net详细解析(三)

    SPP-Net网络结构分析 Author:Mr. Sun Date:2019.03.18 Loacation: DaLian university of technology 论文名称:<Spa ...

  8. [转][Prism]Composite Application Guidance for WPF(6)——服务

      [Prism]Composite Application Guidance for WPF(6)——服务                             周银辉 在Ioc和DI中,最熟悉的 ...

  9. idea打包可执行jar

    (1)在项目上鼠标右键 --> Open Module Settings 或者点击工具栏上的 (2)Artifacts --> + --> JAR --> From modul ...

  10. 移动端video视频播放问题

    1.视频播放后自动全屏 video添加playsinline  webkit-playsinline属性 2.安卓暂停或播放完毕不能滑动 通过js判断机型,安卓去掉controls属性,ios保留co ...