Delphi的Decorator模式是在Decorator的基础上进行了扩展。更多Decorator模式的资料请参阅 《设计模式115页》
动态地给一个对象添加一些职责。就增加功能来说，Decorator模式比增加子类更为灵活.
我们经常要为某一些个别的对象增加一些新的职责，并不是全部的类。假设，我们有一组类用来输出文本行。抽象类TtextStream定义了一些接口，而后代如TtextFile、TlinePrinter、TclipboardStream则实现了这些接口。
|
|
继承机制是添加功能的一种有效途径。从TtextStream类继承了缓存器可以被多个子类的实例使用。但不是很灵活。因为缓存器的选择是静态的了。客户程序不能控制选择缓存器的方式和时机。如此，加重了抽象类TtextStream的字段的负担来控制缓存器，并将带入到它的第一个实例中。通常最好保持高层次的（抽象）基类的轻量。在基类中增加不规则化和原文分析会使它最变得非常笨重！
如果你不想创建一个重量级的基类就会产生别外一个问题。有这样一种情况：大量的独立的继承是可能是，但瀑发式的产生大量的子类来支持不同组合如：TbufTextFile、TscrambledTextFile、TbufScrambledTextFile、TbufLinePrinter、TscrambledLinePrinter及其它。发生同样问题，如果类定义对子类隐藏或不可见的。比如说，如果你想在第三的组件库的高层类中加入一个新的职责，试着给Delphi的Tstream加入一个新的职责！
一个灵活的方法是将文本流嵌入另一个对象中，由这个对象加入缓存器或不规则化。我们称这个嵌入的对象为装饰（Decorator）。这个装饰与文本流组件接口一致，因些它对使用文本流客户程序是透明的。在Delphi中保持接口一致意味着从一个共公的组先继承，例中为TtextStream。装饰将请求向前转到到文本流，并且可能能转发前后执行一些额外的动作（如缓存器、不规则化），透明性使你可以递归的嵌套多个装饰，从面可以添加任意多的功能。
假设类TtextStream的接口如下:
type
TTextStream = class (TObject)
protected
function GetEndOfText: Boolean; virtual; abstract;
public
function ReadLine: string; virtual; abstract;
procedure WriteLine(const Line: string); virtual; abstract;
property EndOfText: Boolean read GetEndOfText;
end;
| |
使用adapter可以创建一些真实的文本流组件，如TLinePrinter, TtextFile，其它更多的。为了保持接口的一致。使用decorator模式，我们可以灵活的为所有的文本流加入新功能。假设我们将装饰类命名为TtextFilter。这个类从TtextStream继承过来从而保TTextStream证接口的兼容，它同样包含了对TtextStream实例TextStream的引用。类TtextFilter没有实现任何新特性，它只是简单的将所有客户程序的请求（方法调用）转发给类TextStream。其后代如：TindentFilter、TupperCaseFilter通过简单重载装饰类的方法加入了一些新职责。
下面的流程图显示了TupperCaseFilter是如何调解客户程序对类TtextStream调用
此模式最重要的是让装饰类显示TtextStream能显示的任何部份。这样通常客户对调用装饰类和末装饰的类没有什么不同， 后它们对装饰类不存在任何依赖关系。在本单元的例子中，客户程序不知道它的文本在实际的写操作之前被转换成大写。
| |
下面的代码演示了类的装饰模式的应用。例子中的TtextStream为装饰类TtextFilter定义了一个抽象的接口。
type
TTextStream = class (TObject)
protected
function GetEndOfText: Boolean; virtual; abstract;
public
function ReadLine: string; virtual; abstract;
procedure WriteLine(const Line: string); virtual; abstract;
property EndOfText: Boolean read GetEndOfText;
end;
TTextFilter = class (TTextStream)
private
FOwnsStream: Boolean;
FTextStream: TTextStream;
protected
function GetEndOfText: Boolean; override;
function GetTextStream: TTextStream;
procedure SetTextStream(Value: TTextStream);
public
constructor Create(ATextStream: TTextStream; AOwnsStream: Boolean);
destructor Destroy; override;
function ReadLine: string; override;
procedure WriteLine(const Line: string); override;
property OwnsStream: Boolean read FOwnsStream write FOwnsStream;
property TextStream: TTextStream read GetTextStream write SetTextStream;
end;
代码说明:
· 属性TextStream包含了对装饰的文本流对象的引用。TextStream具有读、写的操作。这样对后代来说就更灵活了。一个类似的模式的proxy模式，通过读、写方法在proxy模式也是一种好的应用。有关proxy模式请参考《设计模式》。
· 属性OwnsStream用来TextStream的所有权。在下面的实现代码中你可以看到TtextFilter类在free它所有的文本流时先判断OwnsStream是否为真。它取到帮助装饰清除的作用。
· TextStream、OwnsStream是装饰类的构造器的两个参数。
· 实现装饰类重载了ReadLine、WriteLine、GetEndOfText三个方法。并加入了实现。
下面是它的实现部分代码:
constructor TTextFilter.Create(ATextStream: TTextStream; AOwnsStream: Boolean);
begin
inherited Create;
TextStream := ATextStream;
OwnsStream := AOwnsStream;
end;
destructor TTextFilter.Destroy;
begin
TextStream := nil;
inherited Destroy;
end;
function TTextFilter.GetEndOfText: Boolean;
begin
Result := TextStream.GetEndOfText;
end;
function TTextFilter.GetTextStream: TTextStream;
begin
Result := FTextStream;
end;
function TTextFilter.ReadLine: string;
begin
Result := TextStream.ReadLine;
end;
procedure TTextFilter.SetTextStream(Value: TTextStream);
begin
if Value <> FTextStream then
begin
if OwnsTextStream then FTextStream.Free;
FTextStream := Value;
end;
end;
procedure TTextFilter.WriteLine(const Line: string);
begin
TextStream.WriteLine(Line);
end;
在这些实现代码一个非常有兴趣的是:
· 装饰类的行为方法：ReadLine、WriteLine、GetEndOfText只是简单的调用相应的TextStream方法。
· SetTextStream方法在分配一个新的值前安全的释放它的方本流。
· 释造函数将TextStream := nil，因为在SetTextStream有可能释放当前的文本流。
现在可能真正的创建一个将文本转换成大写的过滤器了
接口部分的代码：
type
TUpperCaseFilter = class (TTextFilter)
public
» function ReadLine: string; override;
» procedure WriteLine(const Line: string); override;
end;
implementation
function TUpperCaseFilter.ReadLine: string;
begin
» Result := UpperCase(inherited ReadLine);
end;
procedure TUpperCaseFilter.WriteLine(const Line: string);
begin
» inherited WriteLine(UpperCase(Line));
end;
这个装饰类可以被子任何TtextStream目标使用:
function TClient.CreateOutput: TTextStream;
begin
» { 创建一个基类}
» case Destination of
» dsFile: Result := TTextFile.Create(GetFileName, fmCreate);
» dsPrinter: Result := TLinePrinter.Create;
» end;
» {判断是是否使用了装饰, 并使用同样的参数
» 重要的是我们没必要关心是装饰TTextFile ，还是TLinePrinter }
» if ConvertToUpperCase then
» Result := TUpperCaseFilter.Create(Result, True);
end;
procedure TClient.ListContents;
var
T: TTextStream;
begin
T := CreateOutput;
{ 在这里，我们并不知道是否使用了装饰}
try
{往T写内容 }
T.WriteLine('Contents');
finally
T.Free;
end;
end;
正在组织。。。
