使用RTTI时,我们如何获取和设置更深层次的子属性?

时间:2015-07-08 15:33:46

标签: delphi rtti delphi-xe7

概述

我很感激之前已经提出过几个类似的问题:

然而,我并没有进一步了解如何将RTTI用于我的需求。

我也花了很多时间和精力来写这个问题所以我希望它不会被关闭:)。

工作实例

我有几个程序可以输出到TStrings列表中的组件的属性名称,值和类型。原始来源不是我的,我只是做了一些小改动,整理了代码并将它们放入一些整洁的可重用程序中:

以下将输出属性名称,例如:

  
      
  • 颜色
  •   
  • DoubleBuffered
  •   
  • 启用
  •   
  • 高度
  •   
  • 宽度
  •   
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;

以下将输出属性值,例如:

  
      
  • clWindow
  •   
  •   
  •   
  • 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;

最后,下面将以字符串格式输出属性类型,例如:

  
      
  • TColor
  •   
  • 布尔
  •   
  • 布尔
  •   
  • 整数
  •   
  • 整数
  •   
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;

上面提到的每个过程的输出并排显示如下:

  
      
  • 颜色| clWindow | TColor
  •   
  • DoubleBuffered |错|布尔
  •   
  • 已启用|真的布尔
  •   
  • 高度| 25 |整数
  •   
  • 宽度| 75 |整数
  •   

问题

此时所有上述情况都有效,除了我需要花一些时间阅读文档以尝试获得更好的理解并能够消化它之外,没有其他问题。

我的问题(现在一直困扰我几天)是如何正确获取和设置子属性。例如,看一下Delphi Object Inspector的截图(为了目的而修改):

enter image description here

就像之前显示的程序一样,我需要为以蓝色突出显示的子属性发生同样的事情。

理想情况下,我想要的是一个函数,我可以传递一个组件和一个属性名称,如果它有子属性,则返回True,如下所示:

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

我不确定这会有多好,但从截图中可以看出,一些子属性也有子属性(例如Component> Font> Style)。

最终我想要的是一种检索子属性的名称,值和类型的方法。如下所示:

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

致电时:

GetComponentSubPropertyNames(Label1, Anchors);

应检索:

  
      
  • akLeft
  •   
  • akTop
  •   
  • akRight
  •   
  • akBottom
  •   

使用类似的过程来获取值和类型将如下所示:

  
      
  • akLeft |真的布尔
  •   
  • akTop |真的布尔
  •   
  • akRight |真的布尔
  •   
  • akBottom |真的布尔
  •   

对于Font子属性,例如:

  
      
  • Charset | DEFAULT_CHARSET | TFontCharset
  •   
  • 颜色| clWindowText | TColor
  •   
  • 高度| -11 |整数
  •   
  • 方向| 0 |整数
  •   
  • 音高| fpDefault | TFontPitch
  •   
  • 质量| fqDefault | TFontQuality
  •   
  • 尺寸| 8 |整数
  •   

访问另一个子属性(Font.Style)会带来另一个问题,除非使用这样的过程:

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

这变得相当愚蠢。

摘要

基本上我需要一种挖掘更深层次属性的方法来获取它们的名称,值和类型,将它们放在列表中,并且还能够更改值。

如果有人可以编写一些我可以实现此目的的代码示例(在代码中添加一些评论的奖励),我将不胜感激。我相信一些这将是一个相对容易的任务,但我发现它确实非常微不足道。

到目前为止阅读了各种文档和示例仍然让我相当坦白,主要关注的是不知道使用什么类型或如何正确地创建和管理它们。

1 个答案:

答案 0 :(得分:3)

TFont,TAction,TPopupMenu 等子属性是已在所有者组件中创建的组件(类),如 TButton

要了解属性类型,请使用PropInfo.PropType^.Kind

请参阅Delphi帮助

TypInfo.PTypeInfo Type

TypInfo.TTypeKind

以下是您要求的代码示例:

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

获取子类的示例

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;

使用示例

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

<强>更新

此代码将帮助您理解 SET 属性

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;