Someone’s probably demoed this before, and quite possibly demoed it better too, but hey, here’s my idea of generic object cloning using the high level RTTI. To be honest, in practice, I’m not sure this sort of thing – i.e., a completely generalised approach – is a very good idea, as indeed the small workarounds given for handling components and controls indicates. Makes a neat demo though I think:
unit ObjectClone; interface type TObjectClone = record class function From<T: class>(Source: T): T; static; end; implementation uses SysUtils, Classes, TypInfo, RTTI, Controls; class function TObjectClone.From<T>(Source: T): T; var Context: TRttiContext; IsComponent, LookOutForNameProp: Boolean; RttiType: TRttiType; Method: TRttiMethod; MinVisibility: TMemberVisibility; Params: TArray<TRttiParameter>; Prop: TRttiProperty; SourceAsPointer, ResultAsPointer: Pointer; begin RttiType := Context.GetType(Source.ClassType); //find a suitable constructor, though treat components specially IsComponent := (Source is TComponent); for Method in RttiType.GetMethods do 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; if Params = nil then Result := Method.Invoke(Source.ClassType, []).AsType<T> else Result := Method.Invoke(Source.ClassType, [TComponent(Source).Owner]).AsType<T>; try //many VCL control properties require the Parent property to be set first if Source is TControl then TControl(Result).Parent := TControl(Source).Parent; //loop through the props, copying values across for ones that are read/write Move(Source, SourceAsPointer, SizeOf(Pointer)); Move(Result, ResultAsPointer, SizeOf(Pointer)); LookOutForNameProp := IsComponent and (TComponent(Source).Owner <> nil); if IsComponent then MinVisibility := mvPublished //an alternative is to build an exception list else MinVisibility := mvPublic; for Prop in RttiType.GetProperties do if (Prop.Visibility >= MinVisibility) and Prop.IsReadable and Prop.IsWritable then if LookOutForNameProp and (Prop.Name = 'Name') and (Prop.PropertyType is TRttiStringType) then LookOutForNameProp := False else Prop.SetValue(ResultAsPointer, Prop.GetValue(SourceAsPointer)); except Result.Free; raise; end; end; end.
The XXXAsPointer thing is to get around a compiler bug/limitation, though the rest of it is perfectly clean code.
To try it out, create a new VCL application, add a button and set its Align property to alLeft, its AlignWithMargins property to True, its Caption to ‘Clone Me!’ and its Name to ‘btnClone’, before assigning its OnClick handler to be as thus:
uses ObjectClone; procedure TForm1.btnCloneClick(Sender: TObject); var NewButton: TButton; begin NewButton := TObjectClone.From(btnClone); end;
The local variable is just for clarity – you can remove it if you prefer. Run the application, and you should get something like this in a few clicks:
That said, don’t bother suggesting I use a ‘stream out and back in again’ approach instead since I already know about it. 😉
Postscript: while I’m about it, I thought I’d add a Delphi example to Wikipedia’s ‘Reflection (computer programming)’ page. Here’s the code I added (it’s on the model of the examples for the other languages listed there):
uses RTTI, Unit1; procedure WithoutReflection; var Foo: TFoo; begin Foo := TFoo.Create; try Foo.Hello; finally Foo.Free; end; end; procedure WithReflection; var RttiContext: TRttiContext; RttiType: TRttiInstanceType; Foo: TObject; begin RttiType := RttiContext.FindType('Unit1.TFoo') as TRttiInstanceType; Foo := RttiType.GetMethod('Create').Invoke(RttiType.MetaclassType, []).AsObject; try RttiType.GetMethod('Hello').Invoke(Foo, []); finally Foo.Free; end; end;
Whether it stays there is another matter I guess!
NewButton := TObjectClone.From(btnClone);
This has to be like this:
NewButton := TObjectClone.From<TButton>(btnClone);
That is not correct – the compiler (XE’s at least) can infer the type in simple cases like this, so my original code stands.
Then you can delete my second comment, thanks 😉 Okay… I haven’t know this. Is there any documentation for this? I never heard or read about this!
“Is there any documentation for this?”
Well I first found out about it myself when looking at demos that used TValue.From, but it’s in the docs too: ms-help://embarcadero.rs_xe/rad/Declaring_Generics.html#Parameterized_Methods for DExplore or http://docwiki.embarcadero.com/RADStudio/en/Declaring_Generics#Parameterized_Methods on the web.
Wow, I must have missed this. And I always wondered if this is possible in Delphi but never actually tried it 🙂
Please fix my last comment, because the type is missing after the second .From. There will be a filter for the squared brackets Thanks!
I’ve fixed it but you’re still wrong 😉
now this is nice!! has many applications, especially when one needs to clone an object visible in one form, to another form, simply awesome!!
Thank you!!
You can get rid of the XXXAsPointer thing with a hardcast to TObject which is valid because you have the class constraint (which should indeed tell the compiler that T is a TObject and therefor compatible with Pointer).
I wish we had proper extension methods support in delphi…
This would be awesome imo:
TObjectHelper = class helper for TObject
function Clone(Self: T): T;
end;
Of course it ate the parameter T: class of Clone again…
“Of course it ate the parameter” – I’m probably being dense, but where does the parameter go? Presumably T should be a placeholder for the concrete type of the thing itself, rather than a ‘parameter’ to the type…?
Regarding the cast, thanks. I’ve become vary wary of casts on type parameters though – I always seem to be just a short distance away from an internal compiler error with them. Can I take it casting a class type parameter to TObject definitely works in your experience though…?
In my current project, I have implemented something similar, but limited it to our framework classes, which is basically a set of node and list classes that allow building data trees from relational data . Since those classes pull data from db tables, I want to have a mirror image of each object instance created on every load and save of content – so that I can determine if the object contents are changed before I attempt to save. I.e. RootInstance.IsDirty traverse the list of lists of lists (and so forth) to determine if anything have changed.
This allows me to create smart GUI that have save buttons that light up only when there is an actual change of content in the data tree, after changes or undo’s, and it also limits the database writes to only those rows that actually have a change.
Since some objects contain lazy-loaded denormalized content or change related timestamps, I also need to have a NoCopy attribute that can be put on properties that shouldn’t be compared.
But – I have found that using RTTI to compare the two instances – the working object, and it’s shadow copy – is very costly when you have to compare hundreds or thousands of objects.
Since I am limiting the clone/compare functionality to this specific class hierarchy, I have found a way to optimize it. I have to use RTTI to enumerate the properties to get at their values – I can’t get away from that, but I found out that I can get away with checking each property’s attributes only once.
I decided that since the RTTI property and attribute metadata doesn’t change during runtime, I can create a lookup list class variable that hold a NoCopy list for all the class types.
The first time a class type is compared, the attributes for each property are traversed and saved in that lookuplist. Since the order of properties is deterministic, I can get away with simply tracking the index of the properties I am looking at, and use an array of booleans to store the Copy/NoCopy state which tell if I should copy or compare the current property.
Pingback: /*Prog*/ Delphi-Neftalí /*finProg*/ » Una quincena más… (22/06/2011)
Hi
I was wondering what you were using to display code? and how it was added to your wordpress blog. I have one @ joemele.wordpress.com and the technique I found on the net was bad.
See here: http://en.support.wordpress.com/code/posting-source-code/
thanks!
Pingback: FreePascal Komponente mit Ereignissen Kopieren - Delphi-PRAXiS
unfortunately Delphi 2010 fails at these two lines of code:
IsComponent := Source is TComponent;
and
if Source is TControl then
In both cases the compiler complains:
[DCC Error] … E2015 Operator not applicable to this operand type
😦
IIRC that post was written using XE. I’ll have a look at D2010 later for you.
Pingback: Delphi clone object | Jon L. Aasenden
I saw the Delphi example was removed in 2012. I’ve reinstated it with a note about why Delphi’s reflection is notable.
Hi Chris,
I’ve just tried this in Delphi 10 Seattle and it works well on cloning buttons but then causes an invalid pointer operation when exiting the program. I’ve tried Freeing the cloned buttons one by one and it seems a second cloned object overwrites part of the first when freed causing an exception. Have you seen anything like this?
Any thoughts on how to avoid this clean up problem would be most appreciated.
Thanks,
Adam
VCL or FMX…?
FMX