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