/ Design Patterns / Structural patterns / Decorator

Decorator Design Pattern in Delphi

Attach additional responsibilities to an object dynamically. Decorators provide a flexible alternative to subclassing for extending functionality.

Sometimes we want to add responsibilities to individual objects, not to an entire class. Suppose we have a family of classes used to output lines of text. The abstract base class TTextStream defines an interface, descendants like TTextFile, TLinePrinter and TClipboardStream implement this interface.

Now suppose we want to add behaviour to this family like buffering text, scrambling text and performing textual analysis while writing the text.

One way to add responsibilities is with inheritance. Inheriting a buffer from TTextStream will buffer output for every subclass instance. This is inflexible, however, because the choice of buffering is made statically. A client can't control how and when to let the stream be buffered. Also, this loads the abstract class TTextStream with fields to control buffering which are carried by each instance. In general it is best to keep (abstract) base classes high up in the hierarchy as light weight as possible. Adding scrambling and textual analysis to the base class will make this class even heavier.

If we don't want to create heavy weight base classes another problem arises. In this case a large number of independent extensions are possible and would produce an explosion of subclasses to support every combination: TBufTextFile, TScrambledTextFile, TBufScrambledTextFile, TBufLinePrinter, TScrambledLinePrinter etc. The same problem arises if a class definition is hidden or otherwise unavailable for subclassing. For example, if you want to add new behaviour to a class high up in a third party class library: try to add new behaviour to Delphi's TStream class!

A more flexible approach is to enclose a text stream in another object that just adds buffering or scrambling. The enclosing object is called a decorator. The decorator conforms to the interface of the text stream it decorates so that it's presence is transparent to the text stream's clients. Conforming to an interface in Delphi implicates inheriting from a common ancestor, in this case TTextStream. The decorator forwards requests to the text stream it decorates and may perform additional actions (such as buffering or scrambling the text) before or after forwarding. Transparency lets you nest decorators recursively, thereby allowing an unlimited number of added independent responsibilities.

For example, suppose the interface of class TTextStream is: 

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;

Using adapter patterns we could create real text streams, like TLinePrinter, TTextFile etc. conforming to this interface. Using the decorator pattern we can now add flexible functionality to all of these text streams. Suppose we name the decorator class TTextFilter. This class inherits from TTextStream which ensures the interface compliance. It also contains a reference to a TTextStream instance named TextStream. The class TTextFilter implements no new features, it simply passes on all requests (method calls) to the decorated class TextStream. Descendants like TIndentFilter and TUpperCaseFilter add behaviour by simply overriding decorated methods.

The following diagram shows how to compose a TTextStream object with a TUpperCaseFilter.

The important aspect of this pattern is that it lets decorators appear anywhere a TTextStream can appear. This way clients generally can't tell the difference between a decorated component and an undecorated one, so they don't depend at all on the decoration. In the example, the client doesn't 'know' that text is converted to upper case before it is actually written.

Implementation

We'll use the above described classes to demonstrate the implementation of a decorator pattern. In this example, TTextStream defines an (abstract) interface which is decorated by a TTextFilter class. Here's the implementation: 

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;

In this interface, notice: The property TextStream which contains the reference to the decorated text stream. This property uses read and write access methods. This provides flexibility for descendants. A certain kind of proxy pattern, as described in, has the same structure as a decorator pattern. By using a read access method the pattern can be used to implement this kind of proxy pattern as well. The property OwnsStream which controls ownership of the property TextStream. You'll see in the implementation that a TTextFilter will free an owned text stream if OwnsStream is set True. This helps in cleaning up structures using decorators. Both TextStream and OwnsStream are passed in the constructor Create. This is optional. The overridden methods ReadLine, WriteLine and GetEndOfText. These are the methods that implement the actual decoration.

Now let's have a look at the implementation: 

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;

Some interesting aspects in this implementation are: The decoration behaviour: methods ReadLine, WriteLine and GetEndOfText simply call the corresponding methods in TextStream. The SetTextStream method which takes care of actually freeing owned text streams before assigning a new value. The destructor Destroy uses this feature by setting TextStream := nil which will cause SetTextStream to free the current text stream if it's owned.

It's really easy to create a text filter converting text to uppercase now: 

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;

This filter could now be used to decorate any text stream target:

function TClient.CreateOutput: TTextStream; 
begin 
  //create the base stream, depending on some setting
  case Destination of 
    dsFile: Result := TTextFile.Create(GetFileName, fmCreate); 
    dsPrinter: Result := TLinePrinter.Create; 
  end; 
  //decide whether to use decorator or not, also depending on some setting 
  //Note that it NOT important whether we decorate a LinePrinter or TextFile
  if ConvertToUpperCase then 
    Result := TUpperCaseFilter.Create(Result, True); 
end; 

procedure TClient.ListContents; 
var 
  T: TTextStream; 
begin 
  T := CreateOutput; 
  //At this point, we don't know if we're talking to a decorated output or not
  try 
    { list contents to T } 
    T.WriteLine('Contents'); 
  finally 
    T.Free; 
  end; 
end;

It's not spectacular, but it demonstrates the implementation and use of a decorator. You could imagine far more complex functionality to add using decorators, such as buffering, scrambling textual analysis etc.

Code examples

Java Decorator in Java Decorator in Java Decorator in Java Decorator in Java
C++ Decorator in C++: Before and after Decorator in C++ Decorator in C++: Encoding and decoding layers of header/packet/trailer
PHP Decorator in PHP
Delphi Decorator in Delphi
Python Decorator in Python