Шаблоны проектирования. Часть 2.

Abstract Factory and Factory Method.

Если честно, то я, наверное, до конца так и не понял, в чем различие между этими шаблонами. Оба предназначены для создания групп объектов, которые имеют общее поведение (было бы странно если бы они имели разное реализуя общий интерфейс). Хотя естественно, что если мы наследуем просто от класса с абстрактными методами, то в классе потомке можно добавить новые уникальные методы, чего не сделаешь с классами, которые наследуются от TInterfacedObject.

Реализация Abstract Factory (в наглую сдерта с вики + небольшие правки)

unit AbstractFactory;

interface

type
// AbstractProduct
TCar = class
public
  function Info: string; virtual; abstract;
end;

// ConcreteProductA
TFord = class(TCar)
public
  procedure Test;
  function Info: string; override;
end;

// ConcreteProductB
TToyota  = class(TCar)
public
  function Info: string; override;
end;

// AbstractFactory
TCarFactory = class
public
  function CreateCar: TCar; virtual; abstract;
end;


// ConcreteFactoryA
TFordFactory = Class(TCarFactory)
public
  function CreateCar: TCar; override;
end;

// ConcreteFactoryB
TToyotaFactory = Class(TCarFactory)
public
  function CreateCar: TCar; override;
end;

implementation

{ TFord }
function TFord.Info: string;
begin
  Result:='Ford';
end;

procedure TFord.Test;
begin
  Writeln('TFord.Test');
end;

{ TToyota }
function TToyota.Info: string;
begin
  Result:='Toyota';
end;

{ TFordFactory }
function TFordFactory.CreateCar: TCar;
begin
  Result := TFord.Create;
end;

{ TToyotaFactory }
function TToyotaFactory.CreateCar: TCar;
begin
  Result := TToyota.Create;
end; 

end.

Реализация FactoryMethod

unit FactoryMethod;

interface

type
// "Product"
IProduct = interface
  procedure GetName;
end;

// "ConcreteProductA"
TConcreteProductA = class(TInterfacedObject, IProduct)
  procedure GetName;
end;

// "ConcreteProductB"
TConcreteProductB = class(TInterfacedObject, IProduct)
  procedure GetName;
end;

// "Creator"
ICreator = interface
  function FactoryMethod: IProduct;
end;

// "ConcreteCreatorA"
TConcreteCreatorA = class(TInterfacedObject, ICreator)
  function FactoryMethod: IProduct;
end;

// "ConcreteCreatorB"
TConcreteCreatorB = class(TInterfacedObject, ICreator)
  function FactoryMethod: IProduct;
end;

implementation

{ TConcreteCreatorA }

function TConcreteCreatorA.FactoryMethod: IProduct;
begin
  Result := TConcreteProductA.Create;
end;

{ TConcreteCreatorB }

function TConcreteCreatorB.FactoryMethod: IProduct;
begin
  Result := TConcreteProductB.Create;
end;

{ TConcreteProductA }

procedure TConcreteProductA.GetName;
begin
  Writeln('TConcreteProductA.GetName;');
end;

{ TConcreteProductB }

procedure TConcreteProductB.GetName;
begin
  Writeln('TConcreteProductB.GetName;');
end;

end.

Builder.

Позволяет сконструировать сложный объект на основе “кирпичиков” – более простых объектов. Выходит, что мы можем иметь два объекта одного типа, но с разным содержимым.

Реализация

unit Builder;

interface

uses
SysUtils, Classes;

type

// Product
TProduct = class
private
  FParts: TStringList;
public
  procedure Add(Part: string);
  procedure Show;
  constructor Create;
  destructor Destroy;
end;

// Builder
IBuilder = interface['{52A37564-3B0B-4A5A-ADF0-1DD7AB3A6789}']
  procedure BuildPartA;
  procedure BuildPartB;
  function GetResult: TProduct;
end;

// ConcreteBuilder1
TConcreteBuilder1 = class(TInterfacedObject, IBuilder)
private
  FProduct: TProduct;
public
  procedure BuildPartA;
  procedure BuildPartB;
  function GetResult: TProduct;
  constructor Create;
  destructor Destroy;
end;

// ConcreteBuilder2
TConcreteBuilder2 = class(TInterfacedObject, IBuilder)
private
  FProduct: TProduct;
public
  procedure BuildPartA;
  procedure BuildPartB;
  function GetResult: TProduct;
  constructor Create;
  destructor Destroy;
end;

TDirector = class
public
  procedure Construct(Builder: IBuilder);
end;

implementation

{ Product }

procedure TProduct.Add(Part: string);
begin
  FParts.Add(Part);
end;

constructor TProduct.Create;
begin
  FParts := TStringList.Create;
end;

destructor TProduct.Destroy;
begin
  FreeAndNil(FParts);
end;

procedure TProduct.Show;
var
  I: Integer;
begin
  Writeln('Product Parts -------');
  for I := 0 to FParts.Count - 1 do
  Writeln(FParts[I]);
end;

{ TConcreteBuilder1 }

procedure TConcreteBuilder1.BuildPartA;
begin
  FProduct.Add('PatrA');
  FProduct.Add('PatrB');
  FProduct.Add('PatrC');
end;

procedure TConcreteBuilder1.BuildPartB;
begin
  FProduct.Add('PatrD');
end;

constructor TConcreteBuilder1.Create;
begin
  FProduct := TProduct.Create;
end;

destructor TConcreteBuilder1.Destroy;
begin
  FreeAndNil(FProduct);
end;

function TConcreteBuilder1.GetResult: TProduct;
begin
  Result := FProduct;
end;

{ TConcreteBuilder2 }

procedure TConcreteBuilder2.BuildPartA;
begin
  FProduct.Add('PatrX');
end;

procedure TConcreteBuilder2.BuildPartB;
begin
  FProduct.Add('PatrY');
end;

constructor TConcreteBuilder2.Create;
begin
  FProduct := TProduct.Create;
end;

destructor TConcreteBuilder2.Destroy;
begin
  FreeAndNil(FProduct);
end;

function TConcreteBuilder2.GetResult: TProduct;
begin
  Result := FProduct;
end;

{ TDirector }

procedure TDirector.Construct(Builder: IBuilder);
begin
  Builder.BuildPartA();
  Builder.BuildPartB();
end;

end.

Пример использования

var
  //Builder
  Director: TDirector;
  B1, B2: IBuilder;
  P1, P2: TProduct;
begin
  Director := TDirector.Create;
  B1 := TConcreteBuilder1.Create;
  Director.Construct(B1);
  P1 := B1.GetResult;
  P1.Show;

  B2 := TConcreteBuilder2.Create;
  Director.Construct(B2);
  P2 := B2.GetResult;
  P2.Show;
end;