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.
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.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: