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

示例：基于流操作的拷贝

说明：

在VCL中，继承自TPersistent的类实现了对象的流化存储。流对象技术不仅是Delphi 可视化设计的核心，也为原型模式的实现提供了更为方便、简单和通用的对象克隆方法。

通过TStream流的写方法可以把对象转化成数据保存在内存或文件中；同样，通过TStream流的读方法可以把保存在内存或文件中的数据重新转化成对象。

注意：

<1>、只有published域的数据成员才能够被自动流化。

<2>、在published域声明的对象必须是TPersistent 的派生类。

<3>、在published域声明的属性必须设置读写方法，才能被流化。

如：

    TObjectB = class(TBaseObject)

    private

        FState1: TStateObject;

        FState2: string;

        procedure SetState1(const Value: TStateObject);

    published

        property State1: TStateObject read FState1 write SetState1;

        property State2: string read FState2 write FState2;

end;

<4>、对于继承自TComponent的组件，只有具有子组件或设置过组件名才能被流化。

<5>、从流中读出对象前，要先使用RegisterClass 或RegisterClasses 注册相关的类，否则会报EClassNotFound 异常（即提示找不到类）。

实现：

TBaseObject类提供Save和Load操作为Clone操作定义了一个缺省实现。Save操作将该对象保存在内存缓冲区中（使用WriteComponentResFile方法实现），而Load则通过从该缓冲区中重构这个对象来创建一个复本（使用ReadComponentResFile方法实现）。

代码：

unit uPrototypeClone1;

 

interface

 

uses

    Classes;

 

type

    TStateObject = class(TPersistent)

    private

        FState: string;

    public

        constructor Create;

    published

        property State: string read FState write FState;

    end;

 

    TBaseObject = class(TComponent)

    private

        FState: string;

        procedure Save;

        function Load: TBaseObject;

    public

        function Clone: TBaseObject;

        function GetAllState: string; virtual;

    published

        property State: string read FState write FState; //--基本类型

    end;

 

    TObjectA = class(TBaseObject)

    end;

 

    TObjectB = class(TBaseObject)

    private

        FMyState: TStateObject;

        procedure SetMyState(const Value: TStateObject);

    public

        constructor Create(AOwner: TComponent); override;

        destructor Destroy; override;

        //---

        function GetAllState: string; override;

    published

        property MyState: TStateObject read FMyState write SetMyState; //---使用继承自TPersistent的类

    end;

 

    TObject_SubComponent = class(TBaseObject)

    protected

        procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;

    end;

 

    TObjectC = class(TObject_SubComponent)

    private

        FMyState: TBaseObject;

    public

        constructor Create(AOwner: TComponent); override;

        destructor Destroy; override;

        //---

        function GetAllState: string; override;

    published

        property MyState: TBaseObject read FMyState write FMyState; //---使用继承自TComponent的类

    end;

 

    TObjectD = class(TObject_SubComponent) //---使用Components[I]

    public

        function GetAllState: string; override;

    end;

 

    TClient = class

    private

        FPrototype: TBaseObject;

    public

        constructor Create(Prototype: TBaseObject);

        destructor Destroy; override;

        //---

        function CreateObject: TBaseObject;

    end;

 

implementation

 

constructor TStateObject.Create;

begin

    FState := '';

end;

 

function TBaseObject.GetAllState: string;

begin

    Result := FState;

end;

 

function TBaseObject.Load: TBaseObject;

begin

    Result := TBaseObject(ReadComponentResFile('Prototype.dat',nil));

end;

 

procedure TBaseObject.Save;

begin

    WriteComponentResFile('Prototype.dat',self);

end;

 

function TBaseObject.Clone: TBaseObject;

begin

    self.Save;

    Result := self.Load;

end;

 

constructor TObjectB.Create;

begin

    inherited;

    //---

    FMyState := TStateObject.Create;

end;

 

destructor TObjectB.Destroy;

begin

    FMyState.Free;

    //---

    inherited;

end;

 

function TObjectB.GetAllState: string;

begin

    Result := FState + FMyState.State;

end;

 

procedure TObjectB.SetMyState(const Value: TStateObject);

begin

 

end;

 

procedure TObject_SubComponent.GetChildren(Proc: TGetChildProc; Root:

    TComponent);

var

    I: Integer;

begin

    for I := 0 to ComponentCount - 1 do

        Proc(Components[I]);

end;

 

constructor TObjectC.Create;

begin

    inherited;

    //---

    FMyState := nil;

end;

 

destructor TObjectC.Destroy;

begin

    if assigned(FMyState) then

        FMyState.Free;

    //---

    inherited;

end;

 

function TObjectC.GetAllState: string;

begin

    if assigned(FMyState) then

        Result := FState + FMyState.GetAllState

    else

        Result := FState;

end;

 

function TObjectD.GetAllState: string;

var

    I: Integer;

begin

    Result := FState;

    //---

    for I := 0 to ComponentCount - 1 do

    begin

        if Components[I] is TBaseObject then

            Result := Result + TBaseObject(Components[I]).GetAllState;

    end;

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;

 

initialization

    RegisterClasses([TObjectA,TObjectB,TObjectC,TObjectD]);

 

finalization

 

end.

 

unit Unit1;

 

interface

 

uses

    Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,

    StdCtrls,ExtCtrls;

 

type

    TForm1 = class(TForm)

        Button1: TButton;

        Button2: TButton;

        Button3: TButton;

        Memo1: TMemo;

        Button4: TButton;

        Button5: TButton;

        procedure Button1Click(Sender: TObject);

        procedure Button2Click(Sender: TObject);

        procedure Button3Click(Sender: TObject);

        procedure Button4Click(Sender: TObject);

        procedure Button5Click(Sender: TObject);

    private

 

    public

    { Public declarations }

    end;

 

var

    Form1: TForm1;

 

implementation

 

uses TypInfo,uPrototypeClone1;

 

{$R *.DFM}

 

procedure TForm1.Button1Click(Sender: TObject);

var

    APrototype,AObject: TBaseObject;

    AClient: TClient;

begin

    APrototype := TObjectA.Create(nil);

    APrototype.State := 'Prototype A';

    //---

    AClient := TClient.Create(APrototype);

    try

        AObject := AClient.CreateObject;

        showmessage(AObject.GetAllState);

        AObject.Free;

    finally

        AClient.Free;

    end;

end;

 

procedure TForm1.Button2Click(Sender: TObject);

var

    APrototype: TObjectB;

    AObject: TBaseObject;

    AClient: TClient;

begin

    APrototype := TObjectB.Create(nil);

    with APrototype do

    begin

        State := 'Object B';

        MyState.State := ' 123';

    end;

    //---

    AClient := TClient.Create(APrototype);

    try

        AObject := AClient.CreateObject;

        showmessage(AObject.GetAllState);

        AObject.Free;

    finally

        AClient.Free;

    end;

end;

 

procedure TForm1.Button3Click(Sender: TObject);

var

    APrototype: TObjectC;

    AObject: TBaseObject;

    AClient: TClient;

begin

    APrototype := TObjectC.Create(nil);

    with APrototype do

    begin

        State := 'Object C';

        //---

        MyState := TBaseObject.Create(APrototype);

        with MyState do

        begin

            Name := 'FState'; //--对于继承自TComponent的组件，作为property时，只有设置过组件名才能被流化。

            State := ' 123';

        end;

    end;

    //---

    AClient := TClient.Create(APrototype);

    try

        AObject := AClient.CreateObject;

        try

            showmessage(AObject.GetAllState);

            //---

            with TObjectC(AObject) do

            begin

                if (MyState = nil) or (MyState = APrototype.MyState) then

                    showmessage('浅拷贝 AObject.MyState为引用')

                else

                    showmessage('深拷贝 AObject.MyState为新对象');

            end;

        finally

            AObject.Free;

        end;

    finally

        AClient.Free;

    end;

end;

 

procedure TForm1.Button4Click(Sender: TObject);

var

    APrototype,APrototype1,APrototype2: TObjectC;

    AObject: TBaseObject;

    AClient: TClient;

begin

    APrototype := TObjectC.Create(nil);

    APrototype.State := 'Object C';

    //---

    APrototype1 := TObjectC.Create(APrototype);

    with APrototype1 do

    begin

        Name := 'Prototype1';

        State := ' 123';

    end;

    APrototype.MyState := APrototype1;

    //---

    APrototype2 := TObjectC.Create(APrototype);

    with APrototype2 do

    begin

        Name := 'Prototype2';

        State := ' 123';

    end;

    APrototype1.MyState := APrototype2;

    //---

    AClient := TClient.Create(APrototype);

    try

        AObject := AClient.CreateObject;

        showmessage(AObject.GetAllState);

        AObject.Free;

    finally

        AClient.Free;

    end;

end;

 

procedure TForm1.Button5Click(Sender: TObject);

var

    APrototype: TObjectD;

    APrototype1: TObjectA;

    APrototype2: TObjectB;

    APrototype3: TObjectC;

    AObject: TBaseObject;

    AClient: TClient;

begin

    APrototype1 := TObjectA.Create(nil);

    APrototype1.State := ' 12';

    //---

    APrototype2 := TObjectB.Create(nil);

    APrototype2.State := ' 34';

    APrototype2.MyState.State := ' 56';

    //---

    APrototype3 := TObjectC.Create(nil);

    APrototype3.State := ' 78';

    //---

    APrototype := TObjectD.Create(nil);

    APrototype.State := 'ObjectD';

    APrototype.InsertComponent(APrototype1);

    APrototype.InsertComponent(APrototype2);

    APrototype.InsertComponent(APrototype3);

    //---

    AClient := TClient.Create(APrototype);

    try

        AObject := AClient.CreateObject;

        showmessage(AObject.GetAllState);

        AObject.Free;

    finally

        AClient.Free;

    end;

end;

 

end.