DesignPatterns. FactoryMethod

На входе у нас абстрактный продукт и абстрактный создатель продукта. В потомках создаем конкретных создателей, которые создают конкретные продукты.

Применять в случае, когда неизвестно заранее, какие конкретные классы будем создавать, но известна некоторая абстракция о них.

Клиент

program FactoryMethod;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  uFactoryMethod in 'uFactoryMethod.pas';

var
  Creators: array[1..2] of TCreator;
  productA: TProduct;
  productB: TProduct;

begin
  try
    Creators[1] := TConcreteCreatorA.Create();
    Creators[2] := TConcreteCreatorB.Create();
    try
      productA := Creators[1].FactoryMethod;
      Writeln(productA.GetName());

      productB := Creators[2].FactoryMethod;
      Writeln(productB.GetName());
    finally
      Creators[1].Free();
      Creators[2].Free();
    end;

    ReadLn;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Класс фабричного метода

unit uFactoryMethod;

interface

type
  TProduct = class
    function GetName: string; virtual; abstract;
  end;

  TConcreteProductA = class(TProduct)
  public
    function GetName: string; override;
  end;

  TConcreteProductB = class(TProduct)
    function GetName: string; override;
  end;

  TCreator = class
  public
    function FactoryMethod(): TProduct; virtual; abstract;
  end;

  TConcreteCreatorA = class(TCreator)
  public
    function FactoryMethod(): TProduct; override;
  end;

  TConcreteCreatorB = class(TCreator)
  public
    function FactoryMethod(): TProduct; override;
  end;

implementation

{ TConcreteCreatorB }

function TConcreteCreatorB.FactoryMethod: TProduct;
begin
  Result := TConcreteProductB.Create();
end;

{ TConcreteCreatorA }

function TConcreteCreatorA.FactoryMethod: TProduct;
begin
  Result := TConcreteProductA.Create();
end;

{ TConcreteProductB }

function TConcreteProductB.GetName: string;
begin
  Result := ClassName;
end;

{ TConcreteProductA }

function TConcreteProductA.GetName: string;
begin
  Result := ClassName;
end;

end.