TLazIntfImage as an alternative to scanline

[TG]

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.lazarus.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,strutils,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]

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]

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]

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

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

[TG]

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]

No, SetPixel is rather slow.

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

[TG]

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]

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

[fabienwang]

No, SetPixel is rather slow.

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

Wow, i really like this one

[TG]

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]

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]

Is 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]

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

[circular]

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

[Marc]

Ok 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