logo标签列表

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

delphirttidelphi-xe7
7

概述

我知道之前已经有类似的问题被问过：

然而，我对于如何使用RTTI满足我的需求还没有进展。

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

工作示例

下面有几个过程，可以将组件的属性名称、值和类型输出到TStrings列表中。原始源代码不是我的，我只做了一些小修改，整理了代码并将其放入一些方便重用的过程中：

以下内容将输出属性名称，例如：

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

以下代码将输出属性值，例如：
  • 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;

最后，下面的代码将以字符串格式输出属性类型，例如：

  • 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 | False | 布尔型
  • 启用 | True | 布尔型
  • 高度 | 25 | 整数
  • 宽度 | 75 | 整数

问题

目前所有的内容都能正常运行，没有任何问题，除了我需要花一些时间阅读文档来更好地理解并消化这些内容。

我的问题（已经困扰我几天了）是如何正确获取和设置子属性。例如，请看这张 Delphi 对象检查器的截图（为说明修改）：

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 | True | Boolean
  • akTop | True | Boolean
  • akRight | True | Boolean
  • akBottom | True | Boolean

对于字体子属性，例如：

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

要访问另一个子属性 (Font.Style)，则需要使用以下程序：

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

这就变得有些愚蠢了。

摘要

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

如果有人可以编写一些代码示例，以展示如何实现这一点（最好在代码中添加一些注释），我会非常感激。对于某些人来说，这可能是一个相对容易的任务，但我确实发现这非常琐碎。

到目前为止，阅读各种文档和示例仍然让我感到相当困惑，主要问题是不知道应该使用哪些类型或如何正确地创建和管理它们。

1个回答
4

像TFont,TAction,TPopupMenu这样的子属性已经是在拥有这些组件(类)的组件中创建的，比如TButton。

要知道属性类型，请使用PropInfo.PropType^.Kind

请参见 Delphi 帮助文档：

TypInfo.PTypeInfo 类型

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;
HasSubProperty 看起来工作正常，实际上我认为我应该更好地命名它为 HasSubProperties，但这是一个快速的更改。PropInfo := GetPropInfo(Component, APropName);总是返回 nil 并在使用 GetSubPropClass 函数时抛出 AV 错误。你的 Button1 事件中也有一个小错别字，应该是GetComponentPropertyNames(GetSubPropClass(Form1,'TFont'), ListBox4.Items); 而不是 GetComponentPropertyNames(GetSubPropClass(Form1,'TFont',ListBox4.Items); :) - Craig
这是一个快速示例，您必须在您的过程 GetComponentPropertyNames 中使用它并回调它（递归算法）或类似的东西。 - Shadi Ajam
我很感谢您的回答和评论，但是我在这里并没有取得太大的成功。代码有点能用，但只有当我传递 Font 而不是 TFont 时才有效，例如传递 Margins 时它也能正常工作，但是当传递 Anchors 甚至 StyleElements 时就会失败。 - Craig
锚点，样式元素和对齐方式是设置属性而不是对象，因此您无法获取子属性。 - Shadi Ajam
它是OI，可以将一组属性显示为具有布尔属性的对象。 - Stefan Glienke
这是一个不错的开始，我认为我需要阅读你的答案和我链接的其他内容以及文档来理解并学习更多。 - Craig
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接