asked on

Getting run time properties of a tkClass

I have a script that will cycle through all the properties of an object (memo, for example). However, I would like it to go a step deeper once it reaches the tkclass type.

The script below is part of the overall script which cycles through and lists all the top level properties, but when it gets to tkclass, i want it to go deeper, and get all the sub properties...

if PropList[i].PropType^.Kind = tkClass then
Begin
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

Any help is appreciated!

Thanks
Kevin

Russell Libby

Can't test this without the full code, but you are going to need to change the GetOrdProp to GetObjectProp, eg:

if (PropList[i].PropType^.Kind = tkClass) then
GetPropertyNameList(GetObjectProp(AObject, PropList[i]), NameList);

Regards,
Russell

kevinjd

ASKER

Here's what i have so far. The code below

// BUTTON CLICK CODE
procedure TForm1.btCreateComponentPropertiesClick(Sender: TObject);
var
ComponentProperties : TComponentProperties;
begin
ComponentProperties := TComponentProperties.Create(nil);
try

ComponentProperties.GetPropertyValueList(Memo1, Memo1.Lines);

finally
ComponentProperties.Free;
end;

end;

//CODE TO GO THROUGH ALL PROPERTIES OF TMEMO
procedure TComponentProperties.GetPropertyNameList(AObject: TObject;
NameList: TStrings);
var
i, PropCount : integer;
PropList : PPropList;
PropInfo : PPropInfo;
TypeKinds : TTypeKinds;
NewNameList : TStrings;
TypeInfo: PTypeInfo;
TypeData: PTypeData;

begin
TypeKinds := [tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkClass, tkWChar,
tkLString, tkWString, tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray];

PropCount := GetPropList(AObject, PropList);
GetMem(PropList, PropCount * SizeOf(PPropInfo));
try
GetPropList(AObject.ClassInfo, TypeKinds, PropList);

for I := 0 to PropCount - 1 do
begin
Try
if PropList[i].PropType^.Kind = tkEnumeration then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkUnknown then
begin
sleep(0);
end;

if PropList[i].PropType^.Kind = tkInteger then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkChar then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkFloat then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkString then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkSet then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

// WHEN IT GETS TO A TYPE CLASS, IT SHOULD GO DEEPER INTO THE CLASS OBJECT AND GET ALL THE SUB PROPERTIES...

if PropList[i].PropType^.Kind = tkClass then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkMethod then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkWChar then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkLString then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkWString then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkVariant then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkArray then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkRecord then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkInterface then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkInt64 then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkDynArray then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

if PropList[i].PropType^.Kind = tkMethod then
NameList.Add(FIndentString + PropList[i].Name + '=' + IntToStr(GetOrdProp((AObject as TComponent), PropList[i])));

end;

FreeMem(PropList);
Except;
end;

end;

kevinjd

ASKER

Here is the results of the code.... It populates the memo with the following properties of the Tmemo.

The "Contraints" property is a "tkclass" type and has sub properties. Those are the ones i'm attempting to access.

TMemo
Align=0
Alignment=0
Anchors=3
BevelEdges=15
BevelInner=2
BevelKind=0
BevelOuter=1
BiDiMode=0
BorderStyle=1
Color=-2147483643
Constraints=9518160
Ctl3D=1
Cursor=0
DragCursor=-12
DragKind=0
DragMode=0
Enabled=1
Font=9518120
Height=521
HelpContext=0
HelpKeyword=0
HelpType=1
HideSelection=1
Hint=0
ImeMode=3
ImeName=0
Left=384
Lines=9518296
MaxLength=0
Name=9517544
OEMConvert=0
ParentBiDiMode=1
ParentColor=0
ParentCtl3D=1
ParentFont=1
ParentShowHint=1
PopupMenu=0
ReadOnly=0
ScrollBars=3
ShowHint=0
TabOrder=1
TabStop=1
Tag=0
Top=16
Visible=1
WantReturns=1
WantTabs=0
Width=449
WordWrap=1

Russell Libby

Looking at it...

Russell

ASKER CERTIFIED SOLUTION

Russell Libby

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

kevinjd

ASKER

Beautiful. Thanks.

Russell Libby

No problem Kevin, and thank you. Here is the code taken one step further. Handles all but records/arrays (which is TOUGH) to do. Handles sets and enums very nicely though:

Russell

procedure GetPropertyNameList(Obj: TObject; IdentName: String; NameList: TStrings);
var TypeKinds: TTypeKinds;
PropList: PPropList;
dwIndex: Integer;
dwCount: Integer;
begin

// Type kinds we wish to handle
TypeKinds:=[tkInteger,
tkChar,
tkEnumeration,
tkFloat,
tkString,
tkSet,
tkClass,
tkWChar,
tkLString,
tkWString,
tkVariant,
tkArray,
tkRecord,
tkInterface,
tkInt64,
tkDynArray];

// Check the object and passed list first
if Assigned(Obj) and Assigned(NameList) then
begin
// Lock list update
NameList.BeginUpdate;
try
// Clear the list if first level call (indent name is blank)
if (Length(IdentName) = 0) then NameList.Clear;
// Get proplist count
dwCount:=GetTypeData(Obj.ClassInfo)^.PropCount;
// Allocate memory for proplist
GetMem(PropList, dwCount * SizeOf(PPropInfo));
// Resource protection
try
// Get property list
GetPropList(Obj.ClassInfo, TypeKinds, PropList);
// Walk the properties
for dwIndex:= 0 to Pred(dwCount) do
begin
// Exception trap
try
// Case kind handler
case PropList[dwIndex].PropType^.Kind of
tkEnumeration : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + GetEnumProp(Obj, PropList[dwIndex]));
tkInteger : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(GetOrdProp(Obj, PropList[dwIndex])));
tkChar : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + Char(GetOrdProp(Obj, PropList[dwIndex])));
tkFloat : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + FloatToStr(GetFloatProp(Obj, PropList[dwIndex])));
tkString : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + GetStrProp(Obj, PropList[dwIndex]));
tkSet : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + GetSetProp(Obj, PropList[dwIndex]));
tkClass : GetPropertyNameList(GetObjectProp(Obj, PropList[dwIndex]), PropList[dwIndex].Name + '.', NameList);
tkMethod : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(GetOrdProp(Obj, PropList[dwIndex])));
tkWChar : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + WideChar(GetOrdProp(Obj, PropList[dwIndex])));
tkLString : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + GetStrProp(Obj, PropList[dwIndex]));
tkWString : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(GetOrdProp(Obj, PropList[dwIndex])));
tkVariant : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + VarToStr(GetVariantProp(Obj, PropList[dwIndex])));
{*} tkArray : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(GetOrdProp(Obj, PropList[dwIndex])));
{*} tkRecord : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(GetOrdProp(Obj, PropList[dwIndex])));
{*} tkInterface : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(GetOrdProp(Obj, PropList[dwIndex])));
tkInt64 : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(GetInt64Prop(Obj, PropList[dwIndex])));
{*} tkDynArray : NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(GetOrdProp(Obj, PropList[dwIndex])));
end;
except
// Eat the exception
end;
end;
finally
// Free allocated memory
FreeMem(PropList);
end;
finally
// Unlock the list
NameList.EndUpdate;
end;
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin

// Display form props... pretty cool stuff
GetPropertyNameList(Self, EmptyStr, Memo1.Lines);

end;

Russell Libby

The {*} indicates those types not correctly handled.