EInvalidCast изключение се повдига при присвояване на процедура на обект чрез TRttiProperty.SetValue

Опитвам се да присвоя свойство, което е от тип procedure of object чрез rtti, използвайки процедурата TRttiProperty.SetValue, но това изключение се повдига, когато се опитам да направя присвояването 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.

Как мога да поправя този проблем?


delphi delphi-xe2 rtti
person Salvador    schedule 14.04.2012    source източник

Отговори (1)


arrow_upward
5
arrow_downward

Когато проследих реда за грешка, се озовах на имплицитната рутина за преобразуване на TClass->TValue. Изглежда, че @Bar е указател и компилаторът имплицитно го преобразува в TClass и от там всичко се обърква. Не това искаш.

Това, от което се нуждаете, е действителна TVvalue, чийто тип и стойност съответстват на 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.
person Mason Wheeler    schedule 14.04.2012
comment
@Salvador: Няма за какво. И може да искате да докладвате това като грешка на QC: указател към препратка към метод не трябва да отговаря на условията за имплицитно преобразуване в TClass от компилатора! - person Mason Wheeler; 14.04.2012