Recent

Author Topic: scanline example  (Read 3213 times)

speter

  • Sr. Member
  • ****
  • Posts: 345
scanline example
« on: May 17, 2020, 11:54:20 am »
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][+][-]
  1. {
  2.   This program loads 7 images and then draws them on the form's canvas;
  3.   first using canvas.draw and then secondly using bitmap.scanline.
  4.  
  5.   Stephen Peter.
  6.   2020-05-17
  7.  
  8.   updated:
  9.   2020-05-18
  10.     replaced img.Picture.bitmap.PixelFormat
  11.     with     img.picture.bitmap.RawImage.Description.BitsPerPixel
  12. }
  13. unit main;
  14.  
  15. {$mode objfpc}{$H+}
  16.  
  17. interface
  18.  
  19. uses
  20.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
  21.  
  22. const
  23.   num_pics = 7;
  24. type
  25.  
  26.   { TForm1 }
  27.  
  28.   TForm1 = class(TForm)              // form: width=1105; height=320
  29.     Memo1: TMemo;                    // memo: align=left; width=325
  30.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure FormPaint(Sender: TObject);
  33.   private
  34.     count : integer;
  35.     procedure drawit(a : integer);
  36.   public
  37.     images  : array [1..num_pics] of timage;
  38.     isok : array [1..num_pics] of boolean;
  39.   end;
  40.  
  41. const
  42.   fn : array [1..num_pics] of string =
  43.     ('pic_4.gif', 'pic_8.gif',
  44.      'pic_24.bmp','pic_24.jpg','pic_24.png',
  45.      'pic_32.bmp','pic_32.png');
  46. var
  47.   Form1: TForm1;
  48.  
  49. implementation
  50.  
  51. {$R *.lfm}
  52.  
  53. { TForm1 }
  54.  
  55. //-------------------------------------------------------------------------
  56. procedure TForm1.FormCreate(Sender: TObject);
  57. //-------------------------------------------------------------------------
  58. var
  59.   a : integer;
  60. begin
  61.   for a := 1 to num_pics do
  62.     if fileexists(fn[a]) then
  63.       begin
  64.         isok[a] := false;
  65.         images[a] := timage.create(form1);
  66.         images[a].visible := false;
  67.         try
  68.           images[a].picture.LoadFromFile(fn[a]);
  69.           isok[a] := true;
  70.         except
  71.           memo1.lines.add('There was a problem with image #'+a.tostring+' ('+fn[a]+').');
  72.         end
  73.       end
  74.     else
  75.       memo1.lines.add('Image #'+a.tostring+' was NOT found ('+fn[a]+').');
  76. end;
  77.  
  78. //-------------------------------------------------------------------------
  79. procedure TForm1.drawit(a : integer);
  80. //-------------------------------------------------------------------------
  81. type
  82.   // 24 bit image types
  83.   Trgb24 = packed record
  84.     b,g,r : byte;
  85.   end;
  86.   Trgb24scanline = array [word] of Trgb24;
  87.   Prgb24scanline = ^Trgb24scanline;
  88.  
  89.   // 32 bit image types
  90.   Trgb32 = packed record
  91.     b,g,r,a: byte;
  92.   end;
  93.   Trgb32scanline = packed array[word] of Trgb32;
  94.   Prgb32scanline = ^Trgb32scanline;
  95. var
  96.   xpos, x,y, bitsperpx : integer;
  97.   img : timage;
  98.   bitmap : tbitmap;
  99.   source24bit : Prgb24scanline;
  100.   source32bit : Prgb32scanline;
  101.   dest24bit   : Prgb24scanline;
  102. begin
  103.   xpos := memo1.width + 10 + count*110;
  104.   img := images[a];
  105.  
  106.   // draw the piccy
  107.   canvas.draw(xpos,10,img.picture.bitmap);
  108.  
  109.   // draw the file-name
  110.   canvas.Brush.color := cldefault;
  111.   canvas.TextOut(xpos,112,'('+a.tostring+') '+fn[a]);
  112.  
  113.   // draw the pixel format
  114.   bitsperpx := img.picture.bitmap.RawImage.Description.BitsPerPixel;
  115.   canvas.TextOut(xpos,133,bitsperpx.tostring);
  116.  
  117.   // draw the piccy using scanline
  118.   bitmap := tbitmap.create;
  119.   try
  120.     bitmap.width  := 100;
  121.     bitmap.height := 100;
  122.     bitmap.PixelFormat := pf24bit;
  123.  
  124.     for y := 0 to bitmap.height-1 do
  125.       begin
  126.         dest24bit := bitmap.scanline[y];
  127.  
  128.         if bitsperpx = 24 then
  129.           begin
  130.             source24bit := img.picture.bitmap.scanline[y];
  131.             for x := 0 to bitmap.width-1 do
  132.               begin
  133.                 // copy the pixel
  134.                 dest24bit^[x] := source24bit^[x];
  135.                 { could alternatively assign each colour byte
  136.                 dest24bit^[x].r := source24bit^[x].r;
  137.                 dest24bit^[x].g := source24bit^[x].g;
  138.                 dest24bit^[x].b := source24bit^[x].b;}
  139.               end;
  140.           end
  141.         else if bitsperpx = 32 then
  142.           begin
  143.             source32bit := img.picture.bitmap.scanline[y];
  144.             for x := 0 to bitmap.width-1 do
  145.               begin
  146.                 // copy the pixel (colours)
  147.                 dest24bit^[x].r := source32bit^[x].r;
  148.                 dest24bit^[x].g := source32bit^[x].g;
  149.                 dest24bit^[x].b := source32bit^[x].b;
  150.               end;
  151.           end;
  152.       end;
  153.     canvas.draw(xpos,170,bitmap);
  154.     canvas.TextOut(xpos,272,'^made using');
  155.     canvas.TextOut(xpos,293,'  scanline');
  156.   finally
  157.     bitmap.free;
  158.   end;
  159.  
  160.   inc(count);
  161. end;
  162.  
  163. //-------------------------------------------------------------------------
  164. procedure TForm1.FormPaint(Sender: TObject);
  165. //-------------------------------------------------------------------------
  166. var
  167.   a : integer;
  168. begin
  169.   count := 0;
  170.   for a := 1 to num_pics do
  171.     if isok[a] then
  172.       drawit(a);
  173. end;
  174.  
  175. //-------------------------------------------------------------------------
  176. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  177. //-------------------------------------------------------------------------
  178. var
  179.   a : integer;
  180. begin
  181.   for a := 1 to num_pics do
  182.     images[a].free;
  183. end;
  184.  
  185. end.

Edit:
2020-05-18, new version of code; replaced ZIP file with new version.
« Last Edit: May 18, 2020, 02:07:53 am by speter »
I climbed mighty mountains, and saw that they were actually tiny foothills. :)

wp

  • Hero Member
  • *****
  • Posts: 11855
Re: scanline example
« Reply #1 on: May 17, 2020, 12:50:30 pm »
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

  • Hero Member
  • *****
  • Posts: 5130
  • My goal: build my own game engine using Lazarus
Re: scanline example
« Reply #2 on: May 17, 2020, 12:58:04 pm »

circular

  • Hero Member
  • *****
  • Posts: 4195
    • Personal webpage
Re: scanline example
« Reply #3 on: May 17, 2020, 03:10:39 pm »
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.html#msg300308
Conscience is the debugger of the mind

Handoko

  • Hero Member
  • *****
  • Posts: 5130
  • My goal: build my own game engine using Lazarus
Re: scanline example
« Reply #4 on: May 17, 2020, 03:55:39 pm »
Oops, I missed that post.
Thank you.

speter

  • Sr. Member
  • ****
  • Posts: 345
Re: scanline example
« Reply #5 on: May 18, 2020, 01:21:16 am »
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][+][-]
  1. {
  2. This program gives a simple example of using bitmap.scanline in Lazarus to draw
  3. graphics. It uses a 24bit image (and will not work with other image depths).
  4.  
  5. Stephen Peter, 2020-05-17.
  6. }
  7. unit example2;
  8.  
  9. {$mode objfpc}{$H+}
  10.  
  11. interface
  12.  
  13. uses
  14.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  15.   ComCtrls, ExtCtrls;
  16.  
  17. type
  18.  
  19.   { TForm1 }
  20.  
  21.   TForm1 = class(TForm)             // W=314; H=120; onpaint=formpaint
  22.     Label1: TLabel;                 // L=0; T=0; cap='Opacity'
  23.     opacityTrackBar: TTrackBar;     // min=0; max=10; onchange=formpaint
  24.     opacityPanel: TPanel;           // L=0; T=26; W=84; H=31
  25.     procedure FormPaint(Sender: TObject);
  26.   private
  27.  
  28.   public
  29.  
  30.   end;
  31.  
  32. var
  33.   Form1: TForm1;
  34.  
  35. implementation
  36.  
  37. {$R *.lfm}
  38.  
  39. { TForm1 }
  40.  
  41. //-------------------------------------------------------------------------
  42. procedure TForm1.FormPaint(Sender: TObject);
  43. //-------------------------------------------------------------------------
  44. type
  45.   Trgb24 = packed record
  46.     b,g,r : byte;
  47.   end;
  48.   Trgb24scanline = array [word] of Trgb24;
  49.   Prgb24scanline = ^Trgb24scanline;
  50. const
  51.   q_colours : array [0..3] of Trgb24 = (
  52.     (b:150; g:150; r:255),
  53.     (b:150; g:255; r:150),
  54.     (b:255; g:150; r:150),
  55.     (b:250; g:250; r:250) );
  56. var
  57.   x,y : Integer;
  58.   source_bitmap, output_bitmap : Tbitmap;
  59.   source_scanline, output_scanline : Prgb24scanline;
  60.   q : byte;
  61.   opacity : single;
  62. begin
  63.   source_bitmap := Tbitmap.create;
  64.   output_bitmap := Tbitmap.create;
  65.   try
  66.     source_bitmap.LoadFromFile('pic.bmp'); // 100x100px 24bit image
  67.  
  68.     //--- draw source_bitmap
  69.     Canvas.Draw(94,10, source_bitmap);
  70.  
  71.     //--- create output_bitmap
  72.     output_bitmap.PixelFormat := pf24bit;
  73.     output_bitmap.Width  := source_bitmap.Width;
  74.     output_bitmap.Height := source_bitmap.Height;
  75.     opacity := (opacityTrackBar.position/opacityTrackBar.max); // 0..1 higher is more opaque
  76.     for y := 0 to source_bitmap.Height - 1 do
  77.       begin
  78.         source_scanline := source_bitmap.ScanLine[y];
  79.         output_scanline := output_bitmap.ScanLine[y];
  80.         for x := 0 to source_bitmap.Width - 1 do
  81.           if (y >= 10) and (y < source_bitmap.height-10) and
  82.              (x >= 10) and (x < source_bitmap.width-10) then
  83.             begin
  84.               q := 2*ord(y > source_bitmap.height div 2) + ord(x > source_bitmap.width div 2);
  85.               output_scanline^[x].b := round(opacity*q_colours[q].b + (1-opacity)*source_scanline^[x].b);
  86.               output_scanline^[x].g := round(opacity*q_colours[q].g + (1-opacity)*source_scanline^[x].g);
  87.               output_scanline^[x].r := round(opacity*q_colours[q].r + (1-opacity)*source_scanline^[x].r);
  88.             end
  89.           else
  90.             begin
  91.               output_scanline^[x].b := source_scanline^[x].b;
  92.               output_scanline^[x].g := source_scanline^[x].g;
  93.               output_scanline^[x].r := source_scanline^[x].r;
  94.             end;
  95.       end;
  96.  
  97.     //--- draw picture (with transparency)
  98.     Canvas.Draw(204,10, output_bitmap);
  99.  
  100.   finally
  101.     source_bitmap.Free;
  102.     output_bitmap.free;
  103.   end;
  104. end;
  105.  
  106. end.
  107.  
I climbed mighty mountains, and saw that they were actually tiny foothills. :)

speter

  • Sr. Member
  • ****
  • Posts: 345
Re: scanline example
« Reply #6 on: March 18, 2024, 01:18:13 am »
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).

I climbed mighty mountains, and saw that they were actually tiny foothills. :)

speter

  • Sr. Member
  • ****
  • Posts: 345
Re: scanline example
« Reply #7 on: March 18, 2024, 01:39:11 am »
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.
I climbed mighty mountains, and saw that they were actually tiny foothills. :)

wp

  • Hero Member
  • *****
  • Posts: 11855
Re: scanline example
« Reply #8 on: March 18, 2024, 02:04:18 pm »
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][+][-]
  1. uses
  2.   ... FPImage, IntfGraphics;
  3.  
  4. procedure TForm1.PaintBox1Paint(Sender: TObject);
  5. const
  6.   q_colours : array [0..3] of TFPColor = (
  7.     (Red:255 shl 8; Green:150 shl 8; Blue:150 shl 8; Alpha:$FFFF),
  8.     (Red:150 shl 8; Green:255 shl 8; Blue:150 shl 8; Alpha:$FFFF),
  9.     (Red:150 shl 8; Green:150 shl 8; Blue:255 shl 8; Alpha:$FFFF),
  10.     (Red:250 shl 8; Green:250 shl 8; Blue:250 shl 8; Alpha:$FFFF)
  11.   );
  12. var
  13.   img: TLazIntfImage;
  14.   bmp: TBitmap;
  15.   s: String;
  16.   x, y, i: Integer;
  17.   q: Byte;
  18.   opacity: Single;
  19.   c: TFPColor;
  20. begin
  21.   bmp := TBitmap.Create;
  22.   try
  23.     bmp.LoadFromFile(Application.Location + 'pic.bmp');
  24.     Paintbox1.Canvas.Draw(5, 10, bmp);
  25.  
  26.     opacity := opacityTrackBar.position/opacityTrackBar.max; // 0..1, higher is more opaque
  27.  
  28.     img := bmp.CreateIntfImage;
  29.     for y := 10 to img.Height-10 do
  30.       for x := 10 to img.Width-10 do
  31.       begin
  32.         q := 2*ord(y > img.height div 2) + ord(x > img.width div 2);
  33.         c := img.Colors[x, y];
  34.         c.Alpha := alphaOpaque;
  35.         c.Red   := round(opacity * q_colours[q].Red   + (1.0- opacity) * c.Red);
  36.         c.Green := round(opacity * q_colours[q].Green + (1.0- opacity) * c.Green);
  37.         c.Blue  := round(opacity * q_colours[q].Blue  + (1.0- opacity) * c.Blue);
  38.         img.Colors[x, y] := c;
  39.       end;
  40.  
  41.     bmp.LoadFromIntfImage(img);
  42.     Paintbox1.Canvas.Draw(115, 10, bmp);
  43.   finally
  44.     img.Free;
  45.     bmp.Free;
  46.   end;
  47. end;  

And here is an even more compact version which applies the AlphaBlend function in the FPImage unit:
Code: Pascal  [Select][+][-]
  1. uses
  2.   ... FPImage, IntfGraphics;
  3.  
  4. procedure TForm1.PaintBox1Paint(Sender: TObject);
  5. const
  6.   q_colours : array [0..3] of TFPColor = (
  7.     (Red:255 shl 8; Green:150 shl 8; Blue:150 shl 8; Alpha:$FFFF),
  8.     (Red:150 shl 8; Green:255 shl 8; Blue:150 shl 8; Alpha:$FFFF),
  9.     (Red:150 shl 8; Green:150 shl 8; Blue:255 shl 8; Alpha:$FFFF),
  10.     (Red:250 shl 8; Green:250 shl 8; Blue:250 shl 8; Alpha:$FFFF)
  11.   );
  12. var
  13.   img: TLazIntfImage;
  14.   bmp: TBitmap;
  15.   s: String;
  16.   x, y, i: Integer;
  17.   q: Byte;
  18.   opacity: word;
  19.   c: TFPColor;
  20. begin
  21.   bmp := TBitmap.Create;
  22.   try
  23.     bmp.LoadFromFile(Application.Location + 'pic.bmp');
  24.     Paintbox1.Canvas.Draw(5, 10, bmp);
  25.  
  26.     opacity := round(opacityTrackBar.position/opacityTrackBar.max*$FFFF); // 0..1, higher is more opaque
  27.     for i := 0 to High(q_colours) do
  28.       q_colours[i].Alpha := opacity;
  29.  
  30.     img := bmp.CreateIntfImage;
  31.  
  32.     for y := 10 to img.Height-10 do
  33.       for x := 10 to img.Width-10 do
  34.       begin
  35.         q := 2*ord(y > img.height div 2) + ord(x > img.width div 2);
  36.         img.Colors[x, y] := FPImage.AlphaBlend(img.Colors[x, y], q_colours[q]);
  37.       end;
  38.  
  39.     bmp.LoadFromIntfImage(img);
  40.     Paintbox1.Canvas.Draw(115, 10, bmp);
  41.   finally
  42.     img.Free;
  43.     bmp.Free;
  44.   end;
  45. 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][+][-]
  1. uses
  2.   ... FPImage, FPCanvas, IntfGraphics, LazCanvas;
  3.  
  4. procedure TForm1.PaintBox1Paint(Sender: TObject);
  5. var
  6.   bmp: TBitmap;
  7.   img: TLazIntfImage;
  8.   canv: TLazCanvas;
  9.   opacity: Word;
  10. begin
  11.   bmp := TBitmap.Create;
  12.   try
  13.     bmp.LoadFromFile(Application.Location + 'pic.bmp');
  14.     Paintbox1.Canvas.Draw(5, 10, bmp);
  15.  
  16.     opacity := round(opacityTrackBar.Position/opacityTrackbar.Max*$FFFF);
  17.  
  18.     img := bmp.CreateIntfImage;
  19.     try
  20.       canv := TLazCanvas.Create(img);
  21.       try
  22.         canv.DrawingMode := dmAlphaBlend;
  23.  
  24.         canv.Brush.FPColor := FPColor(255 shl 8, 150 shl 8, 150 shl 8, opacity);
  25.         canv.FillRect(10, 10, img.Width div 2, img.Height div 2);
  26.  
  27.         canv.Brush.FPColor := FPColor(150 shl 8, 255 shl 8, 150 shl 8, opacity);
  28.         canv.FillRect(img.Width div 2, 10, img.Width - 10, img.Height div 2);
  29.  
  30.         canv.Brush.FPColor := FPColor(150 shl 8, 150 shl 8, 255 shl 8, opacity);
  31.         canv.FillRect(10, img.Height div 2, img.Width div 2, img.Height-10);
  32.  
  33.         canv.Brush.FPColor := FPColor(250 shl 8, 250 shl 8, 250 shl 8, opacity);
  34.         canv.FillRect(img.Width div 2, img.Height div 2, img.Width -10, img.Height-10);
  35.       finally
  36.         canv.Free;
  37.       end;
  38.       bmp.LoadFromIntfImage(img);
  39.       Paintbox1.Canvas.Draw(115, 10, bmp);
  40.     finally
  41.       img.Free;
  42.     end;
  43.   finally
  44.     bmp.Free;
  45.   end;
  46. end;  

« Last Edit: March 18, 2024, 05:26:47 pm by wp »

speter

  • Sr. Member
  • ****
  • Posts: 345
Re: scanline example
« Reply #9 on: March 19, 2024, 12:12:12 am »
Thanks very much for your reply WP! Lots of food for (re)thinking. :)

Why 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.
I climbed mighty mountains, and saw that they were actually tiny foothills. :)

 

TinyPortal © 2005-2018