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

Adding scripting support to a Delphi application, again

I’ve updated the Delphi 2010 IDispatch proxy code I posted a couple of weeks ago, fixing a few bugs, improving how Delphi exceptions are handled in my IDispatch.Invoke implementation, and adding some set type support. For the latter, set values are now surfaced as objects with Empty and Contains methods, with the creation of new set values in script being made possible via a new descendent of TCustomDispProxy specially for set types.

That said, I’ve also added a more realistic demo in the form of a scriptable version of the old text editor standby. Being ‘more realistic’ meant two things in particular: drastically cutting down the scope for scripts creating Delphi objects (the issue here being Delphi’s lack of garbage collection in combination with VBScript’s lack of a try/finally equivalent), and creating some script-specific classes to abstract from the application’s internals – basically, you don’t really want to be exposing an application’s internals directly.

One thing I should mention is that because I was finishing it right at the end of my trial period, there’s the odd bug in the new demo’s UI that I didn’t have the time to clean up – in particular, I forgot to add disabled images for the formatting actions, which causes their icons go a bit funny when the app loses the focus. Nonetheless, the proxy code itself should be pretty solid. If you want to see it in action, download the revised code from here.

Calling an event handler using RTTI

In the comments to my previous post, Barry Kelly has popped up to explain the reasons behind the limitations of the new RTTI interface I listed. One thing he did correct me on was the issue of event handlers, since while I had been thinking they are put into TValue records as anonymous methods, this is in fact not the case — in reality, they are put in as TMethod records, as you would expect.

This discovery made, I wondered whether it is possible to invoke event handlers using RTTI — and, in short, they indeed can, since while they cannot be invoked in a single call directly (TRttiMethodType not having an Invoke method), it isn’t hard to write a simple-ish wrapper routine to do the deed for you. One caveat, though, is that because you call Invoke upon a TRttiMethod instance, calling a handler whose type you don’t know up front requires its implementing method to be exposed by RTTI, which in practical terms means it must be with public or published scope. For event types you do know up front, however, you can avoid TRttiMethod completely and just call the handler directly, negating the need for its implementing method to be public or published.

Well, putting this and a bit of knowledge about the TMethod type all together, I came up with the following implementation:

uses
  Classes, TypInfo, Rtti, Controls;

resourcestring
  SMissingEvent = '%s does not have an event called %s';
  SPropertyNotAnEvent = '%s.%s is not an event';
  SEventHandlerHasInsufficientRTTI = 'Event handler does not ' +
    'have the required RTTI to be dynamically invoked';

function CallEventHandler(Instance: TObject; Event: TRttiProperty;
  const Args: array of TValue): TValue; overload;
var
  HandlerValue: TValue;
  HandlerObj: TObject;
  MethodRecPtr: ^TMethod;
  RttiContext: TRttiContext;
  RttiMethod: TRttiMethod;
begin
  if Event.PropertyType.TypeKind <> tkMethod then
    raise EInvocationError.CreateFmt(SPropertyNotAnEvent, [Instance.ClassName, Event.Name]);
  Result := nil;
  HandlerValue := Event.GetValue(Instance);
  if HandlerValue.IsEmpty then Exit;
  MethodRecPtr := HandlerValue.GetReferenceToRawData;
  { check for event types we know }
  if HandlerValue.TypeInfo = TypeInfo(TNotifyEvent) then
  begin
    TNotifyEvent(MethodRecPtr^)(Args[0].AsObject);
    Exit;
  end;
  if HandlerValue.TypeInfo = TypeInfo(TMouseEvent) then
  begin
    TMouseEvent(MethodRecPtr^)(Args[0].AsObject, TMouseButton(Args[1].AsOrdinal),
      Args[2].AsType<TShiftState>, Args[3].AsInteger, Args[4].AsInteger);
    Exit;
  end;
  if HandlerValue.TypeInfo = TypeInfo(TMouseMoveEvent) then
  begin
    TMouseMoveEvent(MethodRecPtr^)(Args[0].AsObject,
      Args[1].AsType<TShiftState>, Args[2].AsInteger, Args[3].AsInteger);
    Exit;
  end;
  { still here? well, let's go for the generic approach }
  HandlerObj := MethodRecPtr.Data;
  for RttiMethod in RttiContext.GetType(HandlerObj.ClassType).GetMethods do
    if RttiMethod.CodeAddress = MethodRecPtr.Code then
    begin
      Result := RttiMethod.Invoke(HandlerObj, Args);
      Exit;
    end;
  raise EInsufficientRtti.Create(SEventHandlerHasInsufficientRTTI);
end;

function CallEventHandler(Instance: TObject; const EventName: string;
  const Args: array of TValue): TValue; overload;
var
  RttiContext: TRttiContext;
  Prop: TRttiProperty;
begin
  Prop := RttiContext.GetType(Instance.ClassType).GetProperty(EventName);
  if Prop = nil then
    raise EInvocationError.CreateFmt(SMissingEvent, [Instance.ClassName, EventName]);
  Result := CallEventHandler(Instance, Prop, Args);
end;

If you have any other standard event types you wish to handle directly, you can add them after TNotifyEvent is taken care of, following the pattern given — note that for any argument type that doesn’t have a corresponding AsXXX method on TValue, you should use the angle bracket syntax, like I do for TShiftState.

In use, you can then do the following:

  CallEventHandler(MyButton, 'OnClick', [MyButton]);

This calls the OnClick event handler for MyButton, passing MyButton as the Sender parameter.

Now, OnClick, being of the TNotifyEvent type, was called directly by CallEventHandler. To test the generic fallback approach, add the following as the handler to the form’s OnGesture event:

procedure TForm1.FormGesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
  ShowMessageFmt('Distance = %d', [EventInfo.Distance]);
end;

To do the actual testing, handle the OnDblClick event of the form as thus:

procedure TForm1.FormDblClick(Sender: TObject);
var
  EventInfo: TGestureEventInfo;
  Handled: Boolean;
begin
  EventInfo.Distance := 999;
  Handled := False;
  CallEventHandler(Self, 'OnGesture', [Self, TValue.From(EventInfo), Handled]);
end;

Note how because EventInfo is a record, you need to use the TValue.From syntax — a minor incovenience for sure, but no more than that.

Try this out by running the app and double-clicking the form, and you should find that it works. What, though, of the var parameter? For, if you change the Handled parameter in the handler, you’ll find that the Handled variable in the caller is not changed. This makes sense if you recognise that TValue records contain copies of, and not pointers to, their source data. If the ‘var-ness’ of a parameter is important to the caller, though, then you will need to construct an array of TValue records manually:

procedure TForm1.FormDblClick(Sender: TObject);
var
  EventInfo: TGestureEventInfo;
  Handled: Boolean;
  Args: TArray<TValue>;
begin
  EventInfo.Distance := 999;
  Handled := False;
  Args := TArray<TValue>.Create(Self, TValue.From(EventInfo), Handled);
  CallEventHandler(Self, 'OnGesture', Args);
  Handled := Args[2].AsBoolean;
  ShowMessage('After being OnGesture has been called, Handled is now ' +
    BoolToStr(Handled, True));
end;

Or, using a static rather than a dynamic array:

procedure TForm1.FormDblClick(Sender: TObject);
var
  EventInfo: TGestureEventInfo;
  Handled: Boolean;
  Args: array[0..2] of TValue;
begin
  EventInfo.Distance := 999;
  Handled := False;
  Args[0] := Self;
  Args[1] := TValue.From(EventInfo);
  Args[2] := Handled;
  CallEventHandler(Self, 'OnGesture', Args);
  Handled := Args[2].AsBoolean;
  ShowMessage('After being OnGesture has been called, Handled is now ' +
    BoolToStr(Handled, True));
end;

To test, we can alter the OnGesture handler to be as thus:

procedure TfrmMain.FormGesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
  ShowMessageFmt('Distance = %d; on input, Handled is %s',
    [EventInfo.Distance, BoolToStr(Handled, True)]);
  Handled := not Handled;
end;

Try it out, and you should find it all works as expected.

Something new for something old — the code

I’ve finally put up the IDispatch wrapper code I mentioned in my previous post — see here for some information and the CodeCentral link. Compared to the compiled demo I posted earlier, I’ve implemented a few more things, e.g. read-only dynamic array support and the automatic exposure of most enumerators, the latter enabling For Each in VBScript where you would use for/in in Delphi.

Nonetheless,whether it’s practically useful or not I don’t really know — writing it just scratched a very old itch really, having played around with the script control many years ago. Moreover, as a demo of the new RTTI, my code is not exactly the best, since most of it concerns implementing IDispatch rather than using Rtti.pas — though of course, that’s as much a tribute to the latter as it is a criticism of my code qua demo of it.

Having said that, writing the proxy classes did make explicit certain limitations of the new RTTI — basically, while its coverage is very good, it isn’t perfect:

  • Where TRttiMethod.Invoke accepts a TValue, object or class as its first parameter, TRttiProperty.GetValue only accepts a pointer. This probably just refects underlying limitations, but nonetheless, the interface should match Invoke IMO.
  • Indexed properties are not surfaced at all.
  • You can’t tell whether such-and-so property is a default property.
  • Class vars are not surfaced.
  • Method pointers (= events) seem tricky (even impossible) to work with when put into a TValue . (Note they aren’t put in as TMethod records, but anonymous method interfaces, or at least, seem to be. Ignore that — I must have been testing incorrectly. They are in fact stored as TMethod records, as you would expect. See my post here for how to invoke an event handler using RTTI.)
  • Sets aren’t exposed as nicely as arrays are.
  • An interface type requires the explicit addition of $M+ (or be derived from IInvokable) for its methods to be surfaced. Even then however, interface properties are ignored. (I’m guessing this is yet another couple of quirks due to the Delphi interface type’s origins as a COM support feature.)

Overall though, the new RTTI is still a very impressive feature and one I think people should use in confidence.

[Update: Barry Kelly, the author of the new RTTI, explains the limitations just listed in the comments.]

Something new for something old: Delphi 2010’s RTTI and Active Scripting

I’ve been playing around with the new RTTI stuff in the D2010 trial, and I have to say, I’m impressed. But for what it surfaces for method pointers (= event types) and sets, it seems both very complete and very intuitive to use.  Not only have I managed to use it without having reference to either source code or an API reference (though let’s not encourage Embarcadero on the latter, eh?), but it has been generally very solid — do something wrong, and an appropriate exception is cleanly raised with a message that tells you straighaway what the issue is. The one (er) exception to this is TValue not doing quite enough verification when attempting a cast to a Variant, though as the latter is an explicit operation, it’s easy enough to work around if and when it bites.

That said, reading the small amount of documentation, I happened across mention of an Invoke method, which set me thinking — is it finally possible to cleanly (and generically!) wrap Delphi objects into IDispatch ones for use in Active Scripting?  Well, apart from the events issue and the difficulties of surfacing set types in a script-friendly manner, my answer is: for sure! Check out this compiled EXE if you’re interested (screenshot here).

Basically, what I’ve done is to write a TCustomDispProxy class with TObjectDispProxy and TClassDispProxy descendants; in the demo, these are then used to directly surface the Application, Mouse and Screen objects, together with the form instance (object properties and fields are handled automatically) and some metaclasses (TButton, TLabel, etc.).The idea is that no specific object or class type requires a specific wrapper — all just use TObjectDispProxy and TClassDispProxy respectively, with wrappers for sub-objects created on the fly. Now unlike Allen Bauer, I’m not a masochist in these things, and so have used the MS Script Control rather than implemented the Active Scripting interfaces directly; because of this, be warned that if the control isn’t installed (which is unlikely these days, though could be the case), the EXE won’t run.

Anyhow, if anyone’s interested in the actual code, add a comment saying so and I’ll endeavour to do it up for public consumption. Alternatively, if you’re not interested, then don’t leave a comment and I won’t bother…

[Update: I’ve put up the code now, adding enumerator support and a few other bits compared to the original demo — see here.]