[solved] BGRABitmap TBGRABitmap.Resample failed on Linux GKT2

[Michl]

Hi,

this is the further thread for this http://forum.lazarus.freepascal.org/index.php/topic,33737.

There is a bug in BGRABitmap for 32bit and 64bit Linux GTK2. A SomeTBGRABitmap.Resample failed there.

I add a reduced example, which runs fine on 32bit and 64bit Windows 7. In the Zip I also added some snapshots to see the wrong resizing. I've debugged the issue a bit, it seems in StretchPutImage (unit BGRAResample), the offset of PBGRAPixels isn't correct (or maybe the TBGRACustomBitmap.ScanLine[...] result)? I hope circular knows immediately where to search, when he see the added images. 

The code is this:

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

1. ...
2.     Picture: TPicture;
3.     FBitmap: TBGRACustomBitmap;
4.     Dummy: TBGRABitmap;
5. ...
6. procedure TForm1.FormCreate(Sender: TObject);
7. begin
8.   FBitmap := Nil;
9.   Picture := TPicture.Create;
10.   Picture.LoadFromFile(Application.Location + 'test.jpg');
11.   Dummy := TBGRABitmap.Create;
12.   Dummy.Assign(Picture.Bitmap);
13.  
14. //  Dummy := TBGRABitmap.Create(Application.Location + 'test.jpg');
15. end;
16.  
17. procedure TForm1.FormDestroy(Sender: TObject);
18. begin
19.   if Assigned(FBitmap) then FBitmap.Free;
20.   Dummy.Free;
21.   Picture.Free;
22. end;
23.  
24. procedure TForm1.FormPaint(Sender: TObject);
25. begin
26.   if Assigned(FBitmap) then
27.     FBitmap.Draw(Canvas, 0, 0);
28. end;
29.  
30. procedure TForm1.FormResize(Sender: TObject);
31. begin
32.   if Assigned(FBitmap) then FBitmap.Free;
33.   FBitmap := Dummy.Resample(ClientWidth, ClientHeight, rmSimpleStretch);
34. end;

The issue is also there, if a bmp is loaded (in the first thread it seems not) or "Dummy" load the img/bmp direct but it isn't so obviously. Then the black areas are filled with wrong content.

I tested BGRABitmapPackage 9.1 (rev. 1265 (today) from svn://svn.code.sf.net/p/lazpaint/code/bgrabitmap).

[lainz]

Dont use sourceforge anymore the always latest version is on github.

[Michl]

Thank you for the hint!

I downloaded the package from https://github.com/bgrabitmap/lazpaint (rev. 95) and tested the trunk version of BGRABitmap, but the issue is still there.

[circular]

Strange. It works on Windows 64bits.

Looking at the code, it seems the problem arises in LinearMix procedure when transition is not tsPlain.

I wonder if the black pixels are in fact transparent. Michl, what happens if you save those images in PNG format?

[Michl]

Looking at the code, it seems the problem arises in LinearMix procedure when transition is not tsPlain.

There I was yesterday too

I wonder if the black pixels are in fact transparent. Michl, what happens if you save those images in PNG format?

You are right, the debugger shows for PDest RGBA [0,0,0,0]. Interesting, the result is a complete empty png, not just empty at the black areas.

[Edit]
PSrc1 and PSrc2 have values, but alpha is all the time 0.

If I load a bmp, alpha is all the time 255.

If I fill the alpha channel for the jpg, the example is running fine:

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

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   FBitmap := Nil;
4.   Picture := TPicture.Create;
5.   Picture.LoadFromFile(Application.Location + 'test.jpg');
6.   WriteLn(Picture.Bitmap.PixelFormat);  // write for jpg and bmp: pf24bit
7.   Dummy := TBGRABitmap.Create;
8.   Dummy.Assign(Picture.Bitmap);
9.   Dummy.AlphaFillRect(0, 0, Dummy.Width, Dummy.Height, 255);  // <- this line added    

[circular]

So it may be that TBGRABitmap.Assign function does not set the alpha values. Can you find out what internal functions are used to do the Assign?

[Michl]

I'm not realy sure, what you need, but I see in LoadFromRawImageImplementation:

nbColorChannels = 32
ARawImage.Description.BitsPerPixel = 32
mustSwapRedBlue = true (in Windows it is false)

and it steps into:

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

1.         copyProc := @CopyFrom32Bit_SwapRedBlue_KeepAlpha    

And if I step through

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

1. procedure CopyFrom32Bit_SwapRedBlue_KeepAlpha(psrc: PByte; pdest: PBGRAPixel; count: NativeInt; sourcePixelSize: PtrInt; {%H-}defaultOpacity: byte);
2. var srcValue: NativeUInt;
3. begin
4.   while count > 0 do
5.   begin
6.     srcValue := PDWord(psrc)^;
7.     PDWord(pdest)^ := (srcValue and not (BGRA_RedMask or BGRA_BlueMask))
8.                    or (((srcValue and BGRA_RedMask) shr TBGRAPixel_RedShift) shl TBGRAPixel_BlueShift)
9.                    or (((srcValue and BGRA_BlueMask) shr TBGRAPixel_BlueShift) shl TBGRAPixel_RedShift);
10.     dec(count);
11.     inc(pdest);
12.     inc(psrc, sourcePixelSize);
13.   end;
14. end;

I can see pdest^.alpha is 0. So it was 0 before.

A bmp is loaded with ARawImage.Description.BitsPerPixel = 24. So maybe it is a LCL issue? But why is a jpg with alpha = 0 shown on Windows and shown on Linux, when it is simply copied? And why shows a WriteLn(Picture.Bitmap.PixelFormat) pf24bit for this jpg when ARawImage.Description.BitsPerPixel = 32?

[Michl]

Maybe there must be a check of ARawImage.Description.Depth, cause it is 24 for this 32bit jpg (and ARawImage.Description.BlueShift = ARawImage.Description.AlphaShift = 0).

E.G. this works for me (unit BGRALCLBitmap, around line 400):

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

1.     if not mustSwapRedBlue then
2.     begin
3.       if ARawImage.Description.BitsPerPixel = 24 then
4.         copyProc := @CopyFrom24Bit
5.       else
6.       if AlwaysReplaceAlpha then
7.         copyProc := @CopyFrom32Bit_SetAlpha
8.       else if DefaultOpacity = 0 then
9.         copyProc := @CopyFrom32Bit_KeepAlpha
10.       else
11.         copyProc := @CopyFrom32Bit_ReplaceZeroAlpha;
12.     end else
13.     begin
14.       if ARawImage.Description.BitsPerPixel = 24 then
15.         copyProc := @CopyFrom24Bit_SwapRedBlue
16.       else
17.       if ARawImage.Description.Depth = 24 then  // this
18.         copyProc := @CopyFrom32Bit_SwapRedBlue_SetAlpha // and this line inserted
19.       else  // and this
20.         if AlwaysReplaceAlpha then
21.           copyProc := @CopyFrom32Bit_SwapRedBlue_SetAlpha
22.         else if DefaultOpacity = 0 then
23.           copyProc := @CopyFrom32Bit_SwapRedBlue_KeepAlpha
24.         else
25.           copyProc := @CopyFrom32Bit_SwapRedBlue_ReplaceZeroAlpha;
26.     end;
27.   end;  

But I'm not sure, if this is the right check at the right position.

[circular]

That's the idea. While we're at it we can check for the alpha precision:

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

1.     if not mustSwapRedBlue then
2.     begin
3.       if ARawImage.Description.BitsPerPixel = 24 then
4.         copyProc := @CopyFrom24Bit
5.       else
6.       if AlwaysReplaceAlpha or (ARawImage.Description.AlphaPrec = 0) then
7.         copyProc := @CopyFrom32Bit_SetAlpha
8.       else if DefaultOpacity = 0 then
9.         copyProc := @CopyFrom32Bit_KeepAlpha
10.       else
11.         copyProc := @CopyFrom32Bit_ReplaceZeroAlpha;
12.     end else
13.     begin
14.       if ARawImage.Description.BitsPerPixel = 24 then
15.         copyProc := @CopyFrom24Bit_SwapRedBlue
16.       else
17.       if AlwaysReplaceAlpha or (ARawImage.Description.AlphaPrec = 0) then
18.         copyProc := @CopyFrom32Bit_SwapRedBlue_SetAlpha
19.       else if DefaultOpacity = 0 then
20.         copyProc := @CopyFrom32Bit_SwapRedBlue_KeepAlpha
21.       else
22.         copyProc := @CopyFrom32Bit_SwapRedBlue_ReplaceZeroAlpha;
23.     end;

I have updated on Git.

[Michl]

I even tested current git version and my little test app on:

Windows 7, 32 bit
Windows 7, 64 bit
Linux Mint 17.3 GTK2, 32 bit
Linux Mint 17.3 GTK2, 64 bit

All tests work fine. 

Thank you!

[circular]

You're welcome. Thank you for you help