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;
|