BGRABitmap - merge 2 images
lazarus / 39-Graphics

----------------------------------------------------------------------
domasz · 2023-02-03 23:11

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var Part1:
TBGRABitmap;    Src,Dest: TBGRABitmap;    Part2: TBGRABitmap;    Poss:
Integer;begin  Poss := 200; //Src and Dest are two bitmaps, 600x400
each.   Part1 := Src.Duplicate(False);  Part2 :=
Dest.GetPart(Rect(Poss,0, Dest.Width, Dest.Height));  
Part1.PutImage(Poss, 0, Part2, dmSet);  Part2.Free;  
Image1.Picture.Assign(Part1);  Part1.Free;end;

----------------------------------------------------------------------
KodeZwerg · 2023-02-04 00:05

Quote from: domasz on February 04, 2023, 12:11:50 amIn Delphi I used
TBitmap and Canvas.CopyRect but TBitmap in Lazarus is brokenCan 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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  {$IFDEF
MSWindows}Windows,{$ENDIF} Classes, Forms, Graphics, StdCtrls,
ExtCtrls; type  { TForm1 }  TForm1 = class(TForm)    Button1:
TButton;    Image1: TImage;    procedure Button1Click(Sender:
TObject);  private  public  end; var  Form1:
TForm1; implementation {$R *.lfm} { TForm1 } procedure
TForm1.Button1Click(Sender: TObject);{$IFDEF MSWindows}const 
CAPTUREBLT   = $40000000;  cmCaptureBlt = CAPTUREBLT; // fast
snapshots{$ENDIF}var  {$IFDEF MSWindows}  LDC: HDC;          // device
context  LPal: PLogPalette; // backward compatible palette  {$ENDIF} 
LCanvas: TCanvas;  // internal drawing surface  LOrgBmp,           //
the bitmap used as source  LNewBmp: TBitmap;  // destination
bitmapbegin  {$IFDEF MSWindows}  // open device context  LDC :=
GetDCEx(GetDesktopWindow, 0, DCX_WINDOW or DCX_PARENTCLIP or
DCX_CLIPSIBLINGS or DCX_CLIPCHILDREN);  try  {$ENDIF}    // create a
canvas    LCanvas := TCanvas.Create;    try      // create a bitmap  
  LOrgBmp := TBitmap.Create;      try        {$IFDEF MSWindows}      
// link surface with device context        LCanvas.Handle      :=
LDC;        // setup bitmap basics        LOrgBmp.PixelFormat :=
TPixelFormat.pf24bit;        LOrgBmp.Width       :=
Screen.Monitors[0].Width - Screen.Monitors[0].Left;       
LOrgBmp.Height      := Screen.Monitors[0].Height -
Screen.Monitors[0].Top;        // if needed, get and add a palette   
   if (GetDeviceCaps(LDC, RASTERCAPS) and RC_PALETTE = RC_PALETTE)
then          begin            GetMem(LPal, SizeOf(TLOGPALETTE) + (255
* SizeOf(TPALETTEENTRY)));            FillChar(LPal^,
SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)), #0);           
LPal^.palVersion := $300;            LPal^.palNumEntries :=
GetSystemPaletteEntries(LDC, 0, 256, LPal^.palPalEntry);            if
(LPal^.palNumEntries <> 0) then              LOrgBmp.Palette :=
CreatePalette(LPal^);            FreeMem(LPal, SizeOf(TLOGPALETTE) +
(255 * SizeOf(TPALETTEENTRY)));          end;        // prepare to
copy        LOrgBmp.Canvas.CopyMode := cmSrcCopy or cmCaptureBlt;    
  // copy surface to bitmap        LOrgBmp.Canvas.CopyRect(          
Rect(0,                 0,                 LOrgBmp.Width,            
   LOrgBmp.Height),            LCanvas,           
Rect(Screen.Monitors[0].Left,                 Screen.Monitors[0].Top, 
               Screen.Monitors[0].Width,               
 Screen.Monitors[0].Height));        // LOrgBmp has now a snapshot of
monitor[0] (primary)        {$ELSE}        LOrgBmp.LoadFromFile('enter
here path and filename of a bitmap');        {$ENDIF}        // create
second bitmap        LNewBmp := TBitmap.Create;        try          //
link surface with first bitmap          LCanvas.Handle          :=
LOrgBmp.Canvas.Handle;          // setup basics         
LNewBmp.PixelFormat     := LOrgBmp.PixelFormat;          LNewBmp.Width
          := LOrgBmp.Width;          LNewBmp.Height          :=
LOrgBmp.Height;          LNewBmp.Canvas.CopyMode := cmSrcCopy;       
 // get the right side of LOrgBmp and copy it to the left side of
LNewBmp          LNewBmp.Canvas.CopyRect(              Rect(0,       
          0,                   LNewBmp.Width div 2,                 
 LNewBmp.Height),              LCanvas,              Rect(0 +
(LOrgBmp.Width div 2),                   0,                 
 LOrgBmp.Width,                   LOrgBmp.Height));          // get
the left side of LOrgBmp and copy it to the right side of LNewBmp    
    LNewBmp.Canvas.CopyRect(              Rect(0 + (LNewBmp.Width div
2),                   0,                   LNewBmp.Width,            
     LNewBmp.Height),              LCanvas,              Rect(0,     
            0,                   LOrgBmp.Width div 2,                
 LOrgBmp.Height));          // put it on screen         
Image1.Picture.Assign(LNewBmp);          // demo is finished,
free/release everything        finally          LNewBmp.Free;       
end;      finally        LOrgBmp.Free;      end;    finally     
LCanvas.Free;    end;  {$IFDEF MSWindows}  finally   
ReleaseDC(GetDesktopWindow, LDC);  end;  {$ENDIF}end; 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 · 2023-02-04 04:27

Quote from: domasz on February 04, 2023, 12:11:50 amIn 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 · 2023-02-04 12:56

Quote from: KodeZwerg on February 04, 2023, 01:05:29 amQuote from:
domasz on February 04, 2023, 12:11:50 amIn Delphi I used TBitmap and
Canvas.CopyRect but TBitmap in Lazarus is brokenCan you prove that
please?
Of course!

Use {$mode delphi}
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var Bmp:
TBitmap;    x,y: Integer;    P: PByteArray;begin  Bmp :=
TBitmap.Create;  Bmp.LoadFromFile('test.bmp'); //try loading 1bpp
image here  Bmp.PixelFormat := pf32bit;   for y:=0 to Bmp.Height-1 do
begin    P := Bmp.Scanline[y];     for x:=0 to Bmp.Width-1 do begin  
  P[4*x  ] := 255; //B      P[4*x+1] := 128; //G      P[4*x+2] := 0; 
//R      P[4*x+3] := 255; //A or X    end;  end;  
Bmp.SaveToFile('out.bmp');  Bmp.Free;
Works perfectly under Delphi. Crashes under Lazarus because
PixelFormat fails to convert to 32bpp.

----------------------------------------------------------------------
KodeZwerg · 2023-02-04 13:13

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 · 2023-02-04 13:16

@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 · 2023-02-04 13:20

Quote from: KodeZwerg on February 04, 2023, 02:13:52 pmI 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 · 2023-02-04 14:12

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 · 2023-02-04 15:21

Quote from: Handoko on February 04, 2023, 05:27:32 amIf 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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,  Y:
Integer);begin      if getTickCount-LastMove < 40 then Exit; // 40 ms
= 25 fps   DrawPreview;   LastMove := getTickCount;  end;

----------------------------------------------------------------------
domasz · 2023-02-04 15:23

Quote from: circular on February 04, 2023, 03:12:51 pmWhen 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 · 2023-02-04 16:05

As you wish.