Класс экземпляра экземпляра требует, чтобы базовый класс находился в одной единице?

Я использую следующую функцию для исправления класса экземпляра существующего объекта. Причина в том, что мне нужно исправить защищенную функцию стороннего класса.

procedure PatchInstanceClass(Instance: TObject; NewClass: TClass);
type
  PClass = ^TClass;
begin
  if Assigned(Instance) and Assigned(NewClass)
    and NewClass.InheritsFrom(Instance.ClassType)
    and (NewClass.InstanceSize = Instance.InstanceSize) then
  begin
    PClass(Instance)^ := NewClass;
  end;
end;

Но по какой-то причине код работает только в том случае, если базовый класс определен в моем собственном блоке. Почему так? Есть ли работа, чтобы заставить ее работать без нее?

Это не работает

 unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, wwdblook, Wwdbdlg;

type
  TwwDBLookupComboDlg = class(Wwdbdlg.TwwDBLookupComboDlg); // This is necessary
  TForm1 = class(TForm)
    Button1: TButton;
    wwDBLookupComboDlg1: TwwDBLookupComboDlg;
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TButtonEx = class(TButton)
  end;

  TwwDBLookupComboDlgEx = class(TwwDBLookupComboDlg)
  end;

procedure PatchInstanceClass(Instance: TObject; NewClass: TClass);
type
  PClass = ^TClass;
begin
  if Assigned(Instance) and Assigned(NewClass)
    and NewClass.InheritsFrom(Instance.ClassType)
    and (NewClass.InstanceSize = Instance.InstanceSize) then
  begin
    PClass(Instance)^ := NewClass;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PatchInstanceClass(Button1, TButtonEx);
  showmessage(Button1.ClassName); // Good: TButtonEx

  PatchInstanceClass(wwDBLookupComboDlg1, TwwDBLookupComboDlgEx);
  showmessage(wwDBLookupComboDlg1.ClassName); // Bad: TwwDBLookupComboDlg (should be TwwDBLookupComboDlgEx)
end;

end.

Это работает (единственное различие заключается в повторном определении TwwDBLookupComboDlg)

type
  TwwDBLookupComboDlg = class(wwdbdlg.TwwDBLookupComboDlg); // <------ added!

procedure TForm1.FormCreate(Sender: TObject);
begin
  PatchInstanceClass(wwDBLookupComboDlg1, TwwDBLookupComboDlgEx);
  showmessage(wwDBLookupComboDlg1.ClassName); // shows TwwDBLookupComboDlgEx :-)
end;

end.

Во время работы над этим примером я узнал, что это явление происходит только с TwwDBLookupComboDlg, но не с TButton. Я не знаю почему. К сожалению, wwdbdlg.pas не является бесплатным.

Update:

Я узнал: если я сравниваю TButton и TButtonEx, оба значения равны 608.

Если я сравниваю wwdlg.TwwDBLookupComboDlg и TwwDBLookupComboDlgEx, то размеры равны 940 и 944.

Если я сравниваю Unit1.TwwDBLookupComboDlg и TwwDBLookupComboDlgEx, то размеры равны 944 и 944.

Итак... актуальная проблема: если я определяю TwwDBLookupComboDlg = class(Wwdbdlg.TwwDBLookupComboDlg);, размер экземпляра увеличивается на 4 байта!

Простая демонстрация. Эта программа:

{$APPTYPE CONSOLE}

uses
  Dialogs;

type
  TOpenDialog = class(Vcl.Dialogs.TOpenDialog);
  TOpenDialogEx = class(TOpenDialog);

begin
  Writeln(Vcl.Dialogs.TOpenDialog.InstanceSize);
  Writeln(TOpenDialog.InstanceSize);
  Writeln(TOpenDialogEx.InstanceSize);
  Readln;
end.

испускает

188
192
192

при компиляции с Delphi 2007. Однако с XE7 вывод:

220
220
220

Пока эта проблема возникает в TOpenDialog, этого не происходит с TCommonDialog.

Обновление 2: Минимальный пример

program Project1;

{$APPTYPE CONSOLE}

uses
  Classes, Dialogs;

type
  TOpenDialog = class(TCommonDialog)
  private
    FOptionsEx: TOpenOptionsEx;
  end;

  TOpenDialogEx = class(Project1.TOpenDialog);

begin
  Writeln(Project1.TOpenDialog.InstanceSize); // 100
  Writeln(TOpenDialogEx.InstanceSize); // 104
  Readln;
end.

Ответы

Ответ 1

Это выглядит как странность (возможно, ошибка) в поведении компилятора для более старых версий компилятора. Я сократил это до следующего кода:

{$APPTYPE CONSOLE}

type
  TClass1 = class
    FValue1: Double;
    FValue2: Integer;
  end;

  TClass2 = class(TClass1);

begin
  Writeln(TClass1.InstanceSize);
  Writeln(TClass2.InstanceSize);

  Writeln;
  Writeln(Integer(@TClass1(nil).FValue1));
  Writeln(Integer(@TClass1(nil).FValue2));

  Writeln;
  Writeln(Integer(@TClass2(nil).FValue1));
  Writeln(Integer(@TClass2(nil).FValue2));

  Readln;
end.

На Delphi 6 вывод:

20
24

8
16

8
16

Компилятор, по-видимому, обрабатывает выравнивание по-разному для двух объявлений класса. Класс содержит double, который имеет 8-байтовое выравнивание, за которым следует целое число в 4 байта. Таким образом, класс действительно должен иметь 4 байта заполнения в конце, чтобы сделать его размер кратным 8. Первый класс не имеет этого дополнения, второй - делает.

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

Очевидно, вы не получите патч для компилятора Delphi 2007. Мое подозрение в том, что вы можете удалить проверку, что NewClass.InstanceSize = Instance.InstanceSize и ваш код исправления по-прежнему будет вести себя правильно. Тогда бремя ответственности за то, что вы не добавляете каких-либо членов данных в свой класс исправления.

Другим подходом может быть использование другого механизма для исправления кода. Не зная о первоначальной проблеме, мне трудно сказать, что это может быть.