Delphi: Konstruktion, die nicht überschriebene virtuelle Konstruktor ruft

Question

Ich habe einen Beispiel nachkommt von TBitmap:

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

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

Zur Laufzeit konstruiere ich eines davon TMyBitmap Objekte, laden Sie ein Bild hinein und legen Sie es in a TImage auf dem Formular:

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

   Image1.Picture.Graphic := g1;
end;

Innen TPicture.SetGraphic Sie können sehen, dass es eine Kopie der Grafik macht, indem Sie eine neue erstellen und anrufen .Assign auf dem neu konstruierten Klon:

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

Die Linie, in der die neue Grafikklasse konstruiert ist:

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

Ruft meinen Konstruktor korrekt auf, und alles ist gut.

---

Ich möchte etwas Ähnliches tun, ich möchte a klonen a 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;

Außer dies ruft nie meinen Konstruktor an, und es ruft auch nicht an TBitmap Konstrukteur. Es ruft nur an TObject Konstrukteur. Nach dem Bau:

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

Der Typ stimmt, aber er nennt meinen Konstruktor nicht, aber der identische Code an anderer Stelle.

Wieso den?

---

Selbst in diesem hypothetischen erfundenen Beispiel ist es immer noch ein Problem, weil der Konstruktor von TBitmap wird nicht genannt; Interne Zustandsvariablen werden nicht auf gültige Werte initialisiert:

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

---

Die Version in tPicture:

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

zerlegt zu:

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

Meine Version:

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

zerlegt zu:

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

Aktualisieren Sie einen

Drücken des "Klonen" in eine separate Funktion:

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

Hilft nicht.

Zwei aktualisieren

Natürlich stelle ich eindeutig ein klares Screenshot für meinen klarer Code, der deutlich zeigt, dass mein klarer Code eindeutig alles ist. Deutlich:

Aktualisieren Sie drei

Hier ist eine eindeutige Version mit OutputDebugStrings:

{ 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;

Und die rohen Ergebnisse:

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)

Und die formatierten Ergebnisse:

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

Vier aktualisieren

Ich habe versucht, alle Optionen für Compiler auszuschalten, die ich konnte:

Notiz: Schalten Sie nicht aus Extended syntax. Ohne sie können Sie die nicht zuweisen Result einer Funktion (Nicht deklarierter Identifikator Ergebnis).

Fünf aktualisieren

Nach @Davids Vorschlag habe ich versucht, den Code auf einigen anderen Maschinen zu kompilieren (alle Delphi 5):

• Ian Boyd (ME): Fails (Windows 7 64-Bit)
• Dale: Failure (Windows 7 64-Bit)
• Dave: Failure (Windows 7 64-Bit)
• Chris: Failure (Windows 7 64-Bit)
• Jamie: Failure (Windows 7 64-Bit)
• JAY: FAIL (Windows XP 32-Bit)
• Customer Build Server: Fail (Windows 7 32-Bit)

Hier ist die Quelle.

Answer 1

Dies scheint ein Scoping -Problem zu sein (das folgende stammt von D5 Grafik.pas):

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

TGraphicClass = class of TGraphic;

Sie haben keine Probleme, die sich überraschen Create, und Sie haben keine Probleme, wenn TGraphicClass(Value.ClassType).Create; wird innerhalb der Grafik -Pas -Einheit aufgerufen.

In einer anderen Einheit jedoch TGraphicClass(Value.ClassType).Create; Hat keinen Zugang zu geschützten Mitgliedern von TGraphic. Also rufst du also an TObject.Create; (was nicht virtuell ist).

Mögliche Lösungen

• Bearbeiten und Kompilieren von Grafiken.pas
• Stellen Sie sicher, dass die Unterklassen Ihrer Klonmethode die Hierarchie tiefern. (zB tbitmap.create ist öffentlich)

Bearbeiten: Zusätzliche Lösung

Dies ist eine Variation der Technik, um Zugang zu den geschützten Mitgliedern einer Klasse zu erhalten.
Keine Garantie für die Robustheit der Lösung, aber es scheint zu funktionieren. :)
Ich fürchte, Sie müssen Ihre eigenen umfangreichen Tests durchführen.

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

Für das, was es wert ist: Ich habe Ihre Quelle (die Zip -Datei) heruntergeladen und ausgeführt CannotCloneGraphics.exe und bekam ein "nicht gültig". Fehlermeldung. Dann habe ich das Projekt (die DPR -Datei) in Delphi 2009 eröffnet, es zusammengestellt und leitete es. Dann habe ich keine Fehlermeldung erhalten, und der benutzerdefinierte Konstruktur lief viermal so, wie es sollte.

Es scheint also, dass dies ein Problem mit Ihren Delphi 5 -Installationen ist. In der Tat, alle Ihre Maschinen hatten Delphi 5 (Zeit zum Upgrade?!). Entweder gibt es ein Problem mit Delphi 5 oder alle Ihre Maschinen wurden auf die gleiche Weise "manipuliert".

Ich bin mir ziemlich sicher, dass ich einen alten Delphi 4 habe persönlich irgendwo. Ich könnte es installieren und sehen, was dort passiert ...

Aktualisieren

Ich habe gerade den Delphi 4 -Standard in einem virtuellen Windows 95 -System installiert. Ich habe diesen Code ausprobiert:

  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;

und Ich habe nur ein Nachrichtenbox! Deshalb das ist schließlich ein Problem mit Delphi 4 (und 5). (Entschuldigung, David!)