《GOF设计模式》—原型(Prototype)—Delphi源码示例：基于实例的原型管理器

示例：基于实例的原型管理器

说明：

当一个系统中原型数目不固定时（也就是说，它们可以动态创建和销毁），要保持一个可用原型的注册表。客户不会自己来管理原型，但会在注册表中存储和检索原型。客户在克隆一个原型前会向注册表请求该原型。我们称这个注册表为原型管理器（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;