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