Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

When using RTTI how can we get and set deeper level sub-properties?

Overview

I appreciate a couple of similar questions have already been asked before:

  • Get/Set sub properties ussing RTTI
  • Get a sub property of a component in Delphi using RTTI
  • how i can set the value of a nested property using the RTTI
  • How can I set/get property value through RTTI for compex things like TStringGrid.Cells?

However I am no further forward in understanding how exactly the RTTI can be used for my needs.

I have also put a lot of time and effort into writing this question so I hope it does not get closed :)

Working Examples

I have a few procedures below which can output to a TStrings list the property names, values and types of a component. The original source was not mine, I just made some minor changes to it, tidied up the code and put them into some neat reusable procedures:


The below will output the property names, such as:

  • Color
  • DoubleBuffered
  • Enabled
  • Height
  • Width
procedure GetComponentPropertyNames(Component: TComponent; OutList: TStrings);
var
  I: Integer;
  Count, Size: Integer;
  PropList: PPropList;
  PropInfo: PPropInfo;
begin
  OutList.BeginUpdate;
  try
    OutList.Clear;

    Count := GetPropList(Component.ClassInfo, tkAny, nil);
    Size  := Count * SizeOf(Pointer);
    GetMem(PropList, Size);
    try
      Count := GetPropList(Component.ClassInfo, tkAny, PropList);
      for I := 0 to Count -1 do
      begin
        PropInfo := PropList^[I];
        if not (PropInfo^.PropType^.Kind = tkMethod) then
        begin
          OutList.Add(PropInfo^.Name);
        end;
      end;
    finally
      FreeMem(PropList);
    end;
  finally
    OutList.EndUpdate;
  end;
end;

The below will output the property values, such as:

  • clWindow
  • False
  • True
  • 25
  • 75
function GetComponentPropertyValue(Component: TComponent; APropName: string): string;
var
  I: Integer;
  Count, Size: Integer;
  PropList: PPropList;
  PropInfo: PPropInfo;
begin
  Count := GetPropList(Component.ClassInfo, tkAny, nil);
  Size  := Count * SizeOf(Pointer);
  GetMem(PropList, Size);
  try
    Count := GetPropList(Component.ClassInfo, tkAny, PropList);
    for I := 0 to Count -1 do
    begin
      PropInfo := PropList^[I];
      if not (PropInfo^.PropType^.Kind = tkMethod) then
      begin
        if SameText(PropInfo^.Name, APropName) then
        begin
          Result := System.Variants.VarToStr(GetPropValue(Component, PropInfo^.Name));
          Exit;
        end;
      end;
    end;
  finally
    FreeMem(PropList);
  end;
end;

procedure GetComponentPropertyValues(Component: TComponent; OutList: TStrings);
var
  SL: TStringList;
  I: Integer;
begin
  SL := TStringList.Create;
  try
    GetComponentPropertyNames(Component, SL);
    for I := 0 to SL.Count -1 do
    begin
      OutList.Add(GetComponentPropertyValue(Component, SL.Strings[I]));
    end;
  finally
    SL.Free;
  end;
end;

And finally, The below will output the property types in string format, such as:

  • TColor
  • Boolean
  • Boolean
  • Integer
  • Integer
function GetComponentPropertyType(Component: TComponent; APropName: string): string;
var
  SL: TStringList;
  I: Integer;
  PropInfo: TPropInfo;
  PropTypeName: string;
begin
  SL := TStringList.Create;
  try
    GetComponentPropertyNames(Component, SL);
    for I := 0 to SL.Count -1 do
    begin
      PropInfo := GetPropInfo(Component, SL.Strings[I])^;
      if SameText(PropInfo.Name, APropName) then
      begin
        PropTypeName := PropInfo.PropType^.Name;
        Result := PropTypeName;
        Exit;
      end;
    end;
  finally
    SL.Free;
  end;
end;

procedure GetComponentPropertyTypes(Component: TComponent; OutList: TStrings);
var
  SL: TStringList;
  I: Integer;
begin
  SL := TStringList.Create;
  try
    GetComponentPropertyNames(Component, SL);
    for I := 0 to SL.Count -1 do
    begin
      OutList.Add(GetComponentPropertyType(Component, SL.Strings[I]));
    end;
  finally
    SL.Free;
  end;
end;

Side by side the output for each procedure called above would show something like this:

  • Color | clWindow | TColor
  • DoubleBuffered | False | Boolean
  • Enabled | True | Boolean
  • Height | 25 | Integer
  • Width | 75 | Integer

Question

All of the above at this point works, there is no issue other than I need to take some time reading the documentation a little more to try and get a bit of a better understanding and be able to digest it all.

My question (which has been bugging me for a few days now) is how to correctly get and set the sub properties. For example, take a look at this screenshot (modified for purpose) of the Delphi Object Inspector:

enter image description here

Just like the procedures shown before, I need the same thing to happen for those sub properties I highlighted in blue.

Ideally what I would like is a function where I can pass a component and a property name, and return True if it has sub properties, so something like:

function HasSubProperty(Component: TComponent; APropName: string): Boolean;
begin
  Result := ??
end;

I am not sure how well this would work though as evident from the screenshot, some sub properties also have sub properties (such as Component>Font>Style).

Ultimately what I would like is a way of retrieving the names, values and types of sub properties. So something like:

procedure GetComponentSubPropertyNames(Component: TComponent; APropName: string;
  OutList: TStrings);
begin
  //
end;

When called:

GetComponentSubPropertyNames(Label1, Anchors);

Should retrieve:

  • akLeft
  • akTop
  • akRight
  • akBottom

With similar procedures to get the values and types would look like:

  • akLeft | True | Boolean
  • akTop | True | Boolean
  • akRight | True | Boolean
  • akBottom | True | Boolean

For the Font sub properties, for example:

  • Charset | DEFAULT_CHARSET | TFontCharset
  • Color | clWindowText | TColor
  • Height | -11 | Integer
  • Orientation | 0 | Integer
  • Pitch | fpDefault | TFontPitch
  • Quality | fqDefault | TFontQuality
  • Size | 8 | Integer

Accessing another sub property (Font.Style) then poses yet another problem, unless a procedure like so is used:

procedure GetComponentSubPropertySubPropertyNames(Component: TComponent; APropName, ASubPropName: string; OutList: TStrings);
begin
  //
end;

This then becomes rather silly.


Summary

Basically I need a way of digging into deeper level properties to get the names, values and types of them, put them in a list, and also be able to change the values.

I would appreciate it if someone could write some code samples of how I can achieve this (bonus with some comments in the code). I am sure for some this will be a relatively easy task but I am finding it very trivial indeed.

Having read various documentation and examples so far still leaves me rather clueless to be honest, the main concern is not knowing what types to use or how to correctly create and manage them.

like image 212
Craig Avatar asked Jul 08 '15 15:07

Craig


1 Answers

Sub properties like TFont,TAction,TPopupMenu is Already A Components(Classes) created in owner component like TButton.

To know property type use PropInfo.PropType^.Kind

See Delphi help

TypInfo.PTypeInfo Type

TypInfo.TTypeKind

Here is a sample of code you request:

function HasSubProperty(Component: TComponent; APropName: string): Boolean;
var PropInfo: TPropInfo;
begin
  PropInfo := GetPropInfo(Component, APropName)^;
  Result := PropInfo.PropType^.Kind in [tkClass,tkSet,tkRecord]
end;

Example to get sub class

function GetSubPropClass(Component: TComponent; APropName: string):TComponent;
    var PropInfo: PPropInfo;
        AObject : TObject;
    begin
      Result := nil;
      PropInfo := GetPropInfo(Component, APropName);
      if PropInfo.PropType^.Kind in [tkClass] then
      begin
        AObject := GetObjectProp(Component,PropInfo);
        if Assigned(AObject) then
          Result := TComponent(AObject);
      end;
    end;

Example To Use it

procedure TForm1.Button1Click(Sender: TObject);
var AComp : TComponent;
begin
  AComp := GetSubPropClass(Form1,'TFont',ListBox4.Items);
  if AComp <> nil then
    GetComponentPropertyNames(AComp);
end;

UPDATE

This code will help you to understand SET properties

function GetComponentPropertyValue(Component: TComponent; APropName: string): string;
var
  I,X: Integer;
  Count, Size: Integer;
  PropList: PPropList;
  PropInfo: PPropInfo;
  PropTypeInf : PTypeInfo;
  SetList : TStrings;
  SetName,SetVal : string;
begin
  Count := GetPropList(Component.ClassInfo, tkAny, nil);
  Size  := Count * SizeOf(Pointer);
  GetMem(PropList, Size);
  try
    Count := GetPropList(Component.ClassInfo, tkAny, PropList);
    for I := 0 to Count -1 do
    begin
     PropTypeInf := PropList^[I]^.PropType^;
     PropInfo := PropList^[I];
      if not (PropInfo^.PropType^.Kind = tkMethod) then
      begin
        if SameText(PropInfo^.Name, APropName) then
        begin

          if (PropInfo^.PropType^.Kind = tkSet) then
          begin
            try
              SetList := TStringList.Create;
              SetList.CommaText := System.Variants.VarToStr(GetPropValue(Component, PropInfo^.Name));
              for X := 0 to 255 do
              begin
                SetName := GetSetElementName(GetTypeData(PropTypeInf)^.CompType^,X);
                if ContainsStr(SetName,'UITypes') then break;
                SetVal := SetName + ' = ' + IfThen(SetList.IndexOf(SetName)<>-1,'True','False');
                if Result = '' then
                  Result := SetVal else
                  Result := Result + ', ' + SetVal;
              end;

            finally
              SetList.Free;
            end;
          end else
            Result := System.Variants.VarToStr(GetPropValue(Component, PropInfo^.Name));
          Exit;
        end;
      end;
    end;
  finally
    FreeMem(PropList);
  end;
end;
like image 101
Shadi Ajam Avatar answered Oct 01 '22 03:10

Shadi Ajam