|
|
|
|
Delphi 1
Показ свойств во время выполнения программы
Я написал компонент-отладчик, выводящий в дереве все компоненты. Попробуйте этот код. Вызывайте функцию 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;
|
- Thomas von Stetten [000753]
|
|
|
|
|