Question

我正在尝试在Object上找到所有带有TStrings后代类型的Properties。

以下是我尝试过的内容：

在表单上放置备忘录和图表，然后是此代码。

procedure TForm1.FormCreate(Sender: TObject);
var
  aObject: TObject;
begin
  for aObject in GetItemsObjects(Chart1) do
    Memo1.Lines.Add(aObject.ClassName);
end;

class function TForm1.GetItemsObjects(aObject: TObject): TArray<TObject>;
var
  RttiProperty: TRttiProperty;
  RttiType: TRttiType;
  ResultList: TList<TObject>;
  PropertyValue: TValue;
  PropertyObject: TObject;
  s: String;
begin
  ResultList := TList<TObject>.Create;
  try
    RttiType := RttiContext.GetType(aObject.ClassType);
    for RttiProperty in RttiType.GetProperties do
    begin
      PropertyValue := RttiProperty.GetValue(aObject);

      if (not PropertyValue.IsObject) or (PropertyValue.IsEmpty) then
        continue;

      try
        PropertyObject := PropertyValue.AsObject;

        s := PropertyObject.ClassName;

        if (PropertyObject is TStrings) then
          ResultList.Add(PropertyObject)
        else
          ResultList.AddRange(GetItemsObjects(PropertyObject));
      except

      end;
    end;

  finally
    Result := ResultList.ToArray;
    ResultList.Free;
  end;
end;

问题是我得到了堆栈溢出。即使我试图用这段代码停止递归：

        if (PropertyObject is TStrings) then
          ResultList.Add(PropertyObject)
        else
          ResultList.AddRange(GetItemsObjects(PropertyObject));

Answer 1

您的代码导致堆栈溢出，因为您递归调用GetItemsObjects，它还会从Parent扫描TControl等属性。

如果你真的想以递归方式对TStrings属性进行深度扫描，那么你需要确保不再重新访问相同的对象 - 用列表或其他东西跟踪它们。

获取所有TStrings属性的列表

1 个答案: