TLazIntfImage as an alternative to scanline
lazarus / 39-Graphics

----------------------------------------------------------------------
TG · 2011-04-11 08:23

I have been converting a large sized Delphi (2010) app to Lazarus
(0.9.30) FPC (2.4.2) over the last few days.  The majority went mostly
painlessly and I managed to get it compiled (at least the main chunk
of code I want to test under FPC).

Now the problem.  Trying to use TLazIntfImage as an alternative to
Delphi's scanline.  I followed the suggestions here http://wiki.lazaru
s.freepascal.org/Developing_with_Graphics#Working_with_TLazIntfImage
but have found slowdowns compared to scanlines.

After looking around and trying various examples of TLazIntfImage I
cannot get it to perform well.  In my tests even using canvas.pixels
directly is faster.

So any help for a newbie would be greatly appreciated.

Here is a simple test app to show the issue.  Single form with a
alclient aligned timage and 2 buttons.  This is the source for the
unit1 form.

Code: [Select]unit Unit1;

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses classes,forms,windows,dialogs,sysutils,extctrls,graphics,math,str
utils,controls,
     StdCtrls
     {$IFDEF FPC}
     ,LCLType, // HBitmap type
     IntfGraphics, // TLazIntfImage type
     fpImage // TFPColor type
     {$ENDIF}
     ;

type
  pRGBArray  =  ^TRGBArray;    // Use SysUtils.pByteArray for 8-bit
color
  TRGBArray  =  ARRAY[0..32767] OF TRGBTriple;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var ix,iy:integer;
    tbm:tbitmap;
    startms,finishms:int64;
begin
     startms:=gettickcount;
     tbm:=tbitmap.create;
     tbm.width:=image1.width;
     tbm.height:=image1.height;
     for iy:=0 to image1.height-1 do
     begin
          for ix:=0 to image1.width-1 do
          begin
               tbm.canvas.pixels[ix,iy]:=rgb(255,0,0);
          end;
          if iy mod 1=0 then
          begin
            image1.canvas.draw(0,0,tbm);
            application.processmessages;
          end;
     end;
     image1.canvas.draw(0,0,tbm);
     tbm.free;
     application.processmessages;
     finishms:=gettickcount;
     showmessage('time taken = '+inttostr(finishms-startms)+' ms');
end;

procedure TForm1.Button2Click(Sender: TObject);
var ix,iy:integer;
    tbm:tbitmap;
    startms,finishms:int64;
    pRGB:pRGBArray;
    {$IFDEF FPC}
    IntfImg1, IntfImg2: TLazIntfImage;
    ImgHandle,ImgMaskHandle: HBitmap;
    CurColor: TFPColor;
    {$ENDIF}
begin
     startms:=gettickcount;
     tbm:=tbitmap.create;
     tbm.width:=image1.width;
     tbm.height:=image1.height;
     {$IFDEF FPC}
     IntfImg1:=TLazIntfImage.Create(0,0);
     IntfImg1.LoadFromBitmap(tbm.Handle,tbm.MaskHandle);
     {$ENDIF}
     for iy:=0 to image1.height-1 do
     begin
          {$IFDEF FPC}
          pRGB:=IntfImg1.GetDataLineStart(iy);
          {$ELSE}
          pRGB:=tbm.scanline[iy];
          {$ENDIF}
          for ix:=0 to image1.width-1 do
          begin
               {$IFDEF FPC}
               pRGB^[ix].rgbtred:=0;
               pRGB^[ix].rgbtgreen:=0;
               pRGB^[ix].rgbtblue:=255;
               {$ELSE}
               pRGB[ix].rgbtred:=0;
               pRGB[ix].rgbtgreen:=0;
               pRGB[ix].rgbtblue:=255;
               {$ENDIF}
          end;
          if iy mod 1=0 then
          begin
            {$IFDEF FPC}
            IntfImg1.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
            tbm.Handle:=ImgHandle;
            tbm.MaskHandle:=ImgMaskHandle;
            {$ENDIF}
            image1.canvas.draw(0,0,tbm);
            application.processmessages;
          end;
     end;
     {$IFDEF FPC}
     IntfImg1.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
     tbm.Handle:=ImgHandle;
     tbm.MaskHandle:=ImgMaskHandle;
     {$ENDIF}
     image1.canvas.draw(0,0,tbm);
     application.processmessages;
     tbm.free;
     finishms:=gettickcount;
     showmessage('time taken = '+inttostr(finishms-startms)+' ms');
end;

end.

I need to keep the IFDEFS at this stage so I can maintain compatible
code between Delphi and Lazarus (at least until the Lazarus code is
all working and I can ditch Delphi).

The current performance I get is 2402 ms for pixels and 3074 ms for
the TLazIntfImage code (image1 is 800x600 pixels).

Compiling the same code under Delphi 2010 gives 1341 ms for pixels and
1123 for scanline.

Am I missing anything obvious with the TLazIntfImage code?

Also I would like to get this multi-platform in the future, so is
pRGB^[ix].rgbtred:= the right way to go?  I noticed the wiki link said
if you know the colors are byte aligned then the rgbtred can be set
direct, but what if in the future I compile on linux and/or mac?  What
is the safest (and fastest) way to implement this?

Many thanks for any tips.  This app is heavily graphics intensive so I
need quick scanline like speeds.

TG

----------------------------------------------------------------------
circular · 2011-04-11 12:55

The developing with graphics wiki was somehow messed up. TLazIntfImage
does not provide direct pixel access, but is a memory bitmap that you
can copy to a TBitmap object.

Look again here :
http://wiki.lazarus.freepascal.org/Developing_with_Graphics

----------------------------------------------------------------------
TG · 2011-04-11 23:50

Thanks, BGRA works fine.

I was blaming the pixel performance, but in reality it is the
calculation code behind the scenes that is slower when compiled under
Lazarus FPC.

----------------------------------------------------------------------
circular · 2011-04-12 14:35

Did you activate code optimisations (Project > Compiler options >
Code) ?

It is important to check to store variables into registers (-Or)

----------------------------------------------------------------------
TG · 2011-04-15 06:06

Yes I used -o2 optimisations and -oR.

Here is the current test code.

Code: [Select]procedure TForm1.Button3Click(Sender: TObject);
var ix,iy:integer;
    tbm:tbitmap;
    startms,finishms:int64;
    {$IFDEF FPC}
    bmp:TBGRABitmap;
    {$ENDIF}
begin
     startms:=gettickcount;
     tbm:=tbitmap.create;
     tbm.width:=image1.width;
     tbm.height:=image1.height;
     {$IFDEF FPC}
     bmp:=TBGRABitmap.Create(tbm.width,tbm.height,BGRABlack);
     {$ENDIF}
     for iy:=0 to image1.height-1 do
     begin
          for ix:=0 to image1.width-1 do
          begin
               {$IFDEF FPC}
               bmp.setpixel(ix,iy,rgb(0,255,0));
               {$ELSE}
               tbm.canvas.pixels[ix,iy]:=rgb(0,255,0);
               {$ENDIF}
          end;
          if iy mod 5=0 then
          begin
            {$IFDEF FPC}
            bmp.InvalidateBitmap;
            bmp.Draw(tbm.canvas,0,0,True);
            image1.canvas.draw(0,0,tbm);
            //bmp.Draw(image1.canvas,0,0,True);
            {$ELSE}
            image1.canvas.draw(0,0,tbm);
            {$ENDIF}
            application.processmessages;
          end;
     end;
     {$IFDEF FPC}
     bmp.InvalidateBitmap;
     bmp.Draw(tbm.canvas,0,0,True);
     image1.canvas.draw(0,0,tbm);
     //bmp.Draw(image1.canvas,0,0,True);
     {$ELSE}
     image1.canvas.draw(0,0,tbm);
     {$ENDIF}
     application.processmessages;
     finishms:=gettickcount;
     {$IFDEF FPC}
     bmp.free;
     {$ENDIF}
     showmessage('time taken = '+inttostr(finishms-startms)+' ms');
end;                      

That does it in 624ms compared to Delphi scanline 203ms.  So it seems
your BGRA is fast enough.  By the way, is using setpixel the best
option?  I do want the code to be cross platform in the future.

----------------------------------------------------------------------
circular · 2011-04-15 10:54

No, SetPixel is rather slow.

See here :
http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial_4

----------------------------------------------------------------------
TG · 2011-04-16 05:55

OK, thanks.  Is using that alternative code compatible on linux and
mac?  I just want to be sure I have compatible code when compiling for
them in the future.  I saw something about different bits per color
that could lead to corrupt colors when using the Intfimage.  Does this
apply to the BGRAPixel scanline?

----------------------------------------------------------------------
circular · 2011-04-16 12:44

Nope, it's designed to be cross-platform. When needed, BGRABitmap
swaps itself channels to render it correctly on different systems.

----------------------------------------------------------------------
fabienwang · 2011-04-16 14:16

Quote from: circular on April 15, 2011, 12:54:24 pmNo, SetPixel is
rather slow.

See here :
http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial_4

Wow, i really like this one

----------------------------------------------------------------------
TG · 2011-04-18 00:50

Is there a known issue with using application.processmessages around
BGRABitmap?

If I remark out the application.processmessages in the following code
(almost identical to the BGRABitmap tutorial 4) then it works as
expected and fills the image green.

If I leave it in, only the first line of the bitmap (and image) is a
green line.

Any ideas?  I need to allow the bitmap and image to be updated every
few lines.

This is for a form with a single alclient aligned image and a button.

Code: [Select]procedure TForm1.Button3Click(Sender: TObject);
var ix,iy,ih,iw:integer;
    startms,finishms:int64;
    bitmap:TBGRABitmap;
    p:pbgrapixel;
begin
     startms:=gettickcount;
     iw:=image1.width;
     ih:=image1.height;
     bitmap:=TBGRABitmap.create(iw,ih,bgrablack);
     for iy:=0 to ih-1 do
     begin
          p:=bitmap.scanline[iy];
          for ix:=0 to iw-1 do
          begin
               p^.red:=0;
               p^.green:=255;
               p^.blue:=0;
               p^.alpha:=255;
               inc(p);
          end;
          if iy mod 5=0 then
          begin
               bitmap.InvalidateBitmap;
               bitmap.Draw(image1.canvas,0,0,True);
               application.processmessages;
          end;
     end;
     bitmap.InvalidateBitmap;
     bitmap.Draw(image1.canvas,0,0,True);
     application.processmessages;
     finishms:=gettickcount;
     bitmap.free;
     showmessage('time taken = '+inttostr(finishms-startms)+' ms');
end;

----------------------------------------------------------------------
sasa · 2011-04-18 08:44

Probably you will have access write problem (not tested), depending on
how  memory lock/unlock mechanism is defined on each OS. Simple
solution is to have global variable which will indicate that write is
in progress.

----------------------------------------------------------------------
circular · 2011-04-18 14:20

Quote from: TG on April 18, 2011, 02:50:30 amIs there a known issue
with using application.processmessages around BGRABitmap?
Your problem is not related to BGRABitmap but to TImage. After drawing
on it, you can call image1.Repaint; to show it. A TImage is not
updated each time you draw on it, I suppose it has some timer.
Apparently, sometimes, the timer does not work correctly and at the
end, the image is not updated. But even without this bug, you need to
call Repaint to show the new image exactly when you want.

----------------------------------------------------------------------
Marc · 2011-04-22 13:14

it has no timer, however when a part of your form has to be repainted,
it might trigger a repaint of the image.

----------------------------------------------------------------------
circular · 2011-04-22 14:52

Ok so maybe it calls Invalidate each time the image is modified.

----------------------------------------------------------------------
Marc · 2011-04-23 10:37

Quote from: circular on April 22, 2011, 04:52:52 pmOk so maybe it
calls Invalidate each time the image is modified.
If it is changed through its graphic canvas, then yes. If it is
changed by byte manipulation, then no