原型模式-对象拷贝[转]

原型模式(Prototype)
作者 陈省

复制功能应该说是一个软件系统非常常见的功能，有人曾经说过“聪明的程序员，是偷窃别人思想的程序员”，我不知道我算不算聪明的程序员，但是我确实很喜欢将别人写过的我需要的功能代码复制到我的项目中去。

同样的，在面向对象程序开发中，复制同样是有非常有意义的。很多时候构造一个对象会很复杂，需要设定n多的参数，并且调用很多方法。如果这个对象需要很多实例，那么重复的进行复杂的创建过程就非常容易出错，那么对于这类问题的一个很好的解决模式就是克隆系统中已有的对象，然后对其属性进行少量或不做修改，这也就是原型模式。

Delphi中的原型模式

在Delphi的VCL有一个非常重要的类TPersistent，从它的名字（可持续类）上可以知道该类提供了可持续性的功能，Vcl的基类TObject本身不支持Rtti(运行时类型信息)，而TPersistent类通过{$M+}编译指令提供了RTTI的功能，打开了M开关后，Delphi在编译该对象时，会把对象的类型信息也编译进可执行文件，这样在运行时就可以动态的获得对象的属性，方法等信息，所有的VCL可视化组件都是从TPersistent派生出来的，因此可以将组件信息保存成DFM文件，可以在运行时加载。

 除了RTTI外，TPersistent类定义了一个非常重要的虚方法Assign，方法的定义如下：
    procedure Assign(Source: TPersistent); virtual;
这个方法其实和Java中的Clone方法和C++中的Copy Constructor构造函数一样，就是用来把一个源对象的属性复制到目标对象中。略微有些不同的是Java中的Clone和C++中的拷贝构造函数直接返回源对象的副本，而调用Assign方法前，我们需要先Create一个目标对象，然后再复制源对象的属性。默认的TPersistent对象的Assign方法只是简单的调用源对象的AssignTo方法来复制属性，而TPersistent的AssignTo虚方法只是简单的抛出一个异常。也就是说TPersistent方法并没有实现任何有意义的功能，那么对于派生自TPersistent类的对象要想提供克隆的功能都需要重载TPersistent的Assign或者AssignTo方法来实现自定义的复制功能，在Vcl中很多的类都实现了定制的Assign方法，比如最常见的TStrings类就重载了Assign方法提供了字符串列表的复制功能，在程序开发中经常会有需要将一个列表框的选项全部移动到另外一个列表中表示选择了全部的内容，这个过程其实就是一个克隆的过程，使用Assign方法来实现就非常简单，代码示意如下：

//将源列表框中的内容复制到目标列表框中

procedure TForm1.btnMoveClick(Sender: TObject);
begin
  DesListBox.Items.Assign(SrcListBox.Items);
end;
 

浅拷贝

 

在C++中对对象提供了一个默认的Copy Constructor，可以按照对象的成员值依次复制到新的对象。在Delphi中并没有提供这项功能，那么一般来说，重载对象的Assign方法就需要向下面这样把所有对象的属性硬编码来进行赋值，

procedure TCloneObj.Assign(Source: TPersistent);

begin

  if Source is TCloneObj then

  begin

A:=TCloneObj(Source).A;

    B:=TCloneObj(Source).A;

//…

  end

  else

inherited Assign(Source);

end;

 

如果一个对象有几十个属性的话，写赋值代码就会很无聊、费时间，并且当对象属性变化时很可能会忘记修改Assign方法，导致奇怪的错误。那么有没有办法像C++那样提供按属性自动赋值的浅拷贝的赋值方法呢，前面提到了TPersistent类支持RTTI，那么我们可以利用RTTI来模拟C++的行为，实现自动的属性赋值。下面是我写的复制函数:

 

unit CXRTTILib;
interface
uses Classes, TypInfo, Sysutils, contnrs;
 
//获得对象的Published属性名称列表
procedure GetPropNames(AObject: TObject; var List: TStringList);
//复制对象
procedure CloneObject(SrcObj, DesObj: TPersistent);
 
implementation
 
procedure GetPropNames(AObject: TObject; var List: TStringList);
var
  I, Count: Integer;
  PropList: PPropList;
  PKinds: TTypeKinds;
begin
  List.Clear;
  PKinds := [tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
    tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
    tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray];
 
  Count := GetPropList(AObject.ClassInfo, PKinds, nil);
  GetMem(PropList, Count * SizeOf(Pointer));
  GetPropList(AObject.ClassInfo, PKinds, PropList);
  for I := 0 to Count - 1 do
    List.Add(PropList^[i].Name);
  FreeMem(PropList, Count * SizeOf(Pointer));
end;
 
procedure CloneObject(SrcObj, DesObj: TPersistent);
var
  NameList: TStringList;
  I: Integer;
  V: Variant;
begin
  //先判断对象类型是否一致
  if SrcObj.ClassName <> SrcObj.ClassName then
    raise Exception.Create('不同类型的对象，无法克隆');
  if (not Assigned(SrcObj)) or (not Assigned(DesObj)) then
    raise Exception.Create('对象不能为nil');
 
  //如果相同，就获得SrcObj的属性列表
  NameList := TStringList.Create;
  GetPropNames(SrcObj, NameList);
  try
    //然后边历属性进行赋值
    for I := 0 to NameList.Count - 1 do
    begin
      V := GetPropValue(SrcObj, NameList.Strings[I]);
      SetPropValue(DesObj, NameList.Strings[I], V);
    end;
  finally
    NameList.Free;
  end;
end;
 
end.
 

其中GetPropNames函数调用Delphi的TypInfo单元中的Rtti函数获得要克隆对象的保护级别为Published的属性名称字符串列表。而CloneObject则遍历对象的属性列表，使用Rtti函数GetPropValue通过属性名获得对象的属性值，然后通过Rtti函数SetPropValue将获得源对象值赋值给目标对象。要注意的是函数中使用TypInfo单元中的Rtti函数都是未经归档的函数，你在Delphi的帮助中找不到这些函数的说明（因为Delphi的R&D Team有可能会在未来修改这些函数，因此没有公开这些函数的调用说明，也就是说使用这些未公开的函数会有风险），不过Ray Liskner在他的《Delphi技术手册》中，对这些Rtti函数进行了非常详细的论述，在这里我不打算把他的叙述再重复一遍，感兴趣的朋友参考该书的内容。还要说明的就是Rtti函数只对Published属性有效，对Public和Protect保护级别的属性无效，因此必须保证你定义的对象的属性都声明为Published，这个函数才有效。

 

深度拷贝

 

上面的对象复制函数对于复合的对象，如包含下级对象的TreeView，ListView以及包含信息列表的类如TStrings是无效，对于这类对象还是必须手工完成克隆代码的编写。下面是TStrings的Assign方法的实现。

 

procedure TStrings.Assign(Source: TPersistent);
begin
  if Source is TStrings then
  begin
    BeginUpdate;
    try
      Clear;
      FDefined := TStrings(Source).FDefined;
      FNameValueSeparator := TStrings(Source).FNameValueSeparator;
      FQuoteChar := TStrings(Source).FQuoteChar;
      FDelimiter := TStrings(Source).FDelimiter;
      AddStrings(TStrings(Source));
    finally
      EndUpdate;
    end;
    Exit;
  end;
  inherited Assign(Source);
end;
 

不同对象之间的clone

 

Delphi的Assign方法除了可以实现同样类型对象的克隆之外，还可以实现不同对象之间的克隆，最典型的就是剪贴板类TClipBoard了，Windows的剪贴板可以存放很多不同类型的数据，如文本，位图，图元等等。为了实现将剪贴板中的位图数据直接复制给对应的TBitmap或者TMetafile类，VCL重载了TClipboard类的AssignTo方法来实现将数据复制给不同的对象：

 

procedure TClipboard.AssignTo(Dest: TPersistent);
begin
  if Dest is TPicture then
    AssignToPicture(TPicture(Dest))
  else if Dest is TBitmap then
    AssignToBitmap(TBitmap(Dest))
  else if Dest is TMetafile then
    AssignToMetafile(TMetafile(Dest))
  else inherited AssignTo(Dest);
end;
 

procedure TClipboard.AssignToBitmap(Dest: TBitmap);
var
  Data: THandle;
  Palette: HPALETTE;
begin
  Open;
  try
    Data := GetClipboardData(CF_BITMAP);
    Palette := GetClipboardData(CF_PALETTE);
    Dest.LoadFromClipboardFormat(CF_BITMAP, Data, Palette);
  finally
    Close;
  end;
end;
 

procedure TClipboard.AssignToMetafile(Dest: TMetafile);
var
//省略…
begin
//省略…
end;
 

procedure TClipboard.AssignToPicture(Dest: TPicture);
var
//…
Begin
  //省略…
end;
 

从这种应用来看,Delphi中的Assign方法比Java中的Clone方法以及C++中的拷贝构造函数应用范围更加广泛。