Delphi：构造不调用重写的虚拟构造函数

我有一个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;

没有帮助.

更新二

很明显,我清楚地提供了清晰的截图,清楚地显示了我的清晰代码,清楚地表明我清楚的代码显然是清楚的.很明显：

更新三

这是一个使用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;

原始结果：

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

更新四

我尝试关闭所有编译器选项：

注意：请勿关闭扩展语法.没有它,您无法分配函数的结果(未声明的标识符结果).

更新五

按照@David的建议,我尝试在其他一些机器上编译代码(所有Delphi 5)：

> Ian Boyd(我)：失败(Windows 7 64位)
> Dale：失败(Windows 7 64位)
>戴夫：失败(Windows 7 64位)
>克里斯：失败(Windows 7 64位)
> Jamie：失败(Windows 7 64位)
>周杰伦：失败(Windows XP 32位)
>客户构建服务器：失败(Windows 7 32位)

Here’s the source.

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

TGraphicClass = class of TGraphic;