scanline example
lazarus / 39-Graphics

----------------------------------------------------------------------
speter · 2020-05-17 09:54

G'Day Folks,

Over the past couple of days I've been looking at bitmap.scanline.
I didn't find many lazarus specific examples of drawing with scanline,
so I've included below a simple example.
The attachment is a ZIP file with the project files and the 7 small
images.
If you couldn't be bothered grabbing the zip, the source below is
probably all you need.

The images are each 100x100px in various image formats and colour
depths.
6 of the 7 images are drawn correctly (a 24bit PNG image doesn't draw
correctly).
If anyone has any suggestions for improving the example, please post.

There is an image of the program window at:
https://i.imgur.com/K2LJzKn.jpg (1126x365px).

 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 {  This
program loads 7 images and then draws them on the form's canvas; 
first using canvas.draw and then secondly using bitmap.scanline.  
Stephen Peter.  2020-05-17   updated:  2020-05-18    replaced
img.Picture.bitmap.PixelFormat    with    
img.picture.bitmap.RawImage.Description.BitsPerPixel}unit main; {$mode
objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls,
Graphics, Dialogs, ExtCtrls, StdCtrls; const  num_pics = 7;type   {
TForm1 }   TForm1 = class(TForm)              // form: width=1105;
height=320    Memo1: TMemo;                    // memo: align=left;
width=325    procedure FormClose(Sender: TObject; var CloseAction:
TCloseAction);    procedure FormCreate(Sender: TObject);    procedure
FormPaint(Sender: TObject);  private    count : integer;    procedure
drawit(a : integer);  public    images  : array [1..num_pics] of
timage;    isok : array [1..num_pics] of boolean;  end; const  fn :
array [1..num_pics] of string =    ('pic_4.gif', 'pic_8.gif',   
 'pic_24.bmp','pic_24.jpg','pic_24.png',   
 'pic_32.bmp','pic_32.png');var  Form1: TForm1; implementation {$R
*.lfm} { TForm1 } //--------------------------------------------------
-----------------------procedure TForm1.FormCreate(Sender: TObject);//
----------------------------------------------------------------------
---var  a : integer;begin  for a := 1 to num_pics do    if
fileexists(fn[a]) then      begin        isok[a] := false;       
images[a] := timage.create(form1);        images[a].visible := false; 
      try          images[a].picture.LoadFromFile(fn[a]);         
isok[a] := true;        except          memo1.lines.add('There was a
problem with image #'+a.tostring+' ('+fn[a]+').');        end     
end    else      memo1.lines.add('Image #'+a.tostring+' was NOT found
('+fn[a]+').');end; //------------------------------------------------
-------------------------procedure TForm1.drawit(a : integer);//------
-------------------------------------------------------------------typ
e  // 24 bit image types  Trgb24 = packed record    b,g,r : byte; 
end;  Trgb24scanline = array [word] of Trgb24;  Prgb24scanline =
^Trgb24scanline;   // 32 bit image types  Trgb32 = packed record   
b,g,r,a: byte;  end;  Trgb32scanline = packed array[word] of Trgb32; 
Prgb32scanline = ^Trgb32scanline;var  xpos, x,y, bitsperpx : integer; 
img : timage;  bitmap : tbitmap;  source24bit : Prgb24scanline; 
source32bit : Prgb32scanline;  dest24bit   : Prgb24scanline;begin 
xpos := memo1.width + 10 + count*110;  img := images[a];   // draw the
piccy  canvas.draw(xpos,10,img.picture.bitmap);   // draw the file-
name  canvas.Brush.color := cldefault; 
canvas.TextOut(xpos,112,'('+a.tostring+') '+fn[a]);   // draw the
pixel format  bitsperpx :=
img.picture.bitmap.RawImage.Description.BitsPerPixel; 
canvas.TextOut(xpos,133,bitsperpx.tostring);   // draw the piccy using
scanline  bitmap := tbitmap.create;  try    bitmap.width  := 100;   
bitmap.height := 100;    bitmap.PixelFormat := pf24bit;     for y := 0
to bitmap.height-1 do      begin        dest24bit :=
bitmap.scanline[y];         if bitsperpx = 24 then          begin    
      source24bit := img.picture.bitmap.scanline[y];            for x
:= 0 to bitmap.width-1 do              begin                // copy
the pixel                dest24bit^[x] := source24bit^[x];           
   { could alternatively assign each colour byte               
dest24bit^[x].r := source24bit^[x].r;                dest24bit^[x].g
:= source24bit^[x].g;                dest24bit^[x].b :=
source24bit^[x].b;}              end;          end        else if
bitsperpx = 32 then          begin            source32bit :=
img.picture.bitmap.scanline[y];            for x := 0 to
bitmap.width-1 do              begin                // copy the pixel
(colours)                dest24bit^[x].r := source32bit^[x].r;       
       dest24bit^[x].g := source32bit^[x].g;               
dest24bit^[x].b := source32bit^[x].b;              end;          end; 
    end;    canvas.draw(xpos,170,bitmap);   
canvas.TextOut(xpos,272,'^made using');    canvas.TextOut(xpos,293,'
 scanline');  finally    bitmap.free;  end;   inc(count);end; //------
-------------------------------------------------------------------pro
cedure TForm1.FormPaint(Sender: TObject);//---------------------------
----------------------------------------------var  a : integer;begin 
count := 0;  for a := 1 to num_pics do    if isok[a] then      drawit(
a);end; //------------------------------------------------------------
-------------procedure TForm1.FormClose(Sender: TObject; var
CloseAction: TCloseAction);//-----------------------------------------
--------------------------------var  a : integer;begin  for a := 1 to
num_pics do    images[a].free;end; end.
Edit:
2020-05-18, new version of code; replaced ZIP file with new version.

----------------------------------------------------------------------
wp · 2020-05-17 10:50

Maybe this is a bug, maybe this is specification of png, I don't know.
But when you look at
Images[a].Picture.Bitmap.RawImage.Description.BitsPerPixel you'll see
that the png image #5 has 32 bits per pixel although its PixelFormat
is reported as pf24bit. So, when you replace the checks for
PixelFormat in the y loop by checks for
img.Picture.Bitmap.RawImage.Description.BitsPerPixel the program will
work correctly.

It always has been said that ScanLine is not portable, I don't know if
this is still true since it is working on Linux in addition to Windows
(did not check Mac).

----------------------------------------------------------------------
Handoko · 2020-05-17 10:58

I had similar issue, still unsolved:
https://forum.lazarus.freepascal.org/index.php/topic,37242.msg252828.h
tml#msg252828

----------------------------------------------------------------------
circular · 2020-05-17 13:10

As explained there, PixelFormat is not reliable. You can use the
information about the raw image though:
https://forum.lazarus.freepascal.org/index.php/topic,43001.msg300308.h
tml#msg300308

----------------------------------------------------------------------
Handoko · 2020-05-17 13:55

Oops, I missed that post.
Thank you.

----------------------------------------------------------------------
speter · 2020-05-17 23:21

Here is a second scanline example, this one showing "transparency"
effects.

The attached ZIP file includes the project files (including the
100x100px image).

A image of the app is at:
https://i.imgur.com/dQhO4I6.jpg (322x153px)

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 {This
program gives a simple example of using bitmap.scanline in Lazarus to
drawgraphics. It uses a 24bit image (and will not work with other
image depths). Stephen Peter, 2020-05-17.}unit example2; {$mode
objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls,
Graphics, Dialogs, StdCtrls,  ComCtrls, ExtCtrls; type   { TForm1 }  
TForm1 = class(TForm)             // W=314; H=120; onpaint=formpaint 
 Label1: TLabel;                 // L=0; T=0; cap='Opacity'   
opacityTrackBar: TTrackBar;     // min=0; max=10; onchange=formpaint 
 opacityPanel: TPanel;           // L=0; T=26; W=84; H=31    procedure
FormPaint(Sender: TObject);  private   public   end; var  Form1:
TForm1; implementation {$R *.lfm} { TForm1 } //-----------------------
--------------------------------------------------procedure
TForm1.FormPaint(Sender: TObject);//----------------------------------
---------------------------------------type  Trgb24 = packed record  
b,g,r : byte;  end;  Trgb24scanline = array [word] of Trgb24; 
Prgb24scanline = ^Trgb24scanline;const  q_colours : array [0..3] of
Trgb24 = (    (b:150; g:150; r:255),    (b:150; g:255; r:150),   
(b:255; g:150; r:150),    (b:250; g:250; r:250) );var  x,y : Integer; 
source_bitmap, output_bitmap : Tbitmap;  source_scanline,
output_scanline : Prgb24scanline;  q : byte;  opacity : single;begin 
source_bitmap := Tbitmap.create;  output_bitmap := Tbitmap.create; 
try    source_bitmap.LoadFromFile('pic.bmp'); // 100x100px 24bit
image     //--- draw source_bitmap    Canvas.Draw(94,10,
source_bitmap);     //--- create output_bitmap   
output_bitmap.PixelFormat := pf24bit;    output_bitmap.Width  :=
source_bitmap.Width;    output_bitmap.Height := source_bitmap.Height; 
  opacity := (opacityTrackBar.position/opacityTrackBar.max); // 0..1
higher is more opaque    for y := 0 to source_bitmap.Height - 1 do   
 begin        source_scanline := source_bitmap.ScanLine[y];       
output_scanline := output_bitmap.ScanLine[y];        for x := 0 to
source_bitmap.Width - 1 do          if (y >= 10) and (y <
source_bitmap.height-10) and             (x >= 10) and (x <
source_bitmap.width-10) then            begin              q :=
2*ord(y > source_bitmap.height div 2) + ord(x > source_bitmap.width
div 2);              output_scanline^[x].b :=
round(opacity*q_colours[q].b + (1-opacity)*source_scanline^[x].b);   
         output_scanline^[x].g := round(opacity*q_colours[q].g +
(1-opacity)*source_scanline^[x].g);              output_scanline^[x].r
:= round(opacity*q_colours[q].r + (1-opacity)*source_scanline^[x].r); 
          end          else            begin             
output_scanline^[x].b := source_scanline^[x].b;             
output_scanline^[x].g := source_scanline^[x].g;             
output_scanline^[x].r := source_scanline^[x].r;            end;     
end;     //--- draw picture (with transparency)    Canvas.Draw(204,10,
output_bitmap);   finally    source_bitmap.Free;   
output_bitmap.free;  end;end; end.

----------------------------------------------------------------------
speter · 2024-03-18 00:18

A couple of years ago I posted the projects above.

I have made a few slight tweaks to the second project and am re-
posting it.

I believe (from WP's earlier comments) that it works in Linux;
I know it works in Windows (11);
but does it work with MacOS?

Can some please have a look and let me know, please.

The program creates a small form with a trackbar, you should be able
to slide the trackbar's marker and the "image" on the right will be
redrawn with more or less opacity of the overlaid grid.

cheers
S.

PS: I didn't add "pic.bmp" to the project's zip, so I've attached it
separately, it should be in the same folder as the exe (or you'll
probably need to change the code).

----------------------------------------------------------------------
speter · 2024-03-18 00:39

This is a slightly simplified example, the source image "pic.bmp" is
placed on the form (so you don't need to download it and the program
doesn't load it from file); and the paint procedure only has to paint
the second graphic.

cheers
S.

----------------------------------------------------------------------
wp · 2024-03-18 13:04

Why did you call your code in the Form's OnPaint when the same method
exists for TPaintBox as well?

I tried the 1st project on a mac in a vm and found that the blended
image is not correct. This is because mac seems to interpret the
pixels as 32 bit although the PixelFormat is reported as pf24Bit. It
is really not recommended to rely on Pixelformat when ScanLine is
supposed to be used.

Rather than ScanLine I usually use LazIntfImage for accessing pixels
which correctly handles the various pixelformat issues correctly. Here
is a modified version of your code which works on Mac as well as on
Windows (did not test Linux, but should work there, too):

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 uses  ...
FPImage, IntfGraphics; procedure TForm1.PaintBox1Paint(Sender:
TObject);const  q_colours : array [0..3] of TFPColor = (    (Red:255
shl 8; Green:150 shl 8; Blue:150 shl 8; Alpha:$FFFF),    (Red:150 shl
8; Green:255 shl 8; Blue:150 shl 8; Alpha:$FFFF),    (Red:150 shl 8;
Green:150 shl 8; Blue:255 shl 8; Alpha:$FFFF),    (Red:250 shl 8;
Green:250 shl 8; Blue:250 shl 8; Alpha:$FFFF)  );var  img:
TLazIntfImage;  bmp: TBitmap;  s: String;  x, y, i: Integer;  q:
Byte;  opacity: Single;  c: TFPColor;begin  bmp := TBitmap.Create; 
try    bmp.LoadFromFile(Application.Location + 'pic.bmp');   
Paintbox1.Canvas.Draw(5, 10, bmp);     opacity :=
opacityTrackBar.position/opacityTrackBar.max; // 0..1, higher is more
opaque     img := bmp.CreateIntfImage;    for y := 10 to img.Height-10
do      for x := 10 to img.Width-10 do      begin        q := 2*ord(y
> img.height div 2) + ord(x > img.width div 2);        c :=
img.Colors[x, y];        c.Alpha := alphaOpaque;        c.Red   :=
round(opacity * q_colours[q].Red   + (1.0- opacity) * c.Red);       
c.Green := round(opacity * q_colours[q].Green + (1.0- opacity) *
c.Green);        c.Blue  := round(opacity * q_colours[q].Blue  + (1.0-
opacity) * c.Blue);        img.Colors[x, y] := c;      end;    
bmp.LoadFromIntfImage(img);    Paintbox1.Canvas.Draw(115, 10, bmp); 
finally    img.Free;    bmp.Free;  end;end;  
And here is an even more compact version which applies the AlphaBlend
function in the FPImage unit:
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 uses  ...
FPImage, IntfGraphics; procedure TForm1.PaintBox1Paint(Sender:
TObject);const  q_colours : array [0..3] of TFPColor = (    (Red:255
shl 8; Green:150 shl 8; Blue:150 shl 8; Alpha:$FFFF),    (Red:150 shl
8; Green:255 shl 8; Blue:150 shl 8; Alpha:$FFFF),    (Red:150 shl 8;
Green:150 shl 8; Blue:255 shl 8; Alpha:$FFFF),    (Red:250 shl 8;
Green:250 shl 8; Blue:250 shl 8; Alpha:$FFFF)  );var  img:
TLazIntfImage;  bmp: TBitmap;  s: String;  x, y, i: Integer;  q:
Byte;  opacity: word;  c: TFPColor;begin  bmp := TBitmap.Create;  try 
  bmp.LoadFromFile(Application.Location + 'pic.bmp');   
Paintbox1.Canvas.Draw(5, 10, bmp);     opacity :=
round(opacityTrackBar.position/opacityTrackBar.max*$FFFF); // 0..1,
higher is more opaque    for i := 0 to High(q_colours) do     
q_colours[i].Alpha := opacity;     img := bmp.CreateIntfImage;     for
y := 10 to img.Height-10 do      for x := 10 to img.Width-10 do     
begin        q := 2*ord(y > img.height div 2) + ord(x > img.width div
2);        img.Colors[x, y] := FPImage.AlphaBlend(img.Colors[x, y],
q_colours[q]);      end;     bmp.LoadFromIntfImage(img);   
Paintbox1.Canvas.Draw(115, 10, bmp);  finally    img.Free;   
bmp.Free;  end;end;
Painting colored boxes over image, finally can also be done in a more
standard way by painting a rectangle on a canvas. Use a TLazCanvas
which nicely cooperates with FPImage.
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 uses  ...
FPImage, FPCanvas, IntfGraphics, LazCanvas; procedure
TForm1.PaintBox1Paint(Sender: TObject);var  bmp: TBitmap;  img:
TLazIntfImage;  canv: TLazCanvas;  opacity: Word;begin  bmp :=
TBitmap.Create;  try    bmp.LoadFromFile(Application.Location +
'pic.bmp');    Paintbox1.Canvas.Draw(5, 10, bmp);     opacity :=
round(opacityTrackBar.Position/opacityTrackbar.Max*$FFFF);     img :=
bmp.CreateIntfImage;    try      canv := TLazCanvas.Create(img);     
try        canv.DrawingMode := dmAlphaBlend;        
canv.Brush.FPColor := FPColor(255 shl 8, 150 shl 8, 150 shl 8,
opacity);        canv.FillRect(10, 10, img.Width div 2, img.Height div
2);         canv.Brush.FPColor := FPColor(150 shl 8, 255 shl 8, 150
shl 8, opacity);        canv.FillRect(img.Width div 2, 10, img.Width -
10, img.Height div 2);         canv.Brush.FPColor := FPColor(150 shl
8, 150 shl 8, 255 shl 8, opacity);        canv.FillRect(10, img.Height
div 2, img.Width div 2, img.Height-10);         canv.Brush.FPColor :=
FPColor(250 shl 8, 250 shl 8, 250 shl 8, opacity);       
canv.FillRect(img.Width div 2, img.Height div 2, img.Width -10,
img.Height-10);      finally        canv.Free;      end;     
bmp.LoadFromIntfImage(img);      Paintbox1.Canvas.Draw(115, 10, bmp); 
  finally      img.Free;    end;  finally    bmp.Free;  end;end;

----------------------------------------------------------------------
speter · 2024-03-18 23:12

Thanks very much for your reply WP! Lots of food for (re)thinking.

Quote from: wp on March 18, 2024, 02:04:18 pmWhy did you call your
code in the Form's OnPaint when the same method exists for TPaintBox
as well?Yes, I was just being lazy (the 2020 version used
form.onpaint).

cheers
S.