Factory Pattern in Delphi

BlueberryCheeseCake.pas

unit BlueberryCheeseCake;

interface

uses
  CheeseCakeInterface;

type
  TBlueberryCheeseCake = class(TCheeseCake)
  public
    procedure MakeCrust; override;
    procedure AddLayer; override;
    procedure AddFlavor; override;
    procedure Bake; override;
  end;

implementation

uses
  CheeseCakeFactory_u;

procedure TBlueberryCheeseCake.AddFlavor;
begin
  WriteLn(' Added Blueberry Flavour … ');
end;

procedure TBlueberryCheeseCake.AddLayer;
begin
  WriteLn(' Added Layers on Blueberry Cheesecake … ');
end;

procedure TBlueberryCheeseCake.Bake;
begin
  WriteLn(' Here''s your Blueberry Cheesecake … ');
end;

procedure TBlueberryCheeseCake.MakeCrust;
begin
  WriteLn(' Making Crust for your Blueberry Cheesecake … ');
end;

initialization

// register the flavour
CheeseCakeFactory.RegisterFlavour('Blueberry', TBlueberryCheeseCake);

end.

CheeseCakeFactory_u.pas

unit CheeseCakeFactory_u;

interface

uses
  CheeseCakeInterface, System.Generics.Collections;

type
  ICheeseCakeFactory = interface
    ['{DC55DBE7-73CE-4B86-AAC3-B3780115BDB3}']
    function MakeCheeseCake(Flavour: string): ICheeseCake;
    procedure RegisterFlavour(Flavour: string; classtype: TCheeseCakeClass);
  end;

var  // global pluggable factory function
  CheeseCakeFactory: function: ICheeseCakeFactory;

implementation

uses
  System.SysUtils;

type
  TCheeseCakeFactory = class(TInterfacedObject, ICheeseCakeFactory)
  private
    FRecipies: TDictionary<string, TCheeseCakeClass>;
  public
    constructor Create;
    destructor Destroy; override;
    function MakeCheeseCake(Flavour: string): ICheeseCake;
    procedure RegisterFlavour(Flavour: string; classtype: TCheeseCakeClass);
  end;

constructor TCheeseCakeFactory.Create;
begin
  inherited;
  FRecipies := TDictionary<string, TCheeseCakeClass>.Create;
end;

destructor TCheeseCakeFactory.Destroy;
begin
  FRecipies.Free;
  inherited;
end;

function TCheeseCakeFactory.MakeCheeseCake(Flavour: string): ICheeseCake;

var
  ImplementingClass: TCheeseCakeClass;
begin
  if FRecipies.TryGetValue(Flavour, ImplementingClass) then
    Result := ImplementingClass.Create
  else
    raise Exception.Create('Flavour not found');
end;

procedure TCheeseCakeFactory.RegisterFlavour(Flavour: string; classtype: TCheeseCakeClass);
begin
  FRecipies.AddOrSetValue(Flavour, classtype);
end;

/// globals  //////
var
  _CheeseCakeFactory: ICheeseCakeFactory;

function GetCheeseCakeFactory: ICheeseCakeFactory;
begin
  if _CheeseCakeFactory = nil then
    _CheeseCakeFactory := TCheeseCakeFactory.Create;
  Result := _CheeseCakeFactory;
end;

initialization

// override this to replace with a mock for testing etc
CheeseCakeFactory := GetCheeseCakeFactory;

end.

CheeseCakeInterface.pas

unit CheeseCakeInterface;

interface

type
  ICheeseCake = interface
    procedure MakeCrust;
    procedure AddLayer;
    procedure AddFlavor;
    procedure Bake;
  end;

  TCheeseCake = class(TInterfacedObject, ICheeseCake)
  public
    procedure MakeCrust; virtual; abstract;
    procedure AddLayer; virtual; abstract;
    procedure AddFlavor; virtual; abstract;
    procedure Bake; virtual; abstract;
  end;

  TCheeseCakeClass = class of TCheeseCake;

implementation

end.

CheeseCakeShop.dpr

program CheeseCakeShop;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils,
  CheeseCakeInterface in 'CheeseCakeInterface.pas',
  CheeseCakeFactory_u in 'CheeseCakeFactory_u.pas',
  BlueberryCheeseCake in 'BlueberryCheeseCake.pas',
  CoffeeCheesecake in 'CoffeeCheesecake.pas',
  MangoCheeseCake in 'MangoCheeseCake.pas',
  StrawberryCheeseCake in 'StrawberryCheeseCake.pas';

procedure PrepareCheeseCake;

var
  FlavorStr: String;
  Cheesecake: ICheeseCake;

begin

  Writeln('What Flavor of Cheesecake do you want ? ');
  Readln(FlavorStr);

  Cheesecake := CheeseCakeFactory.MakeCheeseCake(FlavorStr);
  Cheesecake.MakeCrust;
  Cheesecake.AddLayer;
  Cheesecake.AddFlavor;
  Cheesecake.Bake;
  Readln;
end;

begin
  try
    PrepareCheeseCake;
  except
    on E: Exception do
    begin
      Writeln(E.ClassName, ':', E.Message);
      Readln;
    end
  end;

end.

CoffeeCheesecake.pas

unit CoffeeCheesecake;

interface

uses
  CheeseCakeInterface;

type

  TCoffeeCheeseCake = class(TCheeseCake)
  public
    procedure MakeCrust; override;
    procedure AddLayer; override;
    procedure AddFlavor; override;
    procedure Bake; override;
  end;

implementation

uses
  CheeseCakeFactory_u;

procedure TCoffeeCheeseCake.AddFlavor;
begin
  WriteLn(' Added Coffee Flavour … ');
end;

procedure TCoffeeCheeseCake.AddLayer;
begin
  WriteLn(' Added Layers on Coffee Cheesecake … ');
end;

procedure TCoffeeCheeseCake.Bake;
begin
  WriteLn(' Here''s your Coffee Cheesecake … ');
end;

procedure TCoffeeCheeseCake.MakeCrust;
begin
  WriteLn(' Making Crust for your Coffee Cheesecake … ');
end;

initialization

// register the flavour
CheeseCakeFactory.RegisterFlavour('Coffee', TCoffeeCheeseCake);

end.

MangoCheeseCake.pas

unit MangoCheeseCake;

interface

uses
  CheeseCakeInterface;

type

  TMangoCheeseCake = class(TCheeseCake)
  public
    procedure MakeCrust; override;
    procedure AddLayer; override;
    procedure AddFlavor; override;
    procedure Bake; override;
  end;

implementation

uses
  CheeseCakeFactory_u;

procedure TMangoCheeseCake.AddFlavor;
begin
  WriteLn(' Added Mango Flavour … ');
end;

procedure TMangoCheeseCake.AddLayer;
begin
  WriteLn(' Added Layers on Mango Cheesecake … ');
end;

procedure TMangoCheeseCake.Bake;
begin
  WriteLn(' Here''s your Mango Cheesecake … ');
end;

procedure TMangoCheeseCake.MakeCrust;
begin
  WriteLn(' Making Crust for your Mango Cheesecake … ');
end;

initialization

// register the flavour
CheeseCakeFactory.RegisterFlavour('Mango', TMangoCheeseCake);

end.

StrawberryCheeseCake.pas

unit StrawberryCheeseCake;

interface

uses
  CheeseCakeInterface;

type

  TStrawberryCheeseCake = class(TCheeseCake)
  public
    procedure MakeCrust; override;
    procedure AddLayer; override;
    procedure AddFlavor; override;
    procedure Bake; override;
  end;

implementation

uses
  CheeseCakeFactory_u;

procedure TStrawberryCheeseCake.AddFlavor;
begin
  WriteLn(' Added Strawberry Flavour … ');
end;

procedure TStrawberryCheeseCake.AddLayer;
begin
  WriteLn(' Added Layers on Strawberry Cheesecake … ');
end;

procedure TStrawberryCheeseCake.Bake;
begin
  WriteLn(' Here''s your Strawberry Cheesecake … ');
end;

procedure TStrawberryCheeseCake.MakeCrust;
begin
  WriteLn(' Making Crust for your Strawberry Cheesecake … ');
end;

initialization

// register the flavour
CheeseCakeFactory.RegisterFlavour('Strawberry', TStrawberryCheeseCake);

end.

To add a new flavour create a corresponding unit, implement the core methods (which could be refactored onto the base class) and register the flavour with the factory.