BGRABitmap - merge 2 images

[domasz]

In Delphi I used TBitmap and Canvas.CopyRect but TBitmap in Lazarus is broken so I am trying to use TBGRABitmap but it feels slow.
Am I doing it correctly? Is there a better approach?

I want to make an image where left part is from Src (bitmap) and right part is from Dest (bitmap).

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

1. var Part1: TBGRABitmap;
2.     Src,Dest: TBGRABitmap;
3.     Part2: TBGRABitmap;
4.     Poss: Integer;
5. begin
6.   Poss := 200;
7.  
8. //Src and Dest are two bitmaps, 600x400 each.
9.  
10.   Part1 := Src.Duplicate(False);
11.   Part2 := Dest.GetPart(Rect(Poss,0, Dest.Width, Dest.Height));
12.  
13.   Part1.PutImage(Poss, 0, Part2, dmSet);
14.   Part2.Free;
15.  
16.   Image1.Picture.Assign(Part1);
17.   Part1.Free;
18. end;  
19.  

[KodeZwerg]

In Delphi I used TBitmap and Canvas.CopyRect but TBitmap in Lazarus is broken

Can you prove that please?

Here is my proof that it works by simple create a snapshot of primary display*, and use what you told is broken to create a different view 
*snapshot feature just available by me for the Windows OS, all others need to load a bitmap in

You need 1 TButton with a click event and 1 Timage to rebuild this.

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   {$IFDEF MSWindows}Windows,{$ENDIF} Classes, Forms, Graphics, StdCtrls, ExtCtrls;
9.  
10. type
11.   { TForm1 }
12.   TForm1 = class(TForm)
13.     Button1: TButton;
14.     Image1: TImage;
15.     procedure Button1Click(Sender: TObject);
16.   private
17.   public
18.   end;
19.  
20. var
21.   Form1: TForm1;
22.  
23. implementation
24.  
25. {$R *.lfm}
26.  
27. { TForm1 }
28.  
29. procedure TForm1.Button1Click(Sender: TObject);
30. {$IFDEF MSWindows}
31. const
32.   CAPTUREBLT   = $40000000;
33.   cmCaptureBlt = CAPTUREBLT; // fast snapshots
34. {$ENDIF}
35. var
36.   {$IFDEF MSWindows}
37.   LDC: HDC;          // device context
38.   LPal: PLogPalette; // backward compatible palette
39.   {$ENDIF}
40.   LCanvas: TCanvas;  // internal drawing surface
41.   LOrgBmp,           // the bitmap used as source
42.   LNewBmp: TBitmap;  // destination bitmap
43. begin
44.   {$IFDEF MSWindows}
45.   // open device context
46.   LDC := GetDCEx(GetDesktopWindow, 0, DCX_WINDOW or DCX_PARENTCLIP or DCX_CLIPSIBLINGS or DCX_CLIPCHILDREN);
47.   try
48.   {$ENDIF}
49.     // create a canvas
50.     LCanvas := TCanvas.Create;
51.     try
52.       // create a bitmap
53.       LOrgBmp := TBitmap.Create;
54.       try
55.         {$IFDEF MSWindows}
56.         // link surface with device context
57.         LCanvas.Handle      := LDC;
58.         // setup bitmap basics
59.         LOrgBmp.PixelFormat := TPixelFormat.pf24bit;
60.         LOrgBmp.Width       := Screen.Monitors[0].Width - Screen.Monitors[0].Left;
61.         LOrgBmp.Height      := Screen.Monitors[0].Height - Screen.Monitors[0].Top;
62.         // if needed, get and add a palette
63.         if (GetDeviceCaps(LDC, RASTERCAPS) and RC_PALETTE = RC_PALETTE) then
64.           begin
65.             GetMem(LPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
66.             FillChar(LPal^, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)), #0);
67.             LPal^.palVersion := $300;
68.             LPal^.palNumEntries := GetSystemPaletteEntries(LDC, 0, 256, LPal^.palPalEntry);
69.             if (LPal^.palNumEntries <> 0) then
70.               LOrgBmp.Palette := CreatePalette(LPal^);
71.             FreeMem(LPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
72.           end;
73.         // prepare to copy
74.         LOrgBmp.Canvas.CopyMode := cmSrcCopy or cmCaptureBlt;
75.         // copy surface to bitmap
76.         LOrgBmp.Canvas.CopyRect(
77.             Rect(0,
78.                  0,
79.                  LOrgBmp.Width,
80.                  LOrgBmp.Height),
81.             LCanvas,
82.             Rect(Screen.Monitors[0].Left,
83.                  Screen.Monitors[0].Top,
84.                  Screen.Monitors[0].Width,
85.                  Screen.Monitors[0].Height));
86.         // LOrgBmp has now a snapshot of monitor[0] (primary)
87.         {$ELSE}
88.         LOrgBmp.LoadFromFile('enter here path and filename of a bitmap');
89.         {$ENDIF}
90.         // create second bitmap
91.         LNewBmp := TBitmap.Create;
92.         try
93.           // link surface with first bitmap
94.           LCanvas.Handle          := LOrgBmp.Canvas.Handle;
95.           // setup basics
96.           LNewBmp.PixelFormat     := LOrgBmp.PixelFormat;
97.           LNewBmp.Width           := LOrgBmp.Width;
98.           LNewBmp.Height          := LOrgBmp.Height;
99.           LNewBmp.Canvas.CopyMode := cmSrcCopy;
100.           // get the right side of LOrgBmp and copy it to the left side of LNewBmp
101.           LNewBmp.Canvas.CopyRect(
102.               Rect(0,
103.                    0,
104.                    LNewBmp.Width div 2,
105.                    LNewBmp.Height),
106.               LCanvas,
107.               Rect(0 + (LOrgBmp.Width div 2),
108.                    0,
109.                    LOrgBmp.Width,
110.                    LOrgBmp.Height));
111.           // get the left side of LOrgBmp and copy it to the right side of LNewBmp
112.           LNewBmp.Canvas.CopyRect(
113.               Rect(0 + (LNewBmp.Width div 2),
114.                    0,
115.                    LNewBmp.Width,
116.                    LNewBmp.Height),
117.               LCanvas,
118.               Rect(0,
119.                    0,
120.                    LOrgBmp.Width div 2,
121.                    LOrgBmp.Height));
122.           // put it on screen
123.           Image1.Picture.Assign(LNewBmp);
124.           // demo is finished, free/release everything
125.         finally
126.           LNewBmp.Free;
127.         end;
128.       finally
129.         LOrgBmp.Free;
130.       end;
131.     finally
132.       LCanvas.Free;
133.     end;
134.   {$IFDEF MSWindows}
135.   finally
136.     ReleaseDC(GetDesktopWindow, LDC);
137.   end;
138.   {$ENDIF}
139. end;
140.  
141. end.

I used Lazarus 2.3.0 (rev main-2_3-2513-g659f556800) FPC 3.2.2 x86_64-win64-win32/win64 on Windows 10. All 64bit.

//edit: modified and corrected names, added small descriptions
//update: now demo should be crosscompile compatible  no snapshot for non-Windows OS

[Handoko]

In Delphi I used TBitmap and Canvas.CopyRect but TBitmap in Lazarus is broken so I am trying to use TBGRABitmap but it feels slow.

I rarely use TCanvas.CopyRect. But I remember last time I used it, it was working good. Please provide the code showing the issue.

TBGRABitmap is not faster than TCanvas, it just adds many extra features to it. TBGRABitmap does have some 3D/OpenGL features but most of the internal module is not hardware accelerated. I ever done a test. A 2D side scrolling spaceship game fully written using TCanvas running a bit slow. I switched the internal graphics handling unit to TBGRABitmap, it run at equally the same performance.

If performance is important, don't use TCanvas nor TBGRABitmap. There are many other options that run much faster:
https://wiki.lazarus.freepascal.org/Graphics_libraries
https://wiki.lazarus.freepascal.org/Game_framework

Learning a library/framework is not easy. But, actually not as hard as you think. I tried Allegro, it relatively easy because it has well written documentation can be found on the web. SDL, I never tried. But some years ago, a teen in the forum can write a simple game after learning SDL in some days. ZenGL seems promising, some of their users are active in this forum. Or at least you should try Graphics32 - a better replacement for TBitmap, the description sounds interesting:
https://en.wikipedia.org/wiki/Graphics32

[domasz]

In Delphi I used TBitmap and Canvas.CopyRect but TBitmap in Lazarus is broken

Can you prove that please?

Of course!

Use {$mode delphi}

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

1. var Bmp: TBitmap;
2.     x,y: Integer;
3.     P: PByteArray;
4. begin
5.   Bmp := TBitmap.Create;
6.   Bmp.LoadFromFile('test.bmp'); //try loading 1bpp image here
7.   Bmp.PixelFormat := pf32bit;
8.  
9.   for y:=0 to Bmp.Height-1 do begin
10.     P := Bmp.Scanline[y];
11.  
12.     for x:=0 to Bmp.Width-1 do begin
13.       P[4*x  ] := 255; //B
14.       P[4*x+1] := 128; //G
15.       P[4*x+2] := 0;   //R
16.       P[4*x+3] := 255; //A or X
17.     end;
18.   end;
19.  
20.   Bmp.SaveToFile('out.bmp');
21.   Bmp.Free;

Works perfectly under Delphi. Crashes under Lazarus because PixelFormat fails to convert to 32bpp.

[KodeZwerg]

I see neither a Canvas or a CopyRect in your snippet what you mentioned that it is broken ?!
I agree, PixelFormat for whatever reason is strange/corrupt, I code anyway with it for future.

[circular]

@domasz What can be accelerated in your BGRABitmap code is that there are intermediate copies of the images.

You can instead directly create a blank image of the wanted size, then use PutImagePart to put both images into it, copying only what is necessary.

Regards

[domasz]

I see neither a Canvas or a CopyRect in your snippet what you mentioned that it is broken ?!
I agree, PixelFormat for whatever reason is strange/corrupt, I code anyway with it for future.

Canvas and CopyRect might be OK but since PixelFormat is broken and it's a very important element then the whole TBitmap is broken.

I might use CopyRect and Canvas but at some point I will come across a problem I don't know how to solve easily without PixelFormat. So Instead I thought it would be better to switch to TBGRABitmap which is quite popular here.

[circular]

In fact, @domasz, you may not need the Image component. If it just to display an image of the same size, not stretched, you could use TBGRAVirtualScreen and redraw the content in the OnRedraw event.

When the image changes, you can call BGRAVirtualScreen1.DiscardBitmap to make it update all of it. Or you can call DiscardBitmapRect and specify the area that is changing, so that only this part will be updated. It can be significantly faster if that's a small part of the image.

[domasz]

If performance is important, don't use TCanvas nor TBGRABitmap. There are many other options that run much faster:
https://wiki.lazarus.freepascal.org/Graphics_libraries
https://wiki.lazarus.freepascal.org/Game_framework

Thanks for the info & the links, much appreciated.

For now I switched to Canvas.CopyRect (seems a bit faster) and limited redraws in MouseMove and works nicely.

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

1. procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
2.   Y: Integer);
3. begin    
4.   if getTickCount-LastMove < 40 then Exit; // 40 ms = 25 fps
5.  
6.   DrawPreview;
7.  
8.   LastMove := getTickCount;  
9. end;

[domasz]

When the image changes, you can call BGRAVirtualScreen1.DiscardBitmap to make it update all of it. Or you can call DiscardBitmapRect and specify the area that is changing, so that only this part will be updated. It can be significantly faster if that's a small part of the image.

Interesting, thanks! I ma just learning all those BGRA* stuff. Seems very useful. For now I use it with some TBitmap operations but maybe I will switch completely.

[circular]

As you wish.