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 := 0 to
ATypeData^.PropCount-1 do 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^.Name then
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 = NIL then
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 := 0 to
iIndentLevel-1 do
Result := Result + #9;
end;