TRttiProperty.SetValue経由でオブジェクトのプロシージャを割り当てたときにEInvalidCast例外が発生しました

Question

TRttiProperty.SetValueプロシージャを使用して、procedure of objectタイプのプロパティをrttiに割り当てようとしましたが、この例外は作成したときに発生します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に暗黙的に変換しており、そこからすべてが乱れてしまいます。それはあなたが望むものではありません。

必要なものは、タイプと値がバーに一致する実際のTV値です。試してみてください：

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.