示例:基于实例的原型管理器
说明:
当一个系统中原型数目不固定时(也就是说,它们可以动态创建和销毁),要保持一个可用原型的注册表。客户不会自己来管理原型,但会在注册表中存储和检索原型。客户在克隆一个原型前会向注册表请求该原型。我们称这个注册表为原型管理器(PrototypeManager)。
原型管理器是一个关联存储器(associativestore),它返回一个与给定关键字相匹配的原型。它有一些操作可以用来通过关键字注册原型和解除注册。客户可以在运行时更改甚或浏览这个注册表。这使得客户无需编写代码就可以扩展并得到系统清单。
实现:
应用程序启动时自动创建每个类的实例,并用原型管理器来注册这个实例。然后应用程序从配置文件中获取动态装载类信息,并向原型管理器请求该类的实例,这些类原本并没有和程序相连接。
特点:
(1)、运行时刻增加和删除产品
Prototype允许只通过客户注册原型实例就可以将一个新的具体产品类并入系统。它比其他创建型模式更为灵活,因为客户可以在运行时刻建立和删除原型。
(2)、用类动态配置应用
在运行时刻,Prototype允许你动态将类装载到应用中。
代码:
unit uPrototypeManager;
interface
uses
SysUtils,Classes,Dialogs;
type
TBaseObjectClass = class of TBaseObject;
TBaseObject = class
public
function Clone: TBaseObject; virtual; abstract;
procedure Show; virtual; abstract;
end;
TObjectA = class(TBaseObject)
public
function Clone: TBaseObject; override;
procedure Show; override;
end;
TObjectB = class(TBaseObject)
public
function Clone: TBaseObject; override;
procedure Show; override;
end;
TPrototypeInfo = record
Name: string;
Prototype: TBaseObject;
end;
PPrototypeInfo = ^TPrototypeInfo;
TPrototypeList = class
private
FDataList: TList;
function GetItems(Index: integer): PPrototypeInfo;
public
constructor Create;
destructor Destroy; override;
//---
procedure Clear;
function IndexOf(const APrototypeName: string): integer;
procedure Add(const APrototypeName: string; const APrototype: TBaseObject);
procedure Delete(const AIndex: integer);
//---
property Items[Index: integer]: PPrototypeInfo read GetItems; default;
end;
TPrototypeManager = class
private
FPrototypeList: TPrototypeList;
function Registered(const APrototypeName: string): Boolean;
public
constructor Create;
destructor Destroy; override;
//---
procedure RegisterPrototype(const APrototypeName: string; const APrototype:
TBaseObject);
procedure UnregisterPrototype(const APrototypeName: string);
function CreateObject(const APrototypeName: string): TBaseObject;
end;
var
PrototypeManager: TPrototypeManager;
implementation
function TObjectA.Clone: TBaseObject;
begin
Result := TObjectA.Create;
end;
procedure TObjectA.Show;
begin
showmessage('这是ObjectA');
end;
function TObjectB.Clone: TBaseObject;
begin
Result := TObjectB.Create;
end;
procedure TObjectB.Show;
begin
showmessage('这是ObjectB');
end;
constructor TPrototypeList.Create;
begin
inherited;
//---
FDataList := TList.Create;
end;
destructor TPrototypeList.Destroy;
begin
Clear;
FDataList.Free;
//---
inherited;
end;
procedure TPrototypeList.Clear;
var
i: Integer;
pData: PPrototypeInfo;
begin
with FDataList do
begin
for i := 0 to Count - 1 do
begin
pData := Items[i];
pData.Prototype.Free;
dispose(pData);
end;
//---
Clear;
end;
end;
procedure TPrototypeList.Add(const APrototypeName: string; const APrototype:
TBaseObject);
var
pData: PPrototypeInfo;
begin
new(pData);
//---
with pData^ do
begin
Name := APrototypeName;
Prototype := APrototype;
end;
//---
FDataList.Add(pData);
end;
function TPrototypeList.IndexOf(const APrototypeName: string): integer;
var
i: integer;
pData: PPrototypeInfo;
begin
with FDataList do
begin
for i := 0 to Count - 1 do
begin
pData := Items[i];
if pData.Name = APrototypeName then
begin
Result := i;
exit;
end;
end;
end;
//---
Result := -1;
end;
procedure TPrototypeList.Delete(const AIndex: integer);
var
pData: PPrototypeInfo;
begin
with FDataList do
begin
if (AIndex >= 0) and (AIndex < Count) then
begin
pData := Items[AIndex];
pData.Prototype.Free;
dispose(pData);
//---
Delete(AIndex);
end;
end;
end;
function TPrototypeList.GetItems(Index: integer): PPrototypeInfo;
begin
Result := FDataList[Index];
end;
constructor TPrototypeManager.Create;
begin
FPrototypeList := TPrototypeList.Create;
end;
destructor TPrototypeManager.Destroy;
begin
FPrototypeList.Free;
//---
inherited;
end;
procedure TPrototypeManager.RegisterPrototype(const APrototypeName: string;
const APrototype: TBaseObject);
var
LClassName: string;
begin
if Registered(APrototypeName) then
raise Exception.CreateFmt('A class named %s already exists', [LClassName])
else
FPrototypeList.Add(APrototypeName,APrototype);
end;
function TPrototypeManager.Registered(const APrototypeName: string): Boolean;
begin
Result := FPrototypeList.IndexOf(APrototypeName) >= 0;
end;
procedure TPrototypeManager.UnregisterPrototype(const APrototypeName: string);
var
AIndex: Integer;
begin
AIndex := FPrototypeList.IndexOf(APrototypeName);
if AIndex >= 0 then
FPrototypeList.Delete(AIndex);
end;
function TPrototypeManager.CreateObject(
const APrototypeName: string): TBaseObject;
var
AIndex: Integer;
begin
AIndex := FPrototypeList.IndexOf(APrototypeName);
if AIndex >= 0 then
Result := FPrototypeList[AIndex].Prototype.Clone
else
Result := nil;
end;
initialization
PrototypeManager := TPrototypeManager.Create;
with PrototypeManager do
begin
RegisterPrototype('TObjectA',TObjectA.Create);
RegisterPrototype('TObjectB',TObjectB.Create);
end;
finalization
PrototypeManager.Free;
end.
procedure TForm1.Button1Click(Sender: TObject);
var
AObject: TBaseObject;
//---
function GetClassNameFromIni: string;
begin
Result := 'TObjectA';
end;
begin
AObject := PrototypeManager.CreateObject(GetClassNameFromIni);
try
AObject.Show;
finally
AObject.Free;
end;
end;