Code:

DisplayProperties(Form1, {Вы можете использовать любой компонент}

Outline1.Lines, {Допускается любой TStrings-объект}

0); {0 - "стартовый", корневой уровень}

DisplayProperties(AObj: TObject; AList: TStrings; iIndentLevel: Integer);

var

Indent: string;

ATypeInfo: PTypeInfo;

ATypeData: PTypeData;

APropTypeData: PTypeData;

APropInfo: PPropInfo;

APropList: PPropList;

iProp: Integer;

iCnt: Integer;

iCntProperties: SmallInt;

ASecondObj: TObject;

procedure AddLine(sLine: string);

begin

AList.Add(Indent + #160 + IntToStr(iProp) + ': ' + APropInfo^.Name

+ ' (' + APropInfo^.PropType^.Name + ')' + sLine);

end;

begin

try

Indent := GetIndentSpace(iIndentLevel);

ATypeInfo := AObj.ClassInfo;

ATypeData := GetTypeData(ATypeInfo);

iCntProperties := ATypeData^.PropCount;

GetMem(APropList, SizeOf(TPropInfo) * iCntProperties);

GetPropInfos(ATypeInfo, APropList);

for iProp := 0to ATypeData^.PropCount - 1do

begin

APropInfo := APropList^[iProp];

case APropInfo^.PropType^.Kind of

tkInteger:

AddLine(' := ' + IntToStr(GetOrdProp(AObj, APropInfo)));

tkChar:

AddLine(' := ' + chr(GetOrdProp(AObj, APropInfo)));

tkEnumeration:

begin

APropTypeData := GetTypeData(APropInfo^.PropType);

if APropTypeData^.BaseType^.Name <> APropInfo^.PropType^.Namethen

AddLine(' := ' + IntToStr(GetOrdProp(AObj, APropInfo)))

else

AddLine(' := ' + APropTypeData^.NameList);

end;

tkFloat:

AddLine(' := ' + FloatToStr(GetFloatProp(AObj, APropInfo)));

tkString:

AddLine(' := "' + GetStrProp(AObj, APropInfo) + '"');

tkSet:

begin

AddLine(' := ' + IntToStr(GetOrdProp(AObj, APropInfo)));

end;

tkClass:

begin

ASecondObj := TObject(GetOrdProp(AObj, APropInfo));

if ASecondObj = nilthen

AddLine(' := NIL')

else

begin

AddLine('');

DisplayProperties(ASecondObj, AList, iIndentLevel + 1);

end;

end;

tkMethod:

begin

AddLine('');

end;

else

AddLine(' := >>НЕИЗВЕСТНО<<');

end;

end;

except{Выводим исключение и продолжаем дальше}

on e: Exception do ShowMessage(e.Message);

end;

FreeMem(APropList, SizeOf(TPropInfo) * iCntProperties);

end;

function GetIndentSpace(iIndentLevel: Integer): string;

var iCnt: Integer;

begin

Result := '';

for iCnt := 0to iIndentLevel - 1do

Result := Result + #9;

end;