浅拷贝与深度拷贝(原型模式)

Delphi的VCL从TPersistent开始支持RTTI(RuntimeTypeInfo)运行时类型信息,它是通过{$M+}编译指令提供了RTTI的功能.M打开以后,Delphi在编译该对象时,会把对象的类型信息编译进可执行文件,这样在运行时就可以动态地获得对象的属性和方法等信息.因为所有的VCL可视化组件都是从TPersistent派生的,因此可以将组件信息保存到dfm也可以动态加载.

Delphi还定义了一个虚方法Assign,

 

procedure Assign(Source:TPersistent);virtual;

 

这个方法就是用来把源对象属性复制到目标对象中的.默认的TPersistent对象的Assign方法只是简单的调用源对象的AssignTo方法来复制属性,而TPersistent的AssignTo方法只是抛出一个异常,没有实现有意义的功能,那么派生自TPersistent的对象要想提供克隆的功能都需要重载TPersistent的Assign或AssignTo来实现自定义的复制功能.

获取类的属性列表:要引用TypInfo//rtti,contnrs,classes,sysutils;//{$M+}要打开.

 

procedure GetPropNames(AObject:TObject;var List:TStringList);
var
  I,Count:Integer;
  PropList:PPropList;//数组型指针,数组又是指向属性的纪录型信息的指针型数组.
  PKinds:TTypeKinds;//类型信息的集合
begin
  List.Clear;
  PKinds := [tkUnknow,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<>DesObj.ClassName then
  raise Exception.Create('不同类型的对象,无法克隆');
  if (not Assigned(SrcObje)) or not (Assigned(DesObj)) then
  raise Exception.Create('对象不能为空');
  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);
finally
  Namelist.free;
end;
end;

 

 

其中GetPropName函数调用Delphi的TypeInfo单元的Rtti函数获得要克隆对象的保护级别为Published的属性名称字符串列表.而CloneObject则遍历对象的属性列表,使用RTTI函数GetPropValue通过属性名获得对象的属性值,然后通过RTTI函数的SetPropValue将获得源对象值赋值给目标对象.注意RTTI函数只对Published属性有效,其它保护级别的属性无效.

上面的对象复制函数对于复合的对象如下级对象的TreeView,TStrings是无效的,对于这类对象还必须手工完成.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;

 

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的VCL从TPersistent开始支持RTTI(RuntimeTypeInfo)运行时类型信息,它是通过{$M+}编译指令提供了RTTI的功能.M打开以后,Delphi在编译该对象时,会把对象的类型信息编译进可执行文件,这样在运行时就可以动态地获得对象的属性和方法等信息.因为所有的VCL可视化组件都是从TPersistent派生的,因此可以将组件信息保存到dfm也可以动态加载.
Delphi还定义了一个虚方法Assign,procedure Assign(Source:TPersistent);virtual;
这个方法就是用来把源对象属性复制到目标对象中的.默认的TPersistent对象的Assign方法只是简单的调用源对象的AssignTo方法来复制属性,而TPersistent的AssignTo方法只是抛出一个异常,没有实现有意义的功能,那么派生自TPersistent的对象要想提供克隆的功能都需要重载TPersistent的Assign或AssignTo来实现自定义的复制功能.

 

获取类的属性列表:要引用TypInfo//rtti,contnrs,classes,sysutils;//{$M+}要打开.

 

procedure GetPropNames(AObject:TObject;var List:TStringList);
var
  I,Count:Integer;
  PropList:PPropList;//数组型指针,数组又是指向属性的纪录型信息的指针型数组.
  PKinds:TTypeKinds;//类型信息的集合
begin
  List.Clear;
  PKinds := [tkUnknow,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<>DesObj.ClassName then
  raise Exception.Create('不同类型的对象,无法克隆');
  if (not Assigned(SrcObje)) or not (Assigned(DesObj)) then
  raise Exception.Create('对象不能为空');
  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);
finally
  Namelist.free;
end;
end;

其中GetPropName函数调用Delphi的TypeInfo单元的Rtti函数获得要克隆对象的保护级别为Published的属性名称字符串列表.而CloneObject则遍历对象的属性列表,使用RTTI函数GetPropValue通过属性名获得对象的属性值,然后通过RTTI函数的SetPropValue将获得源对象值赋值给目标对象.注意RTTI函数只对Published属性有效,其它保护级别的属性无效.
上面的对象复制函数对于复合的对象如下级对象的TreeView,TStrings是无效的,对于这类对象还必须手工完成.

 

 

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;

 

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;

http://blog.csdn.net/sushengmiyan/article/details/7467196