RTTI и другие трюки с информацией о классах, модулях и т.п.

Code:

uses

TypInfo

procedure ListProperties(AInstance: TPersistent; AList: TStrings);

var

i: integer;

pInfo: PTypeInfo;

pType: PTypeData;

propList: PPropList;

propCnt: integer;

tmpStr: string;

begin

pInfo := AInstance.ClassInfo;

if (pInfo = nil) or (pInfo^.Kind <> tkClass) then

   raise Exception.Create('Invalid type information');

pType := GetTypeData(pInfo);  {Pointer to TTypeData}

AList.Add('Class name: ' + pInfo^.Name);

{If any properties, add them to the list}

propCnt := pType^.PropCount;

if propCnt > 0then

begin

   AList.Add(EmptyStr);

   tmpStr := IntToStr(propCnt) + ' Propert';

   if propCnt > 1then

     tmpStr := tmpStr + 'ies'

   else

     tmpStr := tmpStr + 'y';

   AList.Add(tmpStr);

   FillChar(tmpStr[1], Length(tmpStr), '-');

   AList.Add(tmpStr);

   {Get memory for the property list}

   GetMem(propList, sizeOf(PPropInfo) * propCnt);

   try

     {Fill in the property list}

     GetPropInfos(pInfo, propList);

     {Fill in info for each property}

     for i := 0to propCnt - 1do

       AList.Add(propList[i].Name+': '+propList[i].PropType^.Name);

   finally

     FreeMem(propList, sizeOf(PPropInfo) * propCnt);

   end;

end;

end;

function GetPropertyList(AControl: TPersistent; AProperty: string): PPropInfo;

var

i: integer;

props: PPropList;

typeData: PTypeData;

begin

Result := nil;

if (AControl = nil) or (AControl.ClassInfo = nil) then

   Exit;

typeData := GetTypeData(AControl.ClassInfo);

if (typeData = nil) or (typeData^.PropCount = 0) then

   Exit;

GetMem(props, typeData^.PropCount * SizeOf(Pointer));

try

   GetPropInfos(AControl.ClassInfo, props);

   for i := 0to typeData^.PropCount - 1do

   begin

     with Props^[i]^ do

       if (Name = AProperty) then

         result := Props^[i];

   end;

finally

   FreeMem(props);

end;

end;

Code:

ListProperties(TProject(treeview1.items[0].data), memo3.lines);

Code:

type

  TProject = class(tComponent)

  private

    FNaam: string;

    procedure SetNaam(const Value: string);

  public

    constructor Create(AOwner: tComponent);

    destructor Destroy;

  published

    property Naam: stringread FNaam write SetNaam;

  end;