Object cloning using the high level RTTI

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!

Advertisements

24 thoughts on “Object cloning using the high level RTTI

  1. NewButton := TObjectClone.From(btnClone);

    This has to be like this:

    NewButton := TObjectClone.From<TButton>(btnClone);

  2. Please fix my last comment, because the type is missing after the second .From. There will be a filter for the squared brackets :-/ Thanks!

  3. 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” – 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…?

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

  5. Pingback: /*Prog*/ Delphi-Neftalí /*finProg*/ » Una quincena más… (22/06/2011)

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

  7. Pingback: FreePascal Komponente mit Ereignissen Kopieren - Delphi-PRAXiS

  8. 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
    😦

  9. Pingback: Delphi clone object | Jon L. Aasenden

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

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s