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

示例：基于类的原型管理器（使用TList和TObject对象服务实现）

代码：

unit uClassManager;

 

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;

 

    TClassManager = class

    private

        FClassList: TList;

    public

        constructor Create;

        destructor Destroy; override;

        //---

        procedure RegisterClass(AClass: TBaseObjectClass);

        procedure UnregisterClass(AClass: TBaseObjectClass);

        function Registered(AClass: TBaseObjectClass): Boolean;

        function GetClass(const AClassName: string): TBaseObjectClass;

    end;

 

procedure RegisterClasses(AClasses: array of TBaseObjectClass);

function GetClass(const AClassName: string): TBaseObjectClass;

 

implementation

 

var

    ClassManager: TClassManager;

 

function GetClass(const AClassName: string): TBaseObjectClass;

begin

    Result := ClassManager.GetClass(AClassName);

end;

 

procedure RegisterClasses(AClasses: array of TBaseObjectClass);

var

    I: Integer;

begin

    for I := Low(AClasses) to High(AClasses) do

        ClassManager.RegisterClass(AClasses[I]);

end;

 

procedure TObjectA.Show;

begin

    showmessage('这是ObjectA');

end;

 

procedure TObjectB.Show;

begin

    showmessage('这是ObjectB');

end;

 

constructor TClassManager.Create;

begin

    FClassList := TList.Create;

end;

 

destructor TClassManager.Destroy;

begin

    FClassList.Free;

    //---

    inherited;

end;

 

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

var

    I: Integer;

begin

    with FClassList do

    begin

        for I := 0 to Count - 1 do

        begin

            Result := Items[I];

            if Result.ClassNameIs(AClassName) then

                Exit;

        end;

    end;

    //---

    Result := nil;

end;

 

procedure TClassManager.RegisterClass(AClass: TBaseObjectClass);

var

    LClassName: string;

begin

    if Registered(AClass) then

    begin

        LClassName := AClass.ClassName;

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

    end

    else

        FClassList.Add(AClass);

end;

 

function TClassManager.Registered(AClass: TBaseObjectClass): Boolean;

begin

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

end;

 

procedure TClassManager.UnregisterClass(AClass: TBaseObjectClass);

begin

    FClassList.Remove(AClass);

end;

 

initialization

    ClassManager := TClassManager.Create;

    RegisterClasses([TObjectA,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;