Delphi: Construction ne pas appeler constructeur virtuel surchargée

Question

j'ai un descendant exemple de TBitmap:

TMyBitmap = class(TBitmap)
public
    constructor Create; override;
end;

constructor TMyBitmap.Create;
begin
   inherited;
   Beep;
end;

A run-time i construire un de ces objets TMyBitmap, charger une image en elle, et le placer dans un TImage sur la forme:

procedure TForm1.Button1Click(Sender: TObject);
var
   g1: TGraphic;
begin
   g1 := TMyBitmap.Create;
   g1.LoadFromFile('C:\...\example.bmp');

   Image1.Picture.Graphic := g1;
end;

À l'intérieur de TPicture.SetGraphic vous pouvez voir que cela fait une copie de l'image, en construisant une nouvelle, et appelant .Assign sur le clone nouvellement construit:

procedure TPicture.SetGraphic(Value: TGraphic);
var
   NewGraphic: TGraphic;
begin
   ...
   NewGraphic := TGraphicClass(Value.ClassType).Create;
   NewGraphic.Assign(Value);
   ...
end;

La ligne où la nouvelle classe graphique est construit:

NewGraphic := TGraphicClass(Value.ClassType).Create;

appelle correctement mon constructeur, et tout va bien.

---

je veux faire quelque chose de similaire, je veux cloner un TGraphic:

procedure TForm1.Button1Click(Sender: TObject);
var
   g1: TGraphic;
   g2: TGraphic;
begin
   g1 := TMyBitmap.Create;
   g1.LoadFromFile('C:\...\example.bmp');

   //Image1.Picture.Graphic := g1;
   g2 := TGraphicClass(g1.ClassType).Create;
end;

Sauf que ce n'appelle mon constructeur, ni appeler constructeur TBitmap. Il est seulement appeler le constructeur de TObject. Après la construction:

g2.ClassName: 'TMyBitmap'
g2.ClassType: TMyBitmap

Le type est juste, mais il ne remet pas mon constructeur, mais le code identique ne ailleurs.

Pourquoi?

---

Même dans cet exemple artificiel hypothethetical il est encore un problème, parce que le constructeur de TBitmap n'est pas appelé; variables d'état internes ne sont pas initialisés à des valeurs valides:

constructor TBitmap.Create;
begin
  inherited Create;
  FTransparentColor := clDefault;
  FImage := TBitmapImage.Create;
  FImage.Reference;
  if DDBsOnly then HandleType := bmDDB;
end;

---

La version en TPicture:

NewGraphic := TGraphicClass(Value.ClassType).Create;

décompile à:

mov eax,[ebp-$08]
call TObject.ClassType
mov dl,$01
call dword ptr [eax+$0c]
mov [ebp-$0c],eax

Ma version:

g2 := TGraphicClass(g1.ClassType).Create;

décompile à:

mov eax,ebx
call TObject.ClassType
mov dl,$01
call TObject.Create
mov ebx,eax

Mise à jour un

En appuyant sur le "clonage" à une fonction distincte:

function CloneGraphic(Value: TGraphic): TGraphic;
var
    NewGraphic: TGraphic;
begin
   NewGraphic := TGraphicClass(Value.ClassType).Create;
   Result := NewGraphic;
end;

ne pas d'aide.

Mise à jour Deux

De toute évidence, je suis clairement fournir une capture d'écran claire clairement de mon code clairement que clairement montre que mon code est clairement clairement il y a clairement tout. Il est clair que:

Mise à jour trois

Voici une version avec OutputDebugStrings non ambiguë:

{ TMyGraphic }

constructor TMyBitmap.Create;
begin
  inherited Create;
    OutputDebugStringA('Inside TMyBitmap.Create');
end;

function CloneGraphic(Value: TGraphic): TGraphic;
var
    NewGraphic: TGraphic;
begin
    NewGraphic := TGraphicClass(Value.ClassType).Create;
    Result := NewGraphic;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    g1: TGraphic;
    g2: TGraphic;
begin
    OutputDebugString('Creating g1');
    g1 := TMyBitmap.Create;
    g1.LoadFromFile('C:\Archive\-=Images=-\ChessvDanCheckmateIn38.bmp');
    OutputDebugString(PChar('g1.ClassName: '+g1.ClassName));

    OutputDebugStringA('Assigning g1 to Image.Picture.Graphic');
    Image1.Picture.Graphic := g1;

    OutputDebugString('Creating g2');
    g2 := Graphics.TGraphicClass(g1.ClassType).Create;
    OutputDebugString(PChar('g2.ClassName: '+g2.ClassName));

    OutputDebugString(PChar('Cloning g1 into g2'));
    g2 := CloneGraphic(g1);
    OutputDebugString(PChar('g2.ClassName: '+g2.ClassName));
end;

Et les résultats bruts:

ODS: Creating g1 Process Project2.exe ($1138)
ODS: Inside TMyBitmap.Create Process Project2.exe ($1138)
ODS: g1.ClassName: TMyBitmap Process Project2.exe ($1138)
ODS: Assigning g1 to Image.Picture.Graphic Process Project2.exe ($1138)
ODS: Inside TMyBitmap.Create Process Project2.exe ($1138)
ODS: Creating g2 Process Project2.exe ($1138)
ODS: g2.ClassName: TMyBitmap Process Project2.exe ($1138)
ODS: Cloning g1 into g2 Process Project2.exe ($1138)
ODS: g2.ClassName: TMyBitmap Process Project2.exe ($1138)
ODS: g1.ClassName: TMyBitmap Process Project2.exe ($1138)

Et les résultats au format:

Creating g1
   Inside TMyBitmap.Create
g1.ClassName: TMyBitmap

Assigning g1 to Image.Picture.Graphic
   Inside TMyBitmap.Create

Creating g2
g2.ClassName: TMyBitmap

Cloning g1 into g2
g2.ClassName: TMyBitmap

g1.ClassName: TMyBitmap

Mise à jour Quatre

i essayé de désactiver toutes les options compilateurs je pouvais:

Remarque: Ne pas éteindre Extended syntax. Sans elle, vous ne pouvez pas affecter la Result d'une fonction ( identifiant Résultat Présence non déclarée ).

Mise à jour Cinq

Après @ la suggestion de David, j'ai essayé de compiler le code sur d'autres machines (tous Delphi 5):

• Ian Boyd (moi): échoue (Windows 7 64 bits)
• Dale: échoue (Windows 7 64 bits)
• Dave: échoue (Windows 7 64 bits)
• Chris: échoue (Windows 7 64 bits)
• Jamie: échoue (Windows 7 64 bits)
• Jay: échoue (Windows XP 32 bits)
• Build client serveur: échoue (Windows 7 32 bits)

Voici la source.

Answer 1

Cela semble être un problème de portée (ce qui suit est de D5 Graphics.pas):

TGraphic = class(TPersistent)
...
protected
  constructor Create; virtual;
...
end;

TGraphicClass = class of TGraphic;

Vous n'avez des problèmes primordiaux Create, et vous n'avez aucun problème lorsque TGraphicClass(Value.ClassType).Create; est appelé à partir de l'unité Graphics.pas.

Toutefois, dans une autre unité TGraphicClass(Value.ClassType).Create; n'a pas accès aux membres protégés de TGraphic. Donc, vous finissez donc par appeler TObject.Create; (qui est non-virtuelle).

Solutions possibles

• Modifier et recompilation Graphics.pas
• Assurez-vous que les sous-classes de méthode clone plus bas de la hiérarchie. (Par exemple TBitmap.Create est public)

EDIT: Solution supplémentaire

Ceci est une variante de la technique d'accès de gain aux membres protégés d'une classe.
Aucune garantie sur la robustesse de la solution, mais il ne semble travailler. :)
Vous devrez faire vos propres tests approfondis j'ai peur.

type
  TGraphicCracker = class(TGraphic)
  end;

  TGraphicCrackerClass = class of TGraphicCracker;

procedure TForm1.Button1Click(Sender: TObject);
var
  a: TGraphic;
  b: TGraphic;
begin
  a := TMyBitmap.Create;
  b := TGraphicCrackerClass(a.ClassType).Create;
  b.Free;
  a.Free;
end;

Answer 2

Pour ce que ça vaut la peine: je l'ai téléchargé votre source (le fichier ZIP) et RAN CannotCloneGraphics.exe et a obtenu un « non valide ». Message d'erreur. Ensuite, j'ai ouvert le projet (le fichier DPR) dans Delphi 2009, compilé et couru. Alors je n'ai pas eu un message d'erreur et le constructur personnalisé couru quatre fois, comme il se doit.

Il semblerait donc que cela est un problème avec vos installations Delphi 5. En effet, tous vos machines avaient Delphi 5 (temps de passer ?!). Soit il y a un problème avec Delphi 5, ou toutes vos machines ont été « trafiqué » avec de la même manière.

Je suis assez sûr que j'ai un vieux Delphi 4 Personnel quelque part. Je pourrais l'installer et de voir ce qui s'y passe ...

Mise à jour

Je viens d'installer Delphi 4 standard dans un système Windows 95 virtuel. J'ai essayé ce code:

  TMyBitmap = class(TBitmap)
  public
    constructor Create; override;
  end;

  ...

  constructor TMyBitmap.Create;
  begin
    inherited;
    ShowMessage('Constructor constructing!');
  end;

  ...

  procedure TForm1.Button1Click(Sender: TObject);
  var
    g, g2: TGraphic;
  begin
    g := TMyBitmap.Create;
    g2 := TGraphicClass(g.ClassType).Create;
    g.Free;
    g2.Free;
  end;

et Je n'ai qu'une boîte de message! Par conséquent, cette un problème avec Delphi 4 (et 5), après tout. (Désolé, David!)