• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 329
  • Last Modified:

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
0
kevinjd
Asked:
kevinjd
  • 5
  • 3
1 Solution
 
Russell LibbySoftware Engineer, Advisory Commented:
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
0
 
kevinjdAuthor Commented:
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;

0
 
kevinjdAuthor Commented:
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
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Russell LibbySoftware Engineer, Advisory Commented:
Looking at it...

Russell
0
 
Russell LibbySoftware Engineer, Advisory Commented:
Not sure why you did some of the things you did, but you should find this yields better results.

1.) No need to cast Obj as TComponent (it only needs TObject)
2.) Why are you calling GetOrdProp on EVERY type? Some are strings, classes, arrays, etc...

The child class handling just recurses into the function again, passing ITS name (plus ".") as the new ident name. I did not fix every type kind from the GetOrdProp call, but I gave you a start.

Let me know if you have problems/questions

Russell




procedure GetPropertyNameList(Obj: TObject; IdentName: String; NameList: TStrings);
var  dwIndex:       Integer;
     dwCount:       Integer;
     PropList:      PPropList;
     PropInfo:      PPropInfo;
     TypeKinds:     TTypeKinds;
     TypeInfo:      PTypeInfo;
     TypeData:      PTypeData;
     objProp:       TObject;
begin

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

  // 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 + '=' + IntToStr(GetOrdProp(Obj, PropList[dwIndex])));
              tkUnknown      :  sleep(0);
              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 + '=' + IntToStr(GetOrdProp(Obj, PropList[dwIndex])));
              tkString       :  NameList.Add(IdentName + PropList[dwIndex].Name + '=' + GetStrProp(Obj, PropList[dwIndex]));
              tkSet          :  NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(GetOrdProp((Obj as TComponent), PropList[dwIndex])));
              tkClass        :
              begin
                 // Get child object
                 objProp:=GetObjectProp(Obj, PropList[dwIndex]);
                 // Recurse into child
                 GetPropertyNameList(objProp, PropList[dwIndex].Name + '.', NameList);
              end;
              tkMethod       :  NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(GetOrdProp(Obj, PropList[dwIndex])));
              tkWChar        :  NameList.Add(IdentName + PropList[dwIndex].Name + '=' + IntToStr(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 + '=' + IntToStr(GetOrdProp(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
     FreeMem(PropList);
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin

  GetPropertyNameList(Memo1, EmptyStr, Memo1.Lines);

end;
0
 
kevinjdAuthor Commented:
Beautiful.  Thanks.
0
 
Russell LibbySoftware Engineer, Advisory Commented:
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;

0
 
Russell LibbySoftware Engineer, Advisory Commented:
The {*} indicates those types not correctly handled.

0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now