|
Показ свойств во время выполнения программы
|
Автор: Thomas von Stetten
|
|
Новость: фирма MICROSOFT, для увеличения надёжности работы своего сервера, установила на него операционную систему UNIX.
|
Я написал компонент-отладчик, выводящий в дереве все компоненты. Попробуйте этот
код. Вызывайте функцию DisplayProperties как показано ниже:
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 := 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;
|
|
