{
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);
//-------------------------------------------------------------------------
type
// 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;
//-------------------------------------------------------------------------
procedure 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.
Recent
