{ Interface to access TObject (mostly TComponent) decendant object
  RTTI values using property names/indexes }
unit RTTIUnit;{v0.61}{used also by FormUtl.pas}
interface
uses
  SysUtils, Classes, TypInfo, PropUtl;

type

  TRTIObj = class;

  { Class to keep track about object's RTTI properties. Instances of
    this class are owned by TRTIObj }
  TRTIProp = class(TComponent)
  private
    FPropInfo: PPropInfo;
    procedure SetPropInfo(APropInfo: PPropInfo);
    function GetValue: string;
    procedure SetValue(AValue: string);
    function GetRTIObj: TRTIObj;
  public
    procedure FillEnumNames(Items: TStrings);
    property RTIObj: TRTIObj read GetRTIObj;
    property PropInfo: PPropInfo read FPropInfo write SetPropInfo;
    property Value: string read GetValue write SetValue;
  end;

  { Class that allows access to Obj published properties by their
    name/index }
  TRTIObj = class(TComponent)
  private
    FObj: TObject;
    procedure SetObj(AObj: TObject);
    function GetPropCount: integer;
    function GetProp(Index:integer): TRTIProp;
    function GetPropByName(const AName: string): TRTIProp;
  public
    function HasProp(const AName: string; var ARTIProp: TRTIProp): boolean;
    property Obj: TObject read FObj write SetObj;
    property PropCount: integer read GetPropCount;
    property Props[Index: integer]: TRTIProp read GetProp;
    property PropByName[const AName: string]: TRTIProp read GetPropByName;
  end;

implementation

{TRTIProp.}
function TRTIProp.GetRTIObj: TRTIObj;
begin
  Result := TRTIObj(Owner);
end;

procedure TRTIProp.SetPropInfo(APropInfo: PPropInfo);
begin
  if FPropInfo = APropInfo then
    exit;
  Name := APropInfo^.Name;
  FPropInfo := APropInfo;
end;

function TRTIProp.GetValue: string;
begin
  Result := ClassGetPropStr(TRTIObj(Owner).Obj, PropInfo);
end;

procedure TRTIProp.SetValue(AValue: string);
begin
  ClassSetPropStr(TRTIObj(Owner).Obj, PropInfo, AValue);
end;

procedure TRTIProp.FillEnumNames(Items: TStrings);
begin
  PropUtl.FillEnumNames(RTIObj.Obj, Name, Items);
end;

{/TRTIProp.}

{TRTIObj.}
procedure TRTIObj.SetObj(AObj: TObject);
var
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  pi: PPropInfo;
  i: integer;
  rtip: TRTIProp;
begin
  if FObj = AObj then
    exit;
  ti := PTypeInfo(AObj.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  for i := 0 to td^.PropCount - 1 do begin
    pi := pl[i];
    rtip := TRTIProp.Create(Self);
    rtip.PropInfo := pi;
  end;
  FObj := AObj;
end;

function TRTIObj.GetPropCount: integer;
begin
  Result := ComponentCount;
end;

function TRTIObj.GetProp(Index:integer): TRTIProp;
begin
  Result := TRTIProp(Components[Index]);
end;

function TRTIObj.GetPropByName(const AName: string): TRTIProp;
begin
  Result := TRTIProp(FindComponent(AName));
end;

function TRTIObj.HasProp(const AName: string; var ARTIProp: TRTIProp): boolean;
begin
  ARTIProp := TRTIProp(FindComponent(AName));
  Result := ARTIProp <> nil;
end;

{/TRTIObj.}

end.
