Обнаружение класса, в котором свойство впервые публикуется с несколькими уровнями наследования

Используя модуль Typinfo, можно легко перечислить свойства, как показано в следующем фрагменте:

procedure TYRPropertiesMap.InitFrom(AClass: TClass; InheritLevel: Integer = 0);
var
  propInfo: PPropInfo;
  propCount: Integer;
  propList: PPropList;
  propType: PPTypeInfo;
  pm: TYRPropertyMap;
  classInfo: TClassInfo;
  ix: Integer;

begin
  ClearMap;

  propCount := GetPropList(PTypeInfo(AClass.ClassInfo), propList);
  for ix := 0 to propCount - 1 do
  begin
    propInfo := propList^[ix];
    propType := propInfo^.PropType;

    if propType^.Kind = tkMethod then
      Continue; // Skip methods
    { Need to get GetPropInheritenceIndex to work
    if GetPropInheritenceIndex(propInfo) > InheritLevel then
      Continue; // Dont include properties deeper than InheritLevel
    }
    pm := TYRPropertyMap.Create(propInfo.Name);
    FList.Add(pm);
  end;
end;

Однако мне нужно выяснить точный класс, от которого наследуется каждое свойство. Например, в TControl свойство Tag исходит от TComponent, что дает ему глубину наследования, равную 1 (0 — это свойство, объявленное в самом TControl, например Cursor).

Вычислить глубину наследования легко, если я знаю, какой класс первым определил свойство. Для моих целей, где свойство впервые стало общедоступным, там оно и появилось впервые.

Я использую Delphi 2007. Пожалуйста, дайте мне знать, если потребуется дополнительная информация. Вся помощь будет оценена.


person Atorian    schedule 14.10.2009    source источник


Ответы (2)


Это работает для меня.
Суть в том, чтобы получить TypeInfo родителя из переданного через дочернего TypeInfo

procedure InheritanceLevel(AClassInfo: PTypeInfo; const AProperty: string; var level: Integer);
var
  propInfo: PPropInfo;
  propCount: Integer;
  propList: PPropList;
  ix: Integer;
begin
  if not Assigned(AClassInfo) then Exit;
  propCount := GetPropList(AClassInfo, propList);
  for ix := 0 to propCount - 1 do
  begin
    propInfo := propList^[ix];
    if propInfo^.Name = AProperty then
    begin
      Inc(level);
      InheritanceLevel(GetTypeData(AClassInfo).ParentInfo^, AProperty, level)
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  level: Integer;
begin
  level := 0;
  InheritanceLevel(PTypeInfo(TForm.ClassInfo), 'Tag', level);
end;
person Lieven Keersmaekers    schedule 14.10.2009
comment
Ах я вижу. Надеялся на более прямой способ (например, возиться с VMT), но это определенно работает. К счастью, эффективность не является моей главной заботой в данный момент. Спасибо за быстрый ответ - ваше решение определенно выходит за рамки direct, в которых я застрял. - person Atorian; 14.10.2009

Я не знаю, сможете ли вы найти это с помощью RTTI, доступного в Delphi 2007. Большинство свойств в дереве TComponent объявлены как защищенные в исходном классе, а затем повторно объявлены как опубликованные ниже, и у вас есть RTTI только для опубликованных участников.

Я как раз собирался описать что-то очень похожее на решение Ливена, когда увидел, что он меня опередил. Это найдет первый класс, в котором свойство было опубликовано, если это то, что вы ищете, но не найдет, где свойство было первоначально объявлено. Вам нужен расширенный RTTI Delphi 2010, если вы этого хотите.

person Mason Wheeler    schedule 14.10.2009
comment
Я забыл о опубликованной части, вы, конечно, правы. Итог: невозможно получить класс, в котором свойство было первоначально объявлено с помощью Delphi 2007 с использованием RTTI, если свойство изначально не было объявлено в опубликованном разделе. - person Lieven Keersmaekers; 14.10.2009
comment
Правильно, что касается защищенных и опубликованных, все в порядке. Я использовал TControl только в качестве примера. Мне это нужно для работы с большим деревом пользовательских компонентов. Все они имеют много опубликованных свойств и зачастую очень глубокие уровни наследования, но ни одно из них не меняет видимость свойств. Насколько я понимаю, где свойство впервые получило опубликованную видимость, там оно и появилось впервые. Надеюсь, я смогу следовать этому правилу, чтобы все было просто. - person Atorian; 14.10.2009