Delphi: a construct not calling an overridden virtual constructor

Question

I have an example of a descendant of TBitmap :

 TMyBitmap = class(TBitmap) public constructor Create; override; end; constructor TMyBitmap.Create; begin inherited; Beep; end; 

At runtime, I create one of these TMyBitmap objects, load the image into it, and put it into the TImage in the form:

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

Inside TPicture.SetGraphic you can see that it creates a copy of the graphic object, creating a new one and calling .Assign for the newly created clone:

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

The line in which the new graphics class is built:

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

correctly calls my constructor, and all is well.

---

I want to do something like this, I want to clone 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; 

Also, this never calls my constructor and does not call the TBitmap constructor. It only calls the TObject constructor. After construction:

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

The type is correct, but it does not call my constructor, but the code is identical elsewhere.

Why?

---

Even in this hypothetical contrived example, this is still a problem because the TBitmap constructor is not called; internal state variables are not initialized with real values:

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

---

Version in TPicture:

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

decompiles:

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

My version:

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

decompiles:

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

Update one

Clicking "clone" on a separate function:

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

Does not help.

Update two

It is clear that I am clearly giving a clear screenshot clearly denoting my code, which clearly shows that my explicit code is clearly explicitly there. Obviously:

Update three

Here is an explicit version with 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; 

And the original results:

 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) 

And formatted results:

 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 

Update four

I tried disabling all compiler options, I could:

Note. Do not turn off Extended syntax . Without it, you cannot assign Result function (Result of an undeclared identifier).

Update five

Following @David's suggestion, I tried to compile the code on some other machines (all Delphi 5):

• Ian Boyd (me): Fails (Windows 7 64-bit)
• Dale: Fails (64-bit version of Windows 7)
• Dave: Fails (Windows 7 64-bit)
• Chris: Fails (Windows 7 64-bit)
• Jamie: Fails (Windows 7 64-bit)
• Jay: Fails (32-bit version of Windows XP)
• Client Build Server: Crash (32-bit version of Windows 7)

Here is the source.

Answer 1

This is apparently a problem with scoping (from D5 Graphics.pas):

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

You have no problem redefining Create , and you have no problem calling TGraphicClass(Value.ClassType).Create; from the Graphics.pas block.

However, in another TGraphicClass(Value.ClassType).Create; block TGraphicClass(Value.ClassType).Create; no access to protected members of TGraphic . So you end up calling TObject.Create; (which is not virtual).

Possible solutions

• Modify and recompile Graphics.pas
• Be sure to subclass the clone method below the hierarchy. (e.g. TBitmap.Create is publicly available)

EDIT: Additional Solution

This is a variation of the method for accessing protected class members.
There is no guarantee of the reliability of the solution, but it works. :)
I'm afraid you will have to do your own extensive trials.

 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

What is it worth: I downloaded your source (ZIP file) and ran CannotCloneGraphics.exe and got "Invalid". error message. Then I opened the project (DPR file) in Delphi 2009, compiled it and ran it. Then I did not receive an error message, and the custom constructor worked four times, as it should be.

So it seems like this is a problem with Delphi 5 installations. Indeed, all of your machines had Delphi 5 (update time!). Either there is a problem with Delphi 5, or all your machines have been "tampered with" the same.

I'm sure I have an old Delphi 4 Personal . I can install it and see what happens there ...

Update

I just installed Delphi 4 Standard on a Windows 95 virtual system. I tried this code:

  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; 

and I got only one message box! Therefore, this is a problem with Delphi 4 (and 5), after all. (Sorry, David!)