《GOF设计模式》—原型(Prototype)—Delphi源码示例：基于Assign方法的拷贝

说明：

在VCL中，TPersistent 的Assign 方法常用于对象复制。Assign 方法在TPersistent 类中被声明为虚方法，以允许其派生类实现自己的复制操作。如果TPersistent的派生类没有重写Assign 方法，则Assign 方法会调用源对象的AssignTo方法来实现复制操作。

代码：

unit uPrototypeClone;

 

interface

 

uses

    Classes;

 

type

    TBaseObject = class(TPersistent)

    private

        FState: string;

    public

        function Clone: TBaseObject; virtual; abstract;

        //---

        property State: string read FState write FState;

    end;

    TObjectA = class(TBaseObject)

    public

        procedure Assign(Source: TPersistent); override;

        function Clone: TBaseObject; override;

    end;

    TObjectB = class(TBaseObject)

    protected

        procedure AssignTo(Dest: TPersistent); override;

    public

        function Clone: TBaseObject; override;

    end;

 

    TClient = class

    private

        FPrototype: TBaseObject;

    public

        constructor Create(Prototype: TBaseObject);

        destructor Destroy; override;

        //---

        function CreateObject: TBaseObject;

    end;

 

implementation

 

procedure TObjectA.Assign(Source: TPersistent);

begin

    if Source is TObjectA then

    begin

        with Source as TObjectA do

        begin

            self.State := State;

        end;

    end

    else

        inherited;

end;

 

function TObjectA.Clone: TBaseObject;

begin

    Result := TObjectA.Create;

    Result.Assign(self);

end;

 

procedure TObjectB.AssignTo(Dest: TPersistent);

begin

    if Dest is TObjectB then

    begin

        with Dest as TObjectB do

        begin

            State := self.State;

        end;

    end

    else

        inherited;

end;

 

function TObjectB.Clone: TBaseObject;

begin

    Result := TObjectB.Create;

    Result.Assign(self);

end;

 

constructor TClient.Create(Prototype: TBaseObject);

begin

    FPrototype := Prototype;

end;

 

destructor TClient.Destroy;

begin

    FPrototype.Free;

    //---

    inherited;

end;

 

function TClient.CreateObject: TBaseObject;

begin

    Result := FPrototype.Clone;

end;

 

end.

 

procedure TForm1.Button1Click(Sender: TObject);

var

    APrototype,AObject: TBaseObject;

    AClient: TClient;

begin

    APrototype := TObjectB.Create;

    APrototype.State := 'Prototype B';

    //---

    AClient := TClient.Create(APrototype);

    try

        AObject := AClient.CreateObject;

        showmessage(AObject.State);

        AObject.Free;

    finally

        AClient.Free;

    end;

end;