The Strategy Design Pattern in Delphi

A summary and [my rendition of] the Delphi code taken from the first chapter of the book, Head First Design Patterns from O’Reilly.
As I mentioned in a previous post, I’m studying Design Patterns using the Head First Design Patterns book from O’Reilly.   As part of this learning process I’m working through the existing examples written in Java and recreating them in Delphi.  This is the second post in my series and the first that actually deals with one of the design patterns.  This first post in the series provides a list of additional resources on Design Patterns in Delphi that I’ve managed to track down.  I must mention again that I don’t plan on teaching you design patterns, as that would be quite presumptuous of me considering that I’m just a student of them myself.  I do intend to provide simply an overview of what I’ve learned and the resulting code I produced in the process.

The Strategy Pattern ... is useful for situations where it is necessary to dynamically swap the algorithms used in an application.  The strategy pattern is intended to provide a means to define a family of algorithms, encapsulate each one as an object, and make them interchangeable.  The strategy pattern lets the algorithms vary independently from clients that use them.
-- Wikipedia

Chapter Summary

The Strategy Pattern we eventually get to, is demonstrated using “a highly successful duck pond simulation game, SimUDuck” that proves difficult to evolve due to the use of basic OO design principles where all Duck types are inherited from a single super-class.
The difficulty in evolving the software became apparent when a new “fly” method was added to the super-class which was deemed inappropriate when applied to some of the derived objects.  For the sake of this demonstration we’ll just ignore that fact that anyone that has given a small child a bath well knows that not only do rubber ducks fly, but nine times out of ten they will hit you right on the head in the process.  Moving on ...
The Design Principle: “Identify the aspects of your application that vary and separate them from what stays the same” is introduced to move us toward the pattern to be used as a solution. They simplify the principle with – “take the parts that vary and encapsulate them, so that later you can alter or extend the parts that vary without affecting those that don’t”.  They also mention, which I took to be significant, that this principle “forms the basis for almost every design pattern in providing a way to let some part of a system vary independently of all other parts”.  With this in mind it is decided that both the fly() and quack() methods are to be refactored out of the Duck classes and each built into a separate set of classes of it’s own.
Along with the process of refactoring the application to move the selected behaviours into their own set of classes, in the Designing the Duck Behaviours section the [easily overlooked but significant] new requirement to be able to change these behaviours at runtime is also introduced.  Another Design Principle: Program to an interface, not an implementation is introduced as this point as well nudging us in the required direction when declaring these new objects in the Duck super-class.
They move right into the code for the two behaviour classes next ... and I was forced to jump right out of my comfort zone.  They had already gone through redefining these new classes with an TObject based [sorta like] super-class and rejected the idea.  It’s all fairly well explained but it still took me a bit to make the leap to using classes based on an TInterfacedObject super-class. Memories of threads and threads of the perils of interfaces and their over-use kept running through my head ... but I somehow shoved it all aside and used them anyway.  The perils of not actually freeing an object you intentionally created is still giving me the willies –but- in this specific case, it sure makes the whole process a lot less complex as we’ll see.
My rendition of the DuckFly behavior class is as follows:

unit DuckFly;

interface

type
  IFlyBehaviour = interface
    procedure Fly;
  end;

  TFlyWithWings = class(TInterfacedObject, IFlyBehaviour)
  public
    procedure Fly;
  end;

  TFlyWithNoWings = class(TInterfacedObject, IFlyBehaviour)
  public
    procedure Fly;
  end;

  TFlyNoWay = class(TInterfacedObject, IFlyBehaviour)
  public
    procedure Fly;
  end;

implementation

{ TFlyWithWings }
procedure TFlyWithWings.Fly;
begin
  WriteLn('');
  Writeln('FlyWithWings behaviour implemented:');
  Writeln('"Hey, look at me ... flapping my wings and flying."');
end;

{ TFlyNoWay }
procedure TFlyNoWay.Fly;
begin
  WriteLn('');
  Writeln('FlyNoWay behaviour implemented:');
  Writeln('Don''t be silly ... Decoy Ducks can''t fly.');
end;

{ TFlyWithNoWings }
procedure TFlyWithNoWings.Fly;
begin
  WriteLn('');
  Writeln('FlyWithNoWings behaviour implemented:');
  Writeln('"Weeeeee ... look at me - I''m a rocket."');
end;

end.

and the DuckQuack behavior class is:

unit DuckQuack;

interface
type
  IQuackBehaviour = interface
    procedure Quack;
  end;

  TQuack = class(TInterfacedObject, IQuackBehaviour)
  public
    procedure Quack;
  end;

  TSqueak = class(TInterfacedObject, IQuackBehaviour)
  public
    procedure Quack;
  end;

  TMuteQuack = class(TInterfacedObject, IQuackBehaviour)
  public
    procedure Quack;
  end;

implementation

{ TQuack }
procedure TQuack.Quack;
begin
  WriteLn('');
  Writeln('Quack behaviour implemented:');
  Writeln('"Quack quack quack."');
end;

{ TSqueak }
procedure TSqueak.Quack;
begin
  WriteLn('');
  Writeln('Squeak behaviour implemented:');
  Writeln('"Squeak squeak squeak."');
end;

{ TMuteQuack }
procedure TMuteQuack.Quack;
begin
  WriteLn('');
  Writeln('Silent behaviour implemented:');
  Writeln('<< silence >>');
end;

end.

In the next section the Duck class is re-coded.  I opted to take a bit of licence with a some of the instruction but only because I disagreed with what they wanted me to do.  I didn’t bother to refactor the Fly and Quack methods to performFly and performQuack respectively.  If you want ADuck to Fly would you use ADuck.performFly ... no, I didn’t think so.
I’ve coded the two behaviour classes to Properties in the Duck class.  Based on my translation of the Java example it seems to be what they are doing as well.  Using Properties allows me to meet the “set the behaviours at runtime” requirement that was introduced.

unit DuckModel;

interface

uses DuckFly, DuckQuack;

type
  TDuck = class(TObject, IFlyBehaviour, IQuackBehaviour)
  private
    FFlyBehaviour: IFlyBehaviour;
    FQuackBehaviour: IQuackBehaviour;
    procedure SetFlyBehaviour(const Value: IFlyBehaviour);
    procedure SetQuackBehaviour(const Value: IQuackBehaviour);
  public
    constructor Create;
    procedure Display; virtual; abstract;
    procedure Fly;
    procedure Quack;
    procedure Swim;
    property FlyBehaviour: IFlyBehaviour
      read FFlyBehaviour
      write SetFlyBehaviour
      implements IFlyBehaviour;
    property QuackBehaviour: IQuackBehaviour
      read FQuackBehaviour
      write SetQuackBehaviour
      implements IQuackBehaviour;
  end;

  TMallardDuck = class(TDuck)
  public
    constructor Create;
    procedure Display; override;
  end;

  TDecoyDuck = class(TDuck)
  public
    constructor Create;
    procedure Display; override;
  end;

implementation

{TDuck}
constructor TDuck.Create;
begin
  inherited;
  //Set the default behaviours for all ducks.
end;

procedure TDuck.Fly;
begin
  FlyBehaviour.Fly
end;

procedure TDuck.Quack;
begin
  QuackBehaviour.Quack
end;

procedure TDuck.SetFlyBehaviour(const Value: IFlyBehaviour);
begin
  FFlyBehaviour := Value;
end;

procedure TDuck.SetQuackBehaviour(const Value: IQuackBehaviour);
begin
  FQuackBehaviour := Value;
end;

procedure TDuck.Swim;
begin
  WriteLn('');
  Writeln('The duck is swimming.');
end;

{ TMallardDuck }
constructor TMallardDuck.Create;
begin
  inherited;
  FFlyBehaviour := TFlyWithWings.Create;
  FQuackBehaviour := TQuack.Create;
end;

procedure TMallardDuck.Display;
begin
  WriteLn('');
  Writeln('The Mallard duck is displayed.');
end;

{ TDecoyDuck }
constructor TDecoyDuck.Create;
begin
  inherited;
  FFlyBehaviour := TFlyNoWay.Create;
  FQuackBehaviour := TMuteQuack.Create;
end;

procedure TDecoyDuck.Display;
begin
  WriteLn('');
  Writeln('The Decoy duck is displayed.');
end;

end.

The quickest and easiest method to test this type of code I’ve found is simply to use a console application and this is what I’ve done here.

program SimUDuck;

{$APPTYPE CONSOLE}

uses
  DuckModel in 'DuckModel.pas',
  DuckFly in 'DuckFly.pas',
  DuckQuack in 'DuckQuack.pas';

var
  ADuck: TDuck;

begin
  //ReportMemoryLeaksOnShutdown := DebugHook <> 0;
  WriteLn('Duck Display Program run ...');
  Writeln('Starting with the Mallard Duck.');
  try
    ADuck := TMallardDuck.Create;
    ADuck.Display;
    ADuck.Swim;
    ADuck.Fly;
    ADuck.Quack;
  finally
    ADuck.Free;
  end;
  WriteLn('');
  Writeln('Changed to the Decoy Duck.');
  try
    ADuck := TDecoyDuck.Create;
    ADuck.Display;
    ADuck.Swim;
    ADuck.Fly;
    ADuck.Quack;
    WriteLn('');
    WriteLn('[Setting Behaviour at Run Time Demo]');
    WriteLn('Toss the Decoy across the pond.');
    ADuck.FlyBehaviour := TFlyWithNoWings.Create;
    ADuck.Fly;
  finally
    ADuck.Free;
  end;
  // More Ducks and Actions here:
  WriteLn('');
  WriteLn('Duck Display Program end ... Press [Enter] to Exit');
  Readln;
end.

There you have it.  The selected Duck Behaviours have been delegated off to separate classes.  We have knowingly broken the rule of “Program to an interface, not an implementation” in the Create events of the Duck sub-classes but apparently we’ll learn how to fix that later.
Any comments you may have on either the code I’ve written as my interpretation of the Java code supplied in the book or the information I’ve provided would be most appreciated and well accepted.
Thanks for stopping by [and here’s hoping I got it close to right] ...
Dave