我有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
s
{ 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):
答案 0 :(得分:7)
这似乎是一个范围问题(以下是来自D5 Graphics.pas):
TGraphic = class(TPersistent)
...
protected
constructor Create; virtual;
...
end;
TGraphicClass = class of TGraphic;
覆盖Create
时没有任何问题,并且在Graphics.pas单元中调用TGraphicClass(Value.ClassType).Create;
时没有任何问题。
但是,在另一个单元中TGraphicClass(Value.ClassType).Create;
无权访问TGraphic
的受保护成员。因此,您最终会调用TObject.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;
答案 1 :(得分:3)
值得一提的是:我下载了你的源文件(ZIP文件),然后运行CannotCloneGraphics.exe
并获得了“无效”。错误信息。然后我在Delphi 2009中打开了项目(DPR文件),编译并运行它。然后我没有收到任何错误消息,并且自定义构造器运行了四次,应该如此。
因此,您的Delphi 5安装似乎存在问题。确实,所有你的机器都有Delphi 5(升级的时间?!)。要么Delphi 5存在一些问题,要么所有机器都以同样的方式被“篡改”。
我很确定我的某个地方有一个旧的Delphi 4 Personal 。我可能会安装它,看看那里发生了什么......
我刚刚在虚拟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)的问题。 (对不起,大卫!)