Showing posts with label Structural patterns. Show all posts
Showing posts with label Structural patterns. Show all posts

Decorator Design Pattern in Delphi. Multiple Decorations

In my previous post I introduced the decorator design pattern to you. I used a fairly simple example (a silly example if you wish) in order to give you a flavour of the pattern. I wrote Delphi code for that matter and I focused in having ONE, and only ONE, decorator class.

This was the situation in the original example: we implemented a TConsole class with a Write method that writes a text to the standard output. Then, we used a TUpperCaseConsole class to decorate a TConsole object. The decoration itself was simple: uppercasing the text to be shown.

Now I want to add a second decoration, which is framing the text to be shown within a rectangle of asterisks (*). For that I will create a new decorator class: TFramedConsole.

Let’s present a raw piece of code: (We will refine and refactor the code later)

var
  MyConsole: TConsole;
begin
  MyConsole:= TConsole.Create;
  MyConsole:= TUpperCaseConsole.Create(MyConsole); //first decoration
  MyConsole:= TFramedConsole.Create(MyConsole); //second decoration

  try
    MyConsole.Write('Hello World!');
  finally
    MyConsole.Free;
  end;
  Readln;
end.

In the code above we added a second decoration. The output for that code should be something like this:

**********************
**   HELLO WORLD!   **
**********************

This is cool: We can even add the same decoration several times. For example, to provide a double frame we would do something like this:

var
  MyConsole: TConsole;
begin
  MyConsole:= TConsole.Create;
  MyConsole:= TUpperCaseConsole.Create(MyConsole); //first decoration
  MyConsole:= TFramedConsole.Create(MyConsole); //second decoration
  MyConsole:= TFramedConsole.Create(MyConsole); //third decoration

  try
    MyConsole.Write('Hello World!');
  finally
    MyConsole.Free;
  end;
  Readln;
end

Can you guess the output now? It’s like this:

**********************
**********************
**   HELLO WORLD!   **
**********************
**********************

How are the decorated and decorator classes put together when multiple decorations are needed? There are two key things to remember:
  1. The different concrete decorators (TUpperCaseConsole and TFramedConsole) must inherit from a base decorator class. We will introduce the TDecoratedConsole class as the common ancestor for our decorators.
  2. The base decorator class forwards the calls to its Write method to the decorated object’s Write method.
The code looks like this:

interface

uses
  SysUtils, Windows;

type
  TConsole = class
  private
    FText: string;
  public
    procedure Write(aText: string); virtual;
  end;

  TDecoratedConsole = class(TConsole) //Base Decorator
  private
    FConsole: TConsole;
  public
    constructor Create(aConsole: TConsole);
    destructor Destroy; override;

    procedure Write(aText: string); override;
  end;

  TUpperCaseConsole = class(TDecoratedConsole) //Concrete Decorator
  public
    procedure Write(aText: string); override;
  end;

  TFramedConsole = class(TDecoratedConsole) //Concrete Decorator
  private
    procedure CreateFrame(var aText: string);
  public
    procedure Write(aText: string); override;
end;

implementation

{ TConsole }

procedure TConsole.Write(aText: string);
begin
  FText:= aText;
  Writeln(FText);
end;

{ TDecoratedConsole }

constructor TDecoratedConsole.Create(aConsole: TConsole);
begin
  inherited Create;
  FConsole:= aConsole;
end;

destructor TDecoratedConsole.Destroy;
begin
  FConsole.Free;
  inherited;
end;

procedure TDecoratedConsole.Write(aText: string);
begin
  FConsole.Write(aText);
end;

{ TUpperCaseConsole }

procedure TUpperCaseConsole.Write(aText: string);
begin
  aText:= UpperCase(aText);
  inherited Write(aText);
end;

{ TFramedConsole }

procedure TFramedConsole.CreateFrame(var aText: string);
var
  TextLength: Integer;
  AsteriskLine: string;
  RealText: string;
begin
  if Pos('*', aText) = 0 then
    aText:= '** ' + aText + ' **';

  RealText:= Trim(StringReplace(aText, '*', '', [rfReplaceAll]));
  TextLength:= Length(RealText);
  AsteriskLine:= StringOfChar('*', TextLength + 10);

  aText:= AsteriskLine + #13#10 +
          aText + #13#10 + AsteriskLine;
end;

procedure TFramedConsole.Write(aText: string);
begin
  CreateFrame(aText);
  inherited Write(aText);
end;

I know you are dying to say: the code above is awful because the decorators are bounded to a specific implementation of the decorated class. Indeed, we are going to fix that by introducing a TAbstractConsole class, which will be the common ancestor of the decorated and decorator classes. The TAbstractConsole class is abstract, meaning it has no implementation. You could have used an Interface type instated, something like IAbstractConsole. I’ll leave that to you.

Finally, I present you the consuming code plus the class definition code:

//Consuming code
var
  MyConsole: TAbstractConsole;
begin
  MyConsole:= TConsole.Create;
  MyConsole:= TUpperCaseConsole.Create(MyConsole); //first decoration
  MyConsole:= TFramedConsole.Create(MyConsole); //second decoration
  MyConsole:= TFramedConsole.Create(MyConsole); //third decoration

  try
    MyConsole.Write('Hello World!');
  finally
    MyConsole.Free;
  end;
  Readln;
end

//Class definition code
interface

uses
  SysUtils, Windows;

type
  TAbstractConsole = class //Abstract class ==> Interface
  public
    procedure Write(aText: string); virtual; abstract;
  end;

  TConsole = class(TAbstractConsole) //Concrete class
  private
    FText: string;
  public
    procedure Write(aText: string); override;
  end;

  TDecoratedConsole = class(TAbstractConsole) //Base Decorator
  private
    FConsole: TAbstractConsole;
  public
    constructor Create(aConsole: TAbstractConsole);
    destructor Destroy; override;

    procedure Write(aText: string); override;
  end;

  TUpperCaseConsole = class(TDecoratedConsole) //Concrete Decorator
  public
    procedure Write(aText: string); override;
  end;

  TFramedConsole = class(TDecoratedConsole) //Concrete Decorator
  private
    procedure CreateFrame(var aText: string);
  public
    procedure Write(aText: string); override;
  end;

implementation

{ TConsole }

procedure TConsole.Write(aText: string);
begin
  FText:= aText;
  Writeln(FText);
end;

{ TDecoratedConsole }

constructor TDecoratedConsole.Create(aConsole: TAbstractConsole);
begin
  inherited Create;
  FConsole:= aConsole;
end;

destructor TDecoratedConsole.Destroy;
begin
  FConsole.Free;
  inherited;
end;

procedure TDecoratedConsole.Write(aText: string);
begin
  FConsole.Write(aText);
end;

{ TUpperCaseConsole }

procedure TUpperCaseConsole.Write(aText: string);
begin
  aText:= UpperCase(aText);
  inherited Write(aText);
end;

{ TFramedConsole }

procedure TFramedConsole.CreateFrame(var aText: string);
var
  TextLength: Integer;
  AsteriskLine: string;
  RealText: string;
begin
  if Pos('*', aText) = 0 then
    aText:= '** ' + aText + ' **';

  RealText:= Trim(StringReplace(aText, '*', '', [rfReplaceAll]));
  TextLength:= Length(RealText);
  AsteriskLine:= StringOfChar('*', TextLength + 10);

  aText:= AsteriskLine + #13#10 +
          aText + #13#10 + AsteriskLine;
end;

procedure TFramedConsole.Write(aText: string);
begin
  CreateFrame(aText);
  inherited Write(aText);
end;

I hope this was useful and I am definitely waiting for you feedback. Corrections and suggestions are welcome in the comment section below. Thanks!

For further reading about design patterns get your hands on these classics:

Decorator Design Pattern in Delphi. Single decoration

Decorator (also referred as Wrapper) is classified by GoF as a structural pattern. Its purpose is to:

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

Both inheritance and the decorator pattern aim towards extending the functionality. This is what they have in common.

There are a couple of remarkable differences:
  • Inheritance extends the functionality at compilation time (statically). The decorator pattern extends the functionality at runtime (dynamically).
  • Inheritance extends the functionality of a whole class (all objects of the extended class get the extended functionality). The decorator pattern allows extending the functionality of a selected object (or group of objects) without affecting the remaining objects.  

You can think of the decorator pattern as a way to add make-up to an object or even as a way to attach accessories to that object. All this is done on the fly after the object itself has been created.

Let’s walk through a simple task to get the idea. This example might sound silly. I want it silly so that you can focus on the decorator implementation, avoiding any extra complexity.

Please, be aware that this design is somewhat unfinished, since we are only covering the case for a single decoration (just one functionality to be extended). In real life, we will need multiple decorators in order to add multiple responsibilities. As this is a controlled example (just for the purpose of this discussion), I am enforcing that only ONE responsibility is going to be extended. This means, we will have ONE decorator class. Because of that, I have made some simplifications to the design; so that you get a taste of the decorator pattern in its simplest expression.

Later on, in other post, we’ll see how to add multiple responsibilities (with multiple decorator classes). For that, we’ll need a more complex design to overcome the shortcomings of this initial example. For now, just get the idea...we'll come back later to the multiple decorations scenario.

If you get some time, take a look at the discussion in the comments section.

Subtask 1: Let’s create a TConsole class which purpose is to output a given text to the standard output. The code might be something like this:

interface
type
  TConsole = class
  public
    procedure Write(aText: string);
  end;

implementation

procedure TConsole.Write(aText: string);
begin
  Writeln(aText);
end;

Subtask 2: Let’s use the TConsole class to printout “Hello World!”. The following code snipped does it:

var
  MyConsole: TConsole;
begin
  MyConsole:= TConsole.Create;
  try
    MyConsole.Write('Hello World!');
  finally
    MyConsole.Free;
  end;
  Readln;
end.

This is how the output looks like:

Hello World!

Subtask 3: Now, let’s decorate the object referenced by MyConsole (only that object, not the whole class). What I want is to upper case every text to be printed out. We need to define a decorator class TUpperCaseConsole for that purpose. See the code:

interface

uses
  SysUtils;

type
  TConsole = class
  public
    procedure Write(aText: string); virtual;
  end;


  //Decorator
  TUpperCaseConsole = class(TConsole)
  private
    FConsole: TConsole;
  public
    constructor Create(aConsole: TConsole);
    destructor Destroy; override;

    procedure Write(aText: string); override;
  end;

implementation

{ TConsole }

procedure TConsole.Write(aText: string);
begin
  Writeln(aText);
end;

{ TUpperCaseConsole }

constructor TUpperCaseConsole.Create(aConsole: TConsole);
begin
  inherited Create;
  FConsole:= aConsole;
end;

destructor TUpperCaseConsole.Destroy;
begin
  FConsole.Free;
  inherited;
end;

procedure TUpperCaseConsole.Write(aText: string);
begin
  aText:= UpperCase(aText);
 
FConsole.Write(aText);
end;

Notice in the code above that the decorator class (TUpperCaseConsole) inherits from the decorated class (TConsole). This makes both the decorated and the decorator objects to share the same public interface. Furthermore, the TUpperCaseConsole class Has-A field of the TConsole type. We’ll use this field to forward the printing functionality to the TConsole class, once we have applied the cosmetic (upper case transformation) to the text.

Subtask 4: Let’s now create some consuming code to decorate one TConsole object on the fly. Note how the TUpperCaseConsole constructor wraps (decorates) the object referenced by MyConsole.

var
  MyConsole: TConsole;
begin
  MyConsole:= TConsole.Create;
  MyConsole:= TUpperCaseConsole.Create(MyConsole);
  try
    MyConsole.Write('Hello World!');
  finally
    MyConsole.Free;
  end;
  Readln;
end.

This is how the output looks like after the decorator has been applied:

HELLO WORLD!  

In real life, you’ll have to judge whether the decorator pattern is the best alternative to be applied to solve a particular problem. Not always it the right way to go with. For more details get your hands on these classic books.