Delphi clone object

This is a nice piece of code I found over at Delphi Haven (Chris Rollingston). I have cleaned it up a bit, moved it out of its record type placeholder, and now use it in a baseclass in my toolbox.

The clones are coming!

Why cloning?

Cloning is something which is very hard to do under Delphi. Other languages like .Net and Java enjoy this en-mass, but it goes without saying that under a virtual language (bytecodes) the assembly information is fairly well evolved compared to a native language. Thankfully, Delphi’s RTTI is getting better and better so we are almost there.

I must have seen hundreds of “deep copy” cloning variations over the years, but this is actually the first one that in my experience is good enough to get the job done. It goes without saying that I’m sure you can compose some class which wont clone perfectly, recursive properties are especially problematic and also nested components or controls. But for plain classes in a hierarchy it works brilliantly and makes my programming life easier.

Note: Just ignore the class structure, just copy the Clone() method to your own class.

type
  TMSPersistent = Class(TMSObject,ISerializable)
  strict protected
    (* ISerializable *)
    function  GetObjectData:TMSSerializationInfo;virtual;
  public
    function Clone(const Parameters:Array of TValue): T;
  end;

function TMSPersistent.Clone(const Parameters:Array of TValue): T;
var
  Context: TRttiContext;
  IsComponent, LookOutForNameProp: Boolean;
  RttiType: TRttiType;
  Method: TRttiMethod;
  MinVisibility: TMemberVisibility;
  Params: TArray;
  Prop: TRttiProperty;
  SourceAsPointer, ResultAsPointer: Pointer;
begin
  RttiType := Context.GetType(self.ClassType);

  isComponent := self.InheritsFrom(TComponent);
  for Method in RttiType.GetMethods do
  Begin
    if Method.IsConstructor then
    begin
      Params := Method.GetParameters;
      if Params = nil then Break;
      if (Length(Params) = 1)
      and IsComponent
      and (Params[0].ParamType is TRttiInstanceType)
      and SameText(Method.Name, 'Create') then
      Break;
    end;
  end;

  if Method<>NIL then
  Result := Method.Invoke(self.ClassType, Parameters).AsType else
  Raise Exception.Create('No constructor found error');

  try
    if self.InheritsFrom(TControl) then
    TControl(Result).Parent := TControl(self).Parent;

    Move(self, SourceAsPointer, SizeOf(Pointer));
    Move(Result, ResultAsPointer, SizeOf(Pointer));
    LookOutForNameProp := IsComponent and (TComponent(self).Owner <> nil);
    if IsComponent then
    MinVisibility := mvPublished  else
    MinVisibility := mvPublic;

    for Prop in RttiType.GetProperties do
    begin
      if  (Prop.Visibility >= MinVisibility)
      and Prop.IsReadable and Prop.IsWritable then
      Begin
        if LookOutForNameProp and (Prop.Name = 'Name')
        and (Prop.PropertyType is TRttiStringType) then
        LookOutForNameProp := False else
        Prop.SetValue(ResultAsPointer, Prop.GetValue(SourceAsPointer));
      end;
    end;
  except
    Result.Free;
    raise;
  end;
end;

Using the method

The method allows you to clone any object, and you can also provide parameters for the constructor (if any). It works like this:

type

//Inherit from an object which has the clone method
TMyClass = Class(TMSPersistent)
private
  FText:  String;
public
  Property  Text:String read FText write FText;
end;

Procedure TForm1.Button1Click(sender:TObject);
var
  first, second:TMyClass;
begin
  First:=TMyClass.Create;
  First.Text:='This is the first object';

  Second:=First.Clone<TMyClass>([]);
  showmessage(second.Text);
end;

In the above code we simply ship in the parameters as an empty array []. This is because TMyClass doesnt have any parameters for it’s constructor.
Had it been a TComponent you would have done something like this:

Second:=First.Clone<TMyClass>([first.Owner]);