La classe d'instance de patchage requiert que la classe de base soit dans la même unité?

Question

J'utilise la fonction suivante pour patcher une classe d'instance d'un objet existant. La raison en est que j'ai besoin de patcher une fonction protégée d'une classe tierce.

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; 

Mais pour une raison quelconque, le code ne fonctionne que si la classe de base est définie dans ma propre unité. Pourquoi est-ce? Y a-t-il une solution de rechange pour que cela fonctionne sans elle?

Cela ne fonctionne pas

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. 

Cela fonctionne (La seule différence est la re-définition TwwDBLookupComboDlg)

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

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

end. 

Tout en travaillant sur cet exemple, j'ai découvert que ce phénomène se produit uniquement avec TwwDBLookupComboDlg, mais pas avec TButton. Je ne sais pas pourquoi. Malheureusement, wwdbdlg.pas n'est pas gratuit.

---

Mise à jour:

J'ai découvert: Si je compare TButton et TButtonEx, les deux valeurs sont 608.

Si je compare wwdlg.TwwDBLookupComboDlg et TwwDBLookupComboDlgEx, puis les dimensions sont 940 et 944.

Si je compare Unit1.TwwDBLookupComboDlg et TwwDBLookupComboDlgEx, alors les tailles sont 944 et 944.

Donc ... le vrai problème est: Si je définis TwwDBLookupComboDlg = class(Wwdbdlg.TwwDBLookupComboDlg);, la taille de l'instance augmente de 4 octets!

Une démonstration simple. Ce programme:

{$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. 

émet

 
188 
192 
192 

lorsqu'il est compilé avec Delphi 2007. Cependant, avec XE7 la sortie est:

 
220 
220 
220 

Bien que ce problème se produit sur TOpenDialog, il ne se produit pas avec TCommonDialog.

Mise à jour 2: Exemple minimal

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. 

Answer 1

Cela semble être une bizarrerie (peut-être un bug) dans le comportement du compilateur pour les anciennes versions du compilateur.Je l'ai taillé au couteau jusqu'à ce le code suivant:

{$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. 

Sur Delphi 6 la sortie est:

 
20 
24 

8 
16 

8 
16 

Le compilateur semble gérer l'alignement différemment pour les deux déclarations de classe. La classe contient un double qui a un alignement de 8 octets, suivi d'un entier de 4 octets. Donc, la classe devrait avoir 4 octets de remplissage à la fin pour que sa taille soit un multiple de 8. La première classe n'a pas ce remplissage, la seconde le fait.

Le code ici prouve que les décalages vers les champs n'ont pas changé, et la différence est juste dans le bourrage à la fin du type qui existe pour réaliser l'alignement.

De toute évidence, vous n'obtiendrez pas de correctif pour le compilateur Delphi 2007. Mon soupçon est que vous pouvez enlever le chèque que NewClass.InstanceSize = Instance.InstanceSize et votre code de correction se comportera toujours correctement. Ensuite, il vous incombe de vous assurer que vous n'ajoutez aucun membre à votre classe de correctifs.

Une autre approche pourrait être d'utiliser un mécanisme différent pour patcher le code. Sans plus de connaissance du problème original, il m'est difficile de dire ce que cela pourrait être.