4

我有一个示例后代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

更新四

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

在此处输入图像描述

注意：不要关闭Extended syntax. 没有它，您将无法分配Result函数的 （未声明的标识符 Result）。

更新五

按照@David 的建议，我尝试在其他一些机器上编译代码（全部为 Delphi 5）：

  • Ian Boyd（我）：失败（Windows 7 64 位）
  • 戴尔：失败（Windows 7 64 位）
  • 戴夫：失败（Windows 7 64 位）
  • 克里斯：失败（Windows 7 64 位）
  • 杰米：失败（Windows 7 64 位）
  • Jay：失败（Windows XP 32 位）
  • 客户构建服务器：失败（Windows 7 32 位）

这是来源。

4

2 回答 2

7

这似乎是一个范围界定问题（以下来自 D5 Graphics.pas）：

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

TGraphicClass = class of TGraphic;

覆盖没有任何问题，从 Graphics.pas 单元中调用Create时也没有任何问题。TGraphicClass(Value.ClassType).Create;

但是，在另一个单元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;
于 2011-03-17T16:29:16.243 回答
3

值得一提的是：我下载了您的源代码（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）的问题。（对不起，大卫！）

于 2011-03-17T15:18:41.540 回答