Click here to Skip to main content
Click here to Skip to main content
Technical Blog

Decorator Design Pattern in Delphi. Multiple Decorations

, 1 Jan 2013 CPOL
Rate this:
Please Sign up or sign in to vote.
Decorator design pattern in Delphi - Multiple decorations

Introduction

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 on 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 your feedback. Corrections and suggestions are welcome in the comments section below. Thanks!

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

Design Patterns: Elements of Reusable Object-Oriented Software

Head First Design Patterns

Object Models: Strategies, Patterns, and Applications (2nd Edition) 

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

yanniel
Software Developer Digital Rapids
Canada Canada
My name is Yanniel Alvarez Alfonso. I was born in San Antonio de los Baños, Havana Province, Cuba on October 24th, 1982.
 
I majored in Information Technology Engineering at José Antonio Echeverría Polytechnic Institute (CUJAE) in Havana City, Cuba (July 2006). After that, I got a Masters Degree in Applied Computer Science at the same University (May 2009).
 
I used to work as a professor of Information Technology at CUJAE. Right now, I work as a Software Developer in Toronto, Canada. I moved to Canada under the Skilled Worker Program on February 26th, 2010.
 
This is my personal blog: Yanniel's notes; in which I write about miscellaneous topics.
 
The link at the end of this sentence compiles an index of all the articles I have written so far about Delphi Programming.

Comments and Discussions

 
-- There are no messages in this forum --
| Advertise | Privacy | Terms of Use | Mobile
Web03 | 2.8.141223.1 | Last Updated 1 Jan 2013
Article Copyright 2013 by yanniel
Everything else Copyright © CodeProject, 1999-2014
Layout: fixed | fluid