当通过TRttiProperty.SetValue分配对象的过程时引发EInvalidCast异常

Question

我试图通过rtti使用TRttiProperty.SetValue过程分配类型为procedure of object的属性，但是当我尝试进行分配时引发此异常EInvalidCast: Invalid class typecast

这个示例应用程序说明问题

{$APPTYPE CONSOLE} 

uses 
Rtti, 
SysUtils; 

type 
    TMyCallBack = procedure (const Foo : string) of object; 
    TMyClass = class 
    procedure DoSomething(const Foo: String); 
    end; 

    TMyAnotherClass = class 
    private 
    FDoSomething: TMyCallBack; 
    published 
    property DoSomething : TMyCallBack read FDoSomething Write FDoSomething; 
    end; 

{ TMyClass } 

procedure TMyClass.DoSomething(const Foo: String); 
begin 
    Writeln('Hello'); 
end; 

Var 
    MyClass : TMyClass; 
    t  : TRttiInstanceType; 
    v  : TValue; 
    p  : TRttiProperty; 
    Bar  : TMyCallBack; 
begin 
    try 
    MyClass:=TMyClass.Create; 
    try 
     t:=TRttiContext.Create.GetType(TMyAnotherClass).AsInstance; 
     v:=t.GetMethod('Create').Invoke(t.MetaclassType,[]); 
     p:=t.GetProperty('DoSomething'); 
     Bar:=MyClass.DoSomething; 
     if p<>nil then 
     p.SetValue(v.AsObject, @Bar); //here the exception is raised 
    finally 
    MyClass.Free; 
    end; 
    except 
    on E: Exception do 
     Writeln(E.ClassName, ': ', E.Message); 
    end; 
    Readln; 
end. 

我怎样才能解决这个问题？

Answer 1

当我追溯到错误行时，我结束了隐式TClass-> TValue转换例程。它看起来像@Bar是一个指针，编译器隐式地将其转换为TClass，并从那里一切都搞砸了。这不是你想要的。

你需要的是一个实际的TValue，其类型和值匹配Bar。试试这个：

Var 
    MyClass : TMyClass; 
    t  : TRttiInstanceType; 
    v  : TValue; 
    p  : TRttiProperty; 
    Bar  : TMyCallBack; 
    vBar : TValue; 
begin 
    try 
    MyClass:=TMyClass.Create; 
    try 
     t:=TRttiContext.Create.GetType(TMyAnotherClass).AsInstance; 
     v:=t.GetMethod('Create').Invoke(t.MetaclassType,[]); 
     p:=t.GetProperty('DoSomething'); 
     Bar:=MyClass.DoSomething; 
     vBar := TValue.From<TMyCallback>(bar); 
     if p<>nil then 
     p.SetValue(v.AsObject, vBar); //here the exception is raised 
    finally 
    MyClass.Free; 
    end; 
    except 
    on E: Exception do 
     Writeln(E.ClassName, ': ', E.Message); 
    end; 
    Readln; 
end.