Delphi：構造不調用重寫的虛擬構造函數

Question

我有一個TBitmap的示例后代：

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

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

在運行時，我構建其中一個TMyBitmap對象，將圖像加載到其中，並將其放置在窗體上的TImage ：

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

   Image1.Picture.Graphic := g1;
end;

在TPicture.SetGraphic你可以看到它通過構造一個新圖形並在新構造的克隆上調用.Assign來制作圖形的副本：

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

構造新圖形類的行：

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

正確調用我的構造函數，一切都很好。

---

我想做類似的事情，我想克隆一個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;

除此之外從不調用我的構造函數，也不調用TBitmap構造函數。 它只調用TObject構造函數。 施工后：

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

類型是正確的，但它不會調用我的構造函數，但其​​他地方的代碼相同。

為什么？

---

即使在這個假設的人為例子中，它仍然是一個問題，因為TBitmap的構造函數沒有被調用; 內部狀態變量未初始化為有效值：

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

---

TPicture中的版本：

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

反編譯為：

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

我的版本：

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

反編譯為：

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

更新一

將“克隆”推送到單獨的功能：

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

沒有幫助。

更新二

很明顯，我清楚地提供了清晰的截圖，清楚地顯示了我的清晰代碼，清楚地表明我清楚的代碼顯然是清楚的。 很明顯：

更新三

這是一個使用OutputDebugString的非官方版本：

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

原始結果：

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)

格式化的結果：

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

更新四

我嘗試關閉所有編譯器選項：

注意：請勿關閉Extended syntax 。 沒有它，您無法分配函數的Result （ 未聲明的標識符結果 ）。

更新五

按照@David的建議，我嘗試在其他一些機器上編譯代碼（所有Delphi 5）：

• Ian Boyd（我）：失敗（Windows 7 64位）
• 戴爾：失敗（Windows 7 64位）
• 戴夫：失敗了（Windows 7 64位）
• 克里斯：失敗（Windows 7 64位）
• 傑米：失敗（Windows 7 64位）
• 周傑倫：失敗（Windows XP 32位）
• 客戶構建服務器：失敗（Windows 7 32位）

這是源頭。

Answer 1

這似乎是一個范圍問題（以下是來自D5 Graphics.pas）：

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

TGraphicClass = class of TGraphic;

你沒有任何問題覆蓋Create ，並且當TGraphicClass(Value.ClassType).Create;時沒有任何問題TGraphicClass(Value.ClassType).Create; 從Graphics.pas單元中調用。

但是，在另一個單元TGraphicClass(Value.ClassType).Create; 無法訪問受保護的TGraphic成員。 所以你最終調用了TObject.Create; （這是非虛擬的）。

可能的解決方案

• 編輯並重新編譯Graphics.pas
• 確保克隆方法子類在層次結構中較低。 （例如TBitmap.Create是公開的）

編輯：附加解決方案

這是獲取對類的受保護成員的訪問權的技術的變體。
不保證解決方案的穩健性，但似乎確實有效。 :)
我擔心你必須進行自己的廣泛測試。

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

值得一提的是：我下載了你的源代碼（ZIP文件），並運行了CannotCloneGraphics.exe並得到了“無效”。 錯誤信息。 然后我在Delphi 2009中打開了項目（DPR文件），編譯並運行它。 然后我沒有得到任何錯誤消息，並且自定義構造器運行了四次，應該如此。

因此，這似乎是您的Delphi 5安裝的問題。 確實，你的所有機器都有Delphi 5（升級時間？！）。 要么Delphi 5存在一些問題，要么所有機器都以同樣的方式被“篡改”。

我很確定我有一個舊的Delphi 4 個人 某處。 我可能會安裝它，看看那里發生了什么......

更新

我剛剛在虛擬Windows 95系統中安裝了Delphi 4 Standard。 我試過這段代碼：

  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;

我只有一個消息框！ 因此，這畢竟是 Delphi 4（和5）的問題。 （對不起，大衛！）