《GOF设计模式》—抽象工厂(Abstract Factory)—Delphi源码示例：基于原型的工厂

示例：基于原型的工厂
说明：
如果有多个可能的产品系列，具体工厂也可以使用Prototype模式来实现。具体工厂使用产品系列中每一个产品的原型实例来初始化，且它通过复制它的原型来创建新的产品。在基于原型的方法中，使得不是每个新的产品系列都需要一个新的具体工厂类。
实现：
此处是Smalltalk中实现一个基于原型的工厂的方法。具体工厂在一个被称为partCatalog的字典中存储将被复制的原型，方法make检索该原型并复制它，方法addPart用来向该字典中增加部件原型。原型通过用一个符号进行标识，从而被增加到工厂中。
代码：



unit uPrototypeFactory;

interface

uses
Dialogs,uAbstractFactory,classes;

type
TPart = class
public
function Clone(): TPart; virtual; abstract;
end;
TPartB = class(TPart)
public
procedure Show; virtual; abstract;
end;
TPartB1 = class(TPartB)
public
function Clone: TPart; override;
procedure Show; override;
end;
TPartB2 = class(TPartB)
public
function Clone: TPart; override;
procedure Show; override;
end;

TPartA = class(TPart)
public
procedure Show; virtual; abstract;
end;
TPartA1 = class(TPartA)
public
function Clone: TPart; override;
procedure Show; override;
end;
TPartA2 = class(TPartA)
public
function Clone: TPart; override;
procedure Show; override;
end;

TPartInfo = record
PartName: string;
PartTemplate: TPart;
end;
PPartInfo = ^TPartInfo;

TPartCatalog = class
private
FDataList: TList;
function GetParts(PartName: string): TPart;
procedure SetParts(PartName: string; const Value: TPart);
procedure Clear;
function Find(const PartName: string): PPartInfo;
procedure Add(const PartName: string; const PartTemplate: TPart);
public
constructor Create;
destructor Destroy; override;
//---
property Parts[PartName: string]: TPart read GetParts write SetParts;
end;

TPartFactory = class
private
FPartCatalog: TPartCatalog;
protected
procedure AddPart(PartTemplate: TPart; const PartName: string);
public
constructor Create;
destructor Destroy; override;
//---
function Make(const PartName: string): TPart; virtual;
end;

function GetPartFactory1: TPartFactory;
function GetPartFactory2: TPartFactory;

implementation

function GetPartFactory1: TPartFactory;
begin
Result := TPartFactory.Create;
//---
with Result do
begin
addPart(TPartA1.Create, 'PartA1');
addPart(TPartB1.Create, 'PartB1');
end;
end;

function GetPartFactory2: TPartFactory;
begin
Result := TPartFactory.Create;
//---
with Result do
begin
addPart(TPartA2.Create, 'PartA2');
addPart(TPartB2.Create, 'PartB2');
end;
end;

function TPartA1.Clone: TPart;
begin
Result := TPartA1.Create;
end;

procedure TPartA1.Show;
begin
showmessage('这是PartA1');
end;

function TPartA2.Clone: TPart;
begin
Result := TPartA2.Create;
end;

procedure TPartA2.Show;
begin
showmessage('这是PartA2');
end;

function TPartB1.Clone: TPart;
begin
Result := TPartB1.Create;
end;

procedure TPartB1.Show;
begin
showmessage('这是PartB1');
end;

function TPartB2.Clone: TPart;
begin
Result := TPartB2.Create;
end;

procedure TPartB2.Show;
begin
showmessage('这是PartB2');
end;

constructor TPartCatalog.Create;
begin
inherited;
//---
FDataList := TList.Create;
end;

destructor TPartCatalog.Destroy;
begin
Clear;
FDataList.Free;
//---
inherited;
end;

procedure TPartCatalog.Clear;
var
i: Integer;
pData: PPartInfo;
begin
with FDataList do
begin
for i := 0 to Count - 1 do
begin
pData := Items[i];
pData.PartTemplate.Free;
dispose(pData);
end;
//---
Clear;
end;
end;

procedure TPartCatalog.Add(const PartName: string; const PartTemplate: TPart);
var
pData: PPartInfo;
begin
new(pData);
//---
pData.PartName := PartName;
pData.PartTemplate := PartTemplate;
//---
FDataList.Add(pData);
end;

function TPartCatalog.Find(const PartName: string): PPartInfo;
var
i: integer;
pData: PPartInfo;
begin
with FDataList do
begin
for i := 0 to Count - 1 do
begin
pData := Items[i];
if pData.PartName = PartName then
begin
Result := pData;
exit;
end;
end;
end;
//---
Result := nil;
end;

function TPartCatalog.GetParts(PartName: string): TPart;
var
pData: PPartInfo;
begin
pData := Find(PartName);
if pData = nil then
Result := nil
else
Result := pData.PartTemplate;
end;

procedure TPartCatalog.SetParts(PartName: string; const Value: TPart);
var
pData: PPartInfo;
begin
pData := Find(PartName);
if pData = nil then
Add(PartName,Value)
else
begin
pData.PartTemplate.Free;
pData.PartTemplate := Value;
end;
end;

constructor TPartFactory.Create;
begin
FPartCatalog := TPartCatalog.Create;
end;

destructor TPartFactory.Destroy;
begin
FPartCatalog.Free;
//---
inherited;
end;

procedure TPartFactory.AddPart(PartTemplate: TPart;
const PartName: string);
begin
FPartCatalog.Parts[PartName] := PartTemplate;
end;

function TPartFactory.Make(const PartName: string): TPart;
begin
Result := FPartCatalog.Parts[PartName].Clone;
end;

end.

procedure TForm2.Button1Click(Sender: TObject);
var
AFactory: TPartFactory;
APartA: TPartA;
APartB: TPartB;
begin
{AFactory := GetPartFactory1;
APartA := TPartA(AFactory.Make('PartA1'));
APartB := TPartB(AFactory.Make('PartB1'));}
//---
AFactory := GetPartFactory2;
APartA := TPartA(AFactory.Make('PartA2'));
APartB := TPartB(AFactory.Make('PartB2'));
//---
APartA.Show;
APartB.Show;
//---
APartA.Free;
APartB.Free;
AFactory.Free;
end;