CODEWITHSUNDEEP
delphigenericsinterfacertti
Rick Wheeler
Rick Wheeler

Reputation: 1132

RTTI for generic type with interface type constraint

Is it possible to inspect the RTTI information for an instance of a generic type with an interface type constraint? The question is probably a little ambiguous so I've created a sample console app to show what I'm trying to do:

program Project3;

{$APPTYPE CONSOLE}

uses
  RTTI,
  SysUtils,
  TypInfo;

type
  TMyAttribute = class(TCustomAttribute)
  strict private
    FName: string;
  public
    constructor Create(AName: string);
    property Name: string read FName;
  end;

  IMyObjectBase = interface
  ['{E063AD44-B7F1-443C-B9FE-AEB7395B39DE}']
    procedure DoSomething;
  end;

  TMyObjectBase = class(TInterfacedObject, IMyObjectBase)
  public
    procedure DoSomething; virtual;
  end;

  [TMyAttribute('First')]
  TMyFirstRealClass = class(TMyObjectBase)
  public
    procedure DoSomethingDifferent;
  end;

  [TMyAttribute('Second')]
  TMySecondRealClass = class(TMyObjectBase)
  public
    procedure BeSomethingDifferent;
  end;

  TGenericClass<I: IMyObjectBase> = class
  public
    function GetAttributeName(AObject: I): string;
  end;


{ TMyAttribute }

constructor TMyAttribute.Create(AName: string);
begin
  FName := AName;
end;

{ TMyObjectBase }

procedure TMyObjectBase.DoSomething;
begin
end;

{ TMyFirstRealClass }

procedure TMyFirstRealClass.DoSomethingDifferent;
begin
end;

{ TMySecondRealClass }

procedure TMySecondRealClass.BeSomethingDifferent;
begin
end;

{ TGenericClass<I> }

function TGenericClass<I>.GetAttributeName(AObject: I): string;
var
  LContext: TRttiContext;
  LProp: TRttiProperty;
  LAttr: TCustomAttribute;
begin
  Result := '';
  LContext := TRttiContext.Create;
  try
    for LAttr in LContext.GetType(AObject).GetAttributes do
    // ----> [DCC Error] E2250 There is no overloaded version of 'GetType' that can be called with these arguments
      if LAttr is TMyAttribute then
      begin
        Result := TMyAttribute(LAttr).Name;
        Break;
      end;
  finally
    LContext.Free;
  end;
end;

var
  LFirstObject: IMyObjectBase;
  LSecondObject: IMyObjectBase;
  LGeneric: TGenericClass<IMyObjectBase>;
begin
  try
    LFirstObject := TMyFirstRealClass.Create;
    LSecondObject := TMySecondRealClass.Create;

    LGeneric := TGenericClass<IMyObjectBase>.Create;

    Writeln(LGeneric.GetAttributeName(LFirstObject));
    Writeln(LGeneric.GetAttributeName(LSecondObject));

    LGeneric.Free;

    LFirstObject := nil;
    LSecondObject := nil;

    Readln;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

I need to inspect the object being passed in (AObject), not the generic interface (I). (Dephi 2010). Thanks for any advice.

Upvotes: 5

Views: 1262

Answers (1)

Graymatter
Graymatter

Reputation: 6587

Two possible solutions for this is as follows:

1) I tested with this and it works (XE4):

for LAttr in LContext.GetType((AObject as TObject).ClassType).GetAttributes do

2) I tested with this and it works (XE4):

for LAttr in LContext.GetType(TMyObjectBase(AObject).ClassType).GetAttributes do

3) Create method on the interface that returns the object and use that to inspect the object:

IMyObjectBase = interface
['{E063AD44-B7F1-443C-B9FE-AEB7395B39DE}']
  procedure DoSomething;
  function GetObject: TObject;
end;

TMyObjectBase = class(TInterfacedObject, IMyObjectBase)
public
  procedure DoSomething; virtual;
  function GetObject: TObject;
end;

{ TMyObjectBase }

function TMyObjectBase.GetObject: TObject;
begin
  Result := Self;
end;

And then call it like this:

for LAttr in LContext.GetType(AObject.GetObject.ClassType).GetAttributes do

Upvotes: 4

Related Questions