1

Мне необходимо зарегистрировать класс. Как делаю я:

procedure registerArr(Classes: array of TPersistentClass);
begin
   RegisterClasses(Classes);
end;

registerArr([TStyleManager
]);

Но при компиляции мне выводит эту ошибку

[dcc32 Error] test.pas(336): E2010 Incompatible types: 'TPersistentClass' and 'class of TStyleManager'

При этом другие классы регистрируются без проблем.

3
  • 1
    ваши другие видимо унаследованы от TPersistentClass, а вот TStyleManager нет.
    – teran
    9 окт 2018 в 10:33
  • проблема как раз в этом.
    – MagicFun
    9 окт 2018 в 10:48
  • 1
    расскажите лучше, зачем вам это понадобилось вообще? Очевидно, цепочку наследования вы тут не измените никак. Какую задачу вы с помощью этого хотите решить?
    – teran
    9 окт 2018 в 10:59

1 ответ 1

2

Очевидно, зарегистрировать класс TStyleManager Вам не удастся по одной простой причине: данный класс не ведет свою родословную от класса TPersistent.

Генеалогическое древо

В модуле VCL.Themes, класс TStyleManager объявлен следующим образом:

  TStyleManager = class sealed
  <...>
  end;  

Ознакомимся со справкой:

The System.TObject class, declared in the System unit, is the ultimate ancestor of all other classes. <...> If the declaration of a class type does not specify an ancestor, the class inherits directly from System.TObject.

Небольшой перевод:
Класс TObject является ультимативным предком любого класса. Если не указан прямой предок класса, то компилятор, по умолчанию будет считать таковым класс TObject.

Выходит, класс TStyleManager в качестве предка использует класс TObject.

Ошибка, которую Вам выдает компилятор, говорит о несоответствии типов, требующихся для регистрации. Полагаю, Вы уже догадались, что классы TPersistentClass и TObject являются различными?

Класс TPersistentClass объявлен в модуле System.Classes и имеет следующий вид:

  TPersistentClass = class of TPersistent;

Нарушитель номер один

Безусловно, на ум приходит вот такое простое решение - приведение типов.

RegisterClasses([TPersistentClass(TStyleManager)]);

Но не стоит питать иллюзий относительно работоспособности данного метода в данном конкретном случае. Вы получите гарантированное сообщение об ошибке.

Вся соль заключается в работе процедуры RegisterClass, которая, в свою очередь, вызывается процедурой RegisterClasses.
Вот так выглядит "тело" процедуры RegisterClass (незначительный код убран):

procedure RegisterClass(AClass: TPersistentClass);
begin
  <...>
  while not RegGroups.Registered(AClass) do
  begin
    RegGroups.RegisterClass(AClass);
    if AClass = TPersistent then Break;
    AClass := TPersistentClass(AClass.ClassParent);
  end;
  <...>
end;

Класс TRegGroups (его экземпляр RegGroups) является ответственным за регистрацию классов, поэтому именно к нему обращается цикл, чтобы убедиться: является ли указанный класс зарегистрированным? Как видно, процедура прекратит проверку регистрации класса и выйдет из цикла только в том случае, если данный класс будет иметь в качестве ClassParent класс TPersistent. До этого момента цикл будет перебирать цепочку родителей, возвращаемых функцией ClassParent до тех пор, пока не встретит искомый результат. Такой подход оправдан для класса TPersistentClass, но для классов, предком которых является класс TObject такое решение весьма печально. Все дело в работе функции ClassParent.

Что говорит нам справка:

System::TObject::ClassParent returns the name of the parent class for an object instance or class reference. For System::TObject, System::TObject::ClassParent returns nil (Delphi) or NULL (C++). Avoid using System::TObject::ClassParent in application code.

Иными словами, для класса TObject данная функция вернет значение nil. Вот почему сделан этот реферанс в сторону использования только персистентных классов(TPersistent).

Мы не используем TObject...

Выше я упоминал гарантированное сообщение об ошибке. Это так. Всему виной* работа метода TRegGroup.RegisterClass, который имеет следующий вид (незначительный код убран):

procedure TRegGroup.RegisterClass(AClass: TPersistentClass);
var
  LClassName: string;
  LClass: TPersistentClass;
begin
  LClassName := AClass.ClassName;
  LClass := GetClass(LClassName);
  <...>
end;  

Данный метод ожидает на входе валидный класс в аргументе AClass. Ограничений, введенных программистами Embarcadero в виде применения TPersistentClass достаточно, чтобы не делать проверку на nil для входящего аргумента. Вместе с тем, именно первое обращение к аргументу и вызывает неизбежное AccessViolation.

За Информацией!

Кто владеет информацией - владеет миром. Шутка ли, но это так. Чтобы владеть миром больше понимать о работе тех или иных функций, указанных здесь, советую посетить данные ресурсы:

  1. Classes and Objects
  2. RegisterClasses method
  3. GetClass function
  4. ClassParent function
  5. Ищите непонятные функции и процедуры в исходных текстах модулей, поставляемых вместе с Delphi.

*На самом деле, метод работает так, как от него ожидается при поступлении корректного аргумента. Использование метода не по назначению (см. приведение типов выше) не является ошибкой программистов Embarcadero.

12
  • да у вас талант воду лить.
    – teran
    10 окт 2018 в 12:18
  • @teran, что Вы имеете в виду? 10 окт 2018 в 13:21
  • весь смысл вашего ответа находится в первом предложении. Далее изложение всякой всячины, чтобы создать объем, что в простонародье называется "налить воды" в текст. высосанные из пальца заведомо некорректные приведения типов, разбор исходного кода, и т.п. В общем написано много, а по существу - одно предложение.
    – teran
    10 окт 2018 в 13:28
  • @teran, Вы ошибаетесь. Если считать за воду подробное описание причин происходящих процессов, то я тогда даже не знаю, что Вам ответить. Я бы мог не писать такой развернутый ответ, просто указать в комментарии причину. Однако если у человека возникнут вопросы "а почему происходит именно так, а не иначе", необходимо будет в комментариях объяснять суть. Это не слишком удобно, поэтому я поместил всю необходимую информацию сразу в ответ. 10 окт 2018 в 13:39
  • @teran, Вы могли бы сразу дать ответ на вопрос, так как он содержится в Вашем первом комментарии к вопросу. Но Вы этого не сделали. Почему? 10 окт 2018 в 13:40

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.