[SOLVED] Can you reproduce this TBitmap-Bug? (Linux only)

[Hartmut]

If you have a Linux OS: please help to test, if you can reproduce this bug:
 - compile and run attached project on Linux
 - if a graphic image is displayed, then the bug did not occur
 - if instead the form is completely gray, then the bug did occur
 - if the bug occurs, please uncomment lines 54..57. Does the bug now disapear?
Please report your results here and include the detailed version numbers of your Linux OS and your Lazarus installation. Thanks a lot. If the but is reproduceable, I will file a bug report.

The attached program is a demo which was created by wp in reply #11 of this Topic: https://forum.lazarus.freepascal.org/index.php/topic,68059.0.html
It displays a picture file (demo.png) which is also included in the attached project. I added only 1 line (line 52):

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls,
9.   math;
10.  
11. const
12.   FileSpec = 'demo.png'; {picture file to show}
13.   Margin = 10; {Margin for background-color in 'clYellow'}
14.  
15. type
16.  { TForm1 }
17.  TForm1 = class(TForm)
18.    PaintBox1: TPaintBox;
19.    ScrollBox1: TScrollBox;
20.    procedure FormDestroy(Sender: TObject);
21.    procedure PaintBox1Paint(Sender: TObject);
22.    procedure showPicture(fspec: string);
23.    procedure FormActivate(Sender: TObject);
24.  private
25.    FPicture: TPicture;
26.    FBuffer: TBitmap;
27.    FScalingFactor: Double;
28.  end;
29.  
30. var
31.   Form1: TForm1;
32.  
33. implementation
34.  
35. {$R *.lfm}
36.  
37. const
38.   MaxFormWidth = 1000;
39.   MaxFormHeight = 800;
40.  
41. { TForm1 }
42.  
43. procedure TForm1.ShowPicture(FSpec: String);
44. var
45.   w, h, i: Integer;
46.   R: TRect;
47. begin
48.   FPicture.Free; // To prevent memory leak when ShowPicture might be called a second time
49.   FPicture := TPicture.Create;
50.   if FBuffer = nil then FBuffer := TBitmap.Create;
51.  
52.   FBuffer.PixelFormat:=pf32bit; // added
53. (*
54.   i:=33; {values < 33 do not work}    // this seems to solve the bug:
55.   FBuffer.SetSize(i,i);
56.   FBuffer.Canvas.Brush.Color:=clBlack;
57.   FBuffer.Canvas.FillRect(0,0,i,i);
58. *)
59.   try
60.     FPicture.LoadFromFile(FSpec);
61.  
62.     w := round(FScalingFactor*FPicture.Width) + 2*Margin;
63.     h := round(FScalingFactor*FPicture.Height) + 2*Margin;
64.     Paintbox1.SetBounds(0, 0, w, h);
65.  
66.     SetBounds(0, 0, Min(Paintbox1.Width, MaxFormWidth), Min(Paintbox1.Height, MaxFormHeight));
67.  
68.     FBuffer.SetSize(w, h);
69.     FBuffer.Canvas.Brush.Color := clYellow;
70.     FBuffer.Canvas.FillRect(0, 0, FBuffer.Width, FBuffer.Height);
71.     R := Rect(Margin, Margin, FBuffer.Width - Margin, FBuffer.Height - Margin);
72.     FBuffer.Canvas.StretchDraw(R, FPicture.Bitmap);
73.   except
74.     on E:Exception do
75.       begin
76.         ShowMessage('Error on loading file!');
77.         FreeAndNil(FPicture);
78.         FreeAndNil(FBuffer);
79.         exit;
80.       end;
81.   end;
82. end;
83.  
84. const
85.   Counter: Integer = 0;
86.  
87. procedure TForm1.PaintBox1Paint(Sender: TObject);
88. begin
89.   if FBuffer = nil then
90.     exit;
91.  
92.   WriteLn('OnPaint ' + IntToStr(Counter));
93.   inc(Counter);
94.  
95.   Paintbox1.Canvas.Draw(0, 0, FBuffer);
96. end;
97.  
98. procedure TForm1.FormDestroy(Sender: TObject);
99. begin
100.   FPicture.Free;
101.   FBuffer.Free;
102. end;
103.  
104. procedure TForm1.FormActivate(Sender: TObject);
105. const
106.   first: boolean = true;
107. begin
108.   if not first then exit;
109.  
110.   first:=false;
111.   ScrollBox1.Align:=alClient;
112.   ScrollBox1.BorderStyle:=bsNone;
113.   ScrollBox1.HorzScrollBar.Tracking:=true; {scroll in Realtime: }
114.   ScrollBox1.VertScrollBar.Tracking:=true;
115.  
116.   Paintbox1.Left := 0;
117.   Paintbox1.Top := 0;
118.  
119.   FScalingFactor := 0.75; {0.75 causes bug, 0.74 and 0.76 work}
120.  
121.   ShowPicture(FileSpec); {shows the picture in file 'FileSpec'}
122. end;
123.  
124. end.

The reason for this line 52 is, that I found out, that the memory consumption with 'pf32bit' is significantly smaller (1 GB less for 'FScalingFactor=14'). After I did this, I got this bug for many FScalingFactor's:
 - the bug occurs with values of 0.71, 0.73, 0.75 and so on
 - the bug does not occur with values of 0.72, 0.74, 0.76 and so on.

This bug only occurs on Linux (Ubuntu 18.04 64-bit) with gtk2, not with qt5. And not on Windows. I tested with:
 - Lazarus 3.99 (rev main_3_99-2316-g00f3d3b397) FPC 3.3.1 x86_64-linux-gtk2
 - Lazarus 3.4.0 with FPC 3.2.2
 - Lazarus 2.2.4 with FPC 3.2.2
 - Lazarus 2.0.10 with FPC 3.2.0

I found out, that lines 54..57 seem to be a workaround for this bug. Can you confirm this?

[wp]

In Manjaro Linux I can confirm the gray paintbox, but do not observe the crash when the pf32bit line is added. Without this line the bitmap uses a device-specific pixel format. I wonder why pf32bit results in the least memory consumption for you, I would have expected to be highest.

BTW, the code that I presented in that other thread is really not very clever since it blows up the input image to a huge buffer bitmap in case of large magnification factor. I think now that it would be better to use the Canvas.CopyRect command which magnifies only the rectangle specified as source. The destination rect, into which the source rect is blown-up, then should be the scrollbox area. You must scale the scrollbox area back into the original image to find the src rect, i.e. divide dimension by your scaling factor. Please try it yourself, I don't have my mind free for this right now,

[Hartmut]

In Manjaro Linux I can confirm the gray paintbox

Thank you wp for testing.

... but do not observe the crash when the pf32bit line is added.

Maybe we misunderstood here. This Topic here has nothing to do with the crash, which I had for *big* scaling factors > 14 in reply # 12 of https://forum.lazarus.freepascal.org/index.php/topic,68059.0.html

I wonder why pf32bit results in the least memory consumption for you, I would have expected to be highest.

I agree. But in the attached screenshot you see the memory consumption in my Linux taskmanager (for scaling factor=14) with the Default = 'pfDevice' in red and with 'pf32bit' in blue. The difference is 1 GB. And the peak at start is higher for 'pfDevice'.

BTW, the code that I presented in that other thread is really not very clever since it blows up the input image to a huge buffer bitmap in case of large magnification factor. I think now that it would be better to use the Canvas.CopyRect command which magnifies only the rectangle specified as source. The destination rect, into which the source rect is blown-up, then should be the scrollbox area. You must scale the scrollbox area back into the original image to find the src rect, i.e. divide dimension by your scaling factor. Please try it yourself, I don't have my mind free for this right now

Thank you for that suggestion. I will try if I can realize that.

[Hartmut]

Thank you wp for this very detailed informations. I agree that especially the dependency of the scaling factor is very strange. But the fact, that you can solve the problem by uncommenting lines 54..57 lets me assume, that the initialization of

Code: Pascal  [Select][+][-]

1. FBuffer.PixelFormat:=pf32bit;

is not correct.

[iLya2IK]

I think the problem is that you delete fpicture before you create it.

Try to add assigned-check at line 48

Code: Pascal  [Select][+][-]

1. if Assigned(FPicture) then FreeAndNil(FPicture);

And i advise you to set the pointer fields to nil on creation cause they may be intialized as a garbage on startup.

[marcov]

Fields of classes are initialized to zero as per language spec.

[Hartmut]

@iLya2IK:
Thanks for that suggestion. I replaced line 48 with your command, but it made no difference. As marcov said, fields of classes are filled with zeros on class creation. You can rely on that.

@marcov:
Thanks for clarification.

[iLya2IK]

Yep. This is the bug. Under normal conditions, all scaleFactor variants should show an empty PaintBox, since when creating an instance of gdkpixbuf, all bits in the image mask are zero (the image is completely transparent). But the problem is that gtkwidget, for some reason, uses a certain algorithm to determine whether the image is transparent (whether the mask provided is valid). The mentioned algorithm, it seems to me, was designed incorrectly (gtk2lclintf.inc lines 354, 355).

Code: Pascal  [Select][+][-]

1. // GraphType.pp (expanded)
2. MaskSize := ((Width +  7) and not PtrUInt(7) * Height) shr 3;
3. // gtk2lclintf.inc
4. DivMod(ARawImage.DataSize, ARawImage.MaskSize, ADivResult, ARemainder);
5. CreateWithAlpha := ARemainder = 0;
6.  

Thus, all the combinations of heights/widths where the image is shown in the paintbox are the bug. Not the bug - these are those few combinations of heights/widths when the image disappears (it is transparent - CreateWithAlpha = true).

[Hartmut]

This sounds very interesting, iLya2IK. Thank you. I will mention in my bug report, that you found the reason, why and where the bug occors. Is this correct?

BTW: you have a typo in the filename. I think it must be gtk2lclintf.inc and not gdk2lclintf.inc. Maybe you want to correct this in your post (at 2 places), because I want to reference this post in my bug report.

Addendum:
What would be a good subject for the bug report?
TPaintBox: error in transparent mode detection (Linux gtk2 only)
or
TBitmap: error in transparent mode detection (Linux gtk2 only)

[iLya2IK]

Of course! I don't mind at all if you refer to my post. It's a pity that I didn't have the patience to understand the idea of the developers why this particular check of the size of the mask is performed. In my opinion, it is more logical to describe the bug as
TBitmapCanvas: error in transparent mode detection (Linux gtk2 only)

[wp]

Title: Stretch draw issue with TBitmap Canvas (gtk2 only)

And attach a simpler demo project, something like this:

Code: Pascal  [Select][+][-]

1. procedure TForm1.PaintBox1Paint(Sender:TObject);
2. var
3.   bmp: TBitmap;
4. begin
5.   bmp := TBitmap.Create;
6.   try
7.     bmp.PixelFormat := pf32bit;
8.     bmp.SetSize(1000, 1000);
9.     bmp.Canvas.Brush.Color := clRed;
10.     bmp.Canvas.FillRect(0, 0, bmp.Width div 2, bmp.Height);
11.     bmp.Canvas.Brush.Color := clYellow;
12.     bmp.Canvas.FillRect(bmp.Width div 2, 0, bmp.Width, bmp.Height);
13.     Caption := FormatFloat('0.000', bmp.RawImage.DataSize/bmp.RawImage.MaskSize);
14.     Paintbox1.Canvas.StretchDraw(Rect(0, 0, Paintbox1.Width, Paintbox1.Height), bmp);
15.   finally
16.     bmp.Free;
17.   end;
18. end;

The bitmap is not drawn when its size is 1000x1000 like in above code (the form caption displays the no-remainder ratio of RawImage.DataSize/.MaskSize), but incrementing width or height by 1 makes the bitmap appear (and DataSize-to-MaskSize ratio is fractional now).

Mention issue #8553 in which the code shown by iLya2IK was added. If possible assign the report to Zeljan Rikalo (if you can't I'll do it for you then).

[Hartmut]

Thanks a lot wp for that demo. I had prepared a bug report with an own demo, but I will change it to use your demo, because it is much shorter and better. I have a visitor today, so it will be Sunday, when I can file the bug report.

BTW: I miss your post, which did exist between replies #2 und #3. There you described detailed how you made your test. Did you delete it? Or is this an issue of the forum software?

[wp]

BTW: I miss your post, which did exist between replies #2 und #3. There you described detailed how you made your test. Did you delete it? Or is this an issue of the forum software?

Sorry, I unintentionally deleted it (Touchpad-mouse jumped over from "modify" to "delete", and I did not read the confirmation prompt carefully).)

[Hartmut]

I filed a bug report in https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/41070

@wp:
can you please assign this report to Zeljan Rikalo? I saw no way to do it. Thanks.

[wp]

Done