《GOF设计模式》—原型(Prototype)—Delphi源码示例：基于类的原型管理器（使用TList实现）

示例：基于类的原型管理器（使用TList实现）

实现：

应用程序启动时自动注册每个类，并用类管理器来管理这个注册类。然后应用程序从配置文件中获取动态装载类的信息，并向类管理器请求该注册类以创建实例，这些类原本并没有和程序相连接。

代码：

unit uClassManager1;

 

interface

 

uses

    SysUtils,Classes,Dialogs;

 

type

    TBaseObjectClass = class of TBaseObject;

 

    TBaseObject = class

    public

        procedure Show; virtual; abstract;

    end;

    TObjectA = class(TBaseObject)

    public

        procedure Show; override;

    end;

    TObjectB = class(TBaseObject)

    public

        procedure Show; override;

    end;

 

    TClassInfo = record

        ClassName: string;

        ObjectClass: TBaseObjectClass;

    end;

    PClassInfo = ^TClassInfo;

 

    TClassList = class

    private

        FDataList: TList;

        function GetItems(Index: integer): PClassInfo;

    public

        constructor Create;

        destructor Destroy; override;

        //---

        procedure Clear;

        function IndexOf(const AClassName: string): integer;

        procedure Add(const AClassName: string; const AClass: TBaseObjectClass);

        procedure Delete(const AIndex: integer);

        //---

        property Items[Index: integer]: PClassInfo read GetItems; default;

    end;

 

    TClassManager = class

    private

        FClassList: TClassList;

    public

        constructor Create;

        destructor Destroy; override;

        //---

        procedure RegisterClass(const AClassName: string; AClass: TBaseObjectClass);

        procedure UnregisterClass(const AClassName: string);

        function Registered(const AClassName: string): Boolean;

        function GetClass(const AClassName: string): TBaseObjectClass;

    end;

 

procedure RegisterClass(const AClassName: string; AClass: TBaseObjectClass);

function GetClass(const AClassName: string): TBaseObjectClass;

 

implementation

 

var

    ClassManager: TClassManager;

 

function GetClass(const AClassName: string): TBaseObjectClass;

begin

    Result := ClassManager.GetClass(AClassName);

end;

 

procedure RegisterClass(const AClassName: string; AClass: TBaseObjectClass);

begin

    ClassManager.RegisterClass(AClassName,AClass);

end;

 

procedure TObjectA.Show;

begin

    showmessage('这是ObjectA');

end;

 

procedure TObjectB.Show;

begin

    showmessage('这是ObjectB');

end;

 

constructor TClassList.Create;

begin

    inherited;

    //---

    FDataList := TList.Create;

end;

 

destructor TClassList.Destroy;

begin

    Clear;

    FDataList.Free;

    //---

    inherited;

end;

 

procedure TClassList.Clear;

var

    i: Integer;

    pData: PClassInfo;

begin

    with FDataList do

    begin

        for i := 0 to Count - 1 do

        begin

            pData := Items[i];

            dispose(pData);

        end;

        //---

        Clear;

    end;

end;

 

procedure TClassList.Add(const AClassName: string; const AClass:

    TBaseObjectClass);

var

    pData: PClassInfo;

begin

    new(pData);

    //---

    with pData^ do

    begin

        ClassName := AClassName;

        ObjectClass := AClass;

    end;

    //---

    FDataList.Add(pData);

end;

 

function TClassList.IndexOf(const AClassName: string): integer;

var

    i: integer;

    pData: PClassInfo;

begin

    with FDataList do

    begin

        for i := 0 to Count - 1 do

        begin

            pData := Items[i];

            if pData.ClassName = AClassName then

            begin

                Result := i;

                exit;

            end;

        end;

    end;

    //---

    Result := -1;

end;

 

procedure TClassList.Delete(const AIndex: integer);

var

    pData: PClassInfo;

begin

    with FDataList do

    begin

        if (AIndex >= 0) and (AIndex < Count) then

        begin

            pData := Items[AIndex];

            dispose(pData);

            //---

            Delete(AIndex);

        end;

    end;

end;

 

function TClassList.GetItems(Index: integer): PClassInfo;

begin

    Result := FDataList[Index];

end;

 

constructor TClassManager.Create;

begin

    FClassList := TClassList.Create;

end;

 

destructor TClassManager.Destroy;

begin

    FClassList.Free;

    //---

    inherited;

end;

 

function TClassManager.GetClass(const AClassName: string): TBaseObjectClass;

var

    AIndex: Integer;

begin

    AIndex := FClassList.IndexOf(AClassName);

    if AIndex >= 0 then

        Result := FClassList[AIndex].ObjectClass

    else

        Result := nil;

end;

 

procedure TClassManager.RegisterClass(const AClassName: string; AClass: TBaseObjectClass);

var

    LClassName: string;

begin

    if Registered(AClassName) then

        raise Exception.CreateFmt('A class named %s already exists', [LClassName])

    else

        FClassList.Add(AClassName,AClass);

end;

 

function TClassManager.Registered(const AClassName: string): Boolean;

begin

    Result := FClassList.IndexOf(AClassName) >= 0;

end;

 

procedure TClassManager.UnregisterClass(const AClassName: string);

var

    AIndex: Integer;

begin

    AIndex := FClassList.IndexOf(AClassName);

    if AIndex >= 0 then

        FClassList.Delete(AIndex);

end;

 

initialization

    ClassManager := TClassManager.Create;

    RegisterClass('TObjectA',TObjectA);

    RegisterClass('TObjectB',TObjectB);

 

finalization

    ClassManager.Free;

end.

 

procedure TForm1.Button1Click(Sender: TObject);

var

    AObject: TBaseObject;

    //---

    function GetClassNameFromIni:string;

    begin

        Result := 'TObjectA';

    end;

begin

    AObject := GetClass(GetClassNameFromIni).Create;

    try

        AObject.Show;

    finally

        AObject.Free;

    end;

end;