Delphi: пункты разрешения методов не применяются при получении / установке свойств через RTTI - PullRequest
Новая
       10

Delphi: пункты разрешения методов не применяются при получении / установке свойств через RTTI

0 голосов
/ 01 июня 2018

Я пытаюсь добавить функциональность в существующий код, используя условие разрешения метода для различных свойств интерфейса.

Хотя это работает нормально, при получении / установке свойств в коде это не удается при попытке установить или получитьсвойства через RTTI.

При использовании RTTI вызывается 1-й метод реализации класса.

Вот код, который показывает проблему: 

program TestIntfMethodResolutions;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Variants,
  System.Classes,
  TypInfo,
  RTTI{,
  uRTTIHelper};


type
   ITestInterface = interface
   ['{61553B5F-574A-4B0F-AB6F-0560E324B463}']
    function GetA:integer;
    procedure SetA(const AVal:integer);
    property A:integer read GetA write SetA;
    end;

   {$RTTI EXPLICIT METHODS([vcPrivate,vcPublic])}
   TTintimpl1 = class(TInterfacedObject,ITestInterface)
    private
    FA:integer;
    function GetA: integer;

    procedure SetA(const Value: integer);virtual; // Does not need to be virtual

    public
      property A:integer read GetA write SetA;

    end;

   {$RTTI EXPLICIT METHODS([vcPrivate,vcPublic])}

   //Explicit RTTI settings causes the Private methods to show up in the method list
   TIntimpl2 = class(TTIntimpl1,ITestInterface)
    private
      procedure MySetA(const Value:integer);virtual;

    public
      procedure ITestInterface.SetA = MySetA;

    end;

  TMain = class

  private
    { Private declarations }
  public
    { Public declarations }
    procedure FormCreate;
    end;

var
  Form5: TMain;

procedure TMain.FormCreate;
var
  ctx:TRttiContext;
  avalue,bvalue:tvalue;
  atype,bastyp:TRttiType;
  aproplist:Tarray<TRttiProperty>;
  amethlist:Tarray<TRttiMethod>;
  isinst:boolean;
  aninst:TRttiInstanceType;
  anintf:TRttiInterfaceType;
  intflist:Tarray<TRttiInterfaceType>;
  inst:pointer;
  anint:ITestInterface;
  aprop:TRttiProperty;
  codeptr:pointer;
  asetmeth:TRTTIMethod;

begin
  ctx:=TRttiContext.Create;

  //Faxisloopthr:=TIntimpl2.Create;

  anint:=TIntimpl2.Create;

  avalue:=anint as TObject;
  atype:=ctx.GetType(avalue.TypeInfo);

  if atype.IsInstance then
    begin
      aninst:=atype.AsInstance;
      aproplist:=aninst.GetProperties;
      amethlist:=aninst.GetMethods;

      bvalue:=TValue.FromOrdinal(aproplist[0].PropertyType.Handle,1);
      inst:=avalue.AsObject;
      aprop:=aproplist[0]; //I could have called aproplist[0].SetValue(...
      aprop.SetValue(inst,bvalue);
      end;

  writeln('RTTI result '+anint.A.ToString); //Should give me 20 but I get 10 everytime


  //asetmeth:=aprop.SetterMethod(inst); // returns SetA and not MySetA - need uRTTIhelper unit. https://github.com/RRUZ/blog/tree/master/RTTI

//      setpropvalue(inst,aprop.PropInfo,bvalue.AsVariant); // calls SetA and not MySetA

  //Manually setting the value calls the correct method

  anint.A:=1;
  writeln('Direct setting '+anint.A.ToString);

  end;


{ T2ndIntf }


{ TTintimpl1 }

function TTintimpl1.GetA: integer;
begin
  Result:=FA;
  end;

procedure TTintimpl1.SetA(const Value: integer);
var
  a:integer;
begin
  FA:=Value*10;
  writeln('In SetA ',FA);
  end;

{ TIntimpl2 }


//Should get called - but the 1st implementing parent gets called
procedure TIntimpl2.MySetA(const Value: integer);

begin
  FA:=Value*20;
  writeln('In MySetA ',FA);
  end;

begin
  Form5:=TMain.Create;
  try
    Form5.FormCreate;
  finally
    Form5.Free;
    readln;
    end;

  end.

Что я делаю не так?

Спасибо,

IB.Delphi 10.2 Tokyo Win64

...