BGRA Graphic Speed Test
lazarus / 39-Graphics

----------------------------------------------------------------------
Gigatron · 2025-04-07 23:41

Hi,
If you know Sysspeed Amiga from Alien Design to test some
gfx/mem/cpu/fpu speed.

I made a similar little program with lazarus FPC to test BGRA graphic
speed , you can test it on your machine;
Hope the values are correct !

Good Luck !


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 unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, ExtCtrls, ComCtrls, StdCtrls,  BGRABitmap,
BGRABitmapTypes, BGRAVirtualScreen; const  MaxTests = 10; // Nombre
total de test 0-9 type   { TForm1 }   TForm1 = class(TForm)   
BGRAVirtualScreen1: TBGRAVirtualScreen;    Button1: TButton;    Memo1:
TMemo;    Timer1: TTimer;    procedure
BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);   
procedure Button1Click(Sender: TObject);    procedure
FormCreate(Sender: TObject);    procedure FormDestroy(Sender:
TObject);    procedure Timer1Timer(Sender: TObject);  private    
procedure DrawScene1(Bm: TBGRABitmap);    procedure DrawScene2(Bm:
TBGRABitmap);    procedure DrawScene3(Bm: TBGRABitmap);    procedure
DrawScene4(Bm: TBGRABitmap);    procedure DrawScene5(Bm:
TBGRABitmap);    procedure DrawScene6(Bm: TBGRABitmap);    procedure
DrawScene7(Bm: TBGRABitmap);    procedure DrawScene8(Bm:
TBGRABitmap);    procedure DrawScene9(Bm: TBGRABitmap);    procedure
DrawScene10(Bm: TBGRABitmap);   end; var  Form1: TForm1;  Test :
Integer;  TestElapsed: Integer;  LinesDrawn: Integer;  BenchElapsed:
Integer; implementation {$R *.lfm} procedure TForm1.FormCreate(Sender:
TObject);begin  Randomize;  Test := -1;  TestElapsed := 0;  LinesDrawn
:= 0;  BenchElapsed := 0;   Timer1.Interval := 5;  Timer1.Enabled :=
False; end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject;
Bitmap: TBGRABitmap);begin  case Test of    0: DrawScene1(Bitmap);   
1: DrawScene2(Bitmap);    2: DrawScene3(Bitmap);    3:
DrawScene4(Bitmap);    4: DrawScene5(Bitmap);    5:
DrawScene6(Bitmap);    6: DrawScene7(Bitmap);    7:
DrawScene8(Bitmap);    8: DrawScene9(Bitmap);    9:
DrawScene10(Bitmap);   end; end; procedure TForm1.Button1Click(Sender:
TObject);begin  Memo1.Clear;  Test := 0;  TestElapsed := 0; 
BenchElapsed := 0;  LinesDrawn := 0;  Timer1.Enabled := True; 
BGRAVirtualScreen1.OnRedraw := @BGRAVirtualScreen1Redraw;end; // rnd
linesprocedure TForm1.DrawScene1(Bm: TBGRABitmap);var  T0: QWord;  x1,
y1, x2, y2: Integer;begin  Bm.Fill(BGRA(0, 0, 0));   T0 :=
GetTickCount64;  while (GetTickCount64 - T0 < 5) do  begin    x1 :=
Random(Bm.Width);    y1 := Random(Bm.Height);    x2 :=
Random(Bm.Width);    y2 := Random(Bm.Height);    Bm.DrawLine(x1, y1,
x2, y2, BGRA(Random(255), Random(255), Random(255)), False);   
Inc(LinesDrawn);  end;end;// Hlinesprocedure TForm1.DrawScene2(Bm:
TBGRABitmap);var  T0: QWord;  y: Integer;begin  Bm.Fill(BGRA(0, 0,
0));   T0 := GetTickCount64;  while (GetTickCount64 - T0 < 5) do 
begin    y := Random(Bm.Height);    Bm.DrawLine(0, y, Bm.Width, y,
BGRA(Random(255), Random(255), Random(255)), False);   
Inc(LinesDrawn);  end;end; // Vlinesprocedure TForm1.DrawScene3(Bm:
TBGRABitmap);var  T0: QWord;  x: Integer;begin  Bm.Fill(BGRA(0, 0,
0));   T0 := GetTickCount64;  while (GetTickCount64 - T0 < 5) do 
begin    x := Random(Bm.Width);    Bm.DrawLine(x, 0, x, Bm.Height,
BGRA(Random(255), Random(255), Random(255)), False);   
Inc(LinesDrawn);  end;end;// circlesprocedure TForm1.DrawScene4(Bm:
TBGRABitmap);var  T0: QWord;  x, y, r: Integer;begin  Bm.Fill(BGRA(0,
0, 0));   T0 := GetTickCount64;  while (GetTickCount64 - T0 < 5) do 
begin    x := Random(Bm.Width);    y := Random(Bm.Height);    r :=
Random(50) + 5;    Bm.EllipseAntialias(x, y, r, r, BGRA(Random(255),
Random(255), Random(255)), 2);    Inc(LinesDrawn);  end;end;//
rectanglesprocedure TForm1.DrawScene5(Bm: TBGRABitmap);var  T0:
QWord;  x1, y1, x2, y2: Integer;begin  Bm.Fill(BGRA(0, 0, 0));   T0 :=
GetTickCount64;  while (GetTickCount64 - T0 < 5) do  begin    x1 :=
Random(Bm.Width);    y1 := Random(Bm.Height);    x2 := x1 +
Random(100);    y2 := y1 + Random(100);    Bm.Rectangle(x1, y1, x2,
y2, BGRA(Random(255), Random(255), Random(255)),
dmDrawWithTransparency);    Inc(LinesDrawn);  end;end;//
carrésprocedure TForm1.DrawScene6(Bm: TBGRABitmap);var  T0: QWord;  x,
y, size: Integer;begin  Bm.Fill(BGRA(0, 0, 0));   T0 :=
GetTickCount64;  while (GetTickCount64 - T0 < 5) do  begin    x :=
Random(Bm.Width);    y := Random(Bm.Height);    size := Random(80);  
Bm.Rectangle(x, y, x + size, y + size, BGRA(Random(255), Random(255),
Random(255)), dmDrawWithTransparency);    Inc(LinesDrawn);  end;end;//
textprocedure TForm1.DrawScene7(Bm: TBGRABitmap);var  T0: QWord;  x,
y: Integer;  txt: string;begin  Bm.Fill(BGRA(0, 0, 0));  Bm.FontHeight
:= 20;   T0 := GetTickCount64;  while (GetTickCount64 - T0 < 5) do 
begin    x := Random(Bm.Width - 100);    y := Random(Bm.Height - 30); 
  txt := 'TEST ' + IntToStr(Random(999));    Bm.TextOut(x, y, txt,
BGRA(Random(255), Random(255), Random(255)));    Inc(LinesDrawn); 
end;end;// rect pleinprocedure TForm1.DrawScene8(Bm: TBGRABitmap);var 
T0: QWord;  x1, y1, x2, y2: Integer;begin  Bm.Fill(BGRA(0, 0, 0));  
T0 := GetTickCount64;  while (GetTickCount64 - T0 < 5) do  begin    x1
:= Random(Bm.Width);    y1 := Random(Bm.Height);    x2 := x1 +
Random(100);    y2 := y1 + Random(100);    Bm.FillRect(x1, y1, x2, y2,
BGRA(Random(255), Random(255), Random(255), 180));   
Inc(LinesDrawn);  end;end;// carré plein !procedure
TForm1.DrawScene9(Bm: TBGRABitmap);var  T0: QWord;  x, y, size:
Integer;begin  Bm.Fill(BGRA(0, 0, 0));   T0 := GetTickCount64;  while
(GetTickCount64 - T0 < 5) do  begin    x := Random(Bm.Width);    y :=
Random(Bm.Height);    size := Random(80);    Bm.FillRect(x, y, x +
size, y + size, BGRA(Random(255), Random(255), Random(255), 180));   
Inc(LinesDrawn);  end;end;//  cercle pleinprocedure
TForm1.DrawScene10(Bm: TBGRABitmap);var  T0: QWord;  x, y, r:
Integer;begin  Bm.Fill(BGRA(0, 0, 0));   T0 := GetTickCount64;  while
(GetTickCount64 - T0 < 5) do  begin    x := Random(Bm.Width);    y :=
Random(Bm.Height);    r := Random(50) + 5;   
Bm.FillEllipseAntialias(x, y, r, r, BGRA(Random(255), Random(255),
Random(255), 180));    Inc(LinesDrawn);  end;end; procedure
TForm1.Timer1Timer(Sender: TObject);begin  Inc(TestElapsed,
Timer1.Interval);  BGRAVirtualScreen1.RedrawBitmap;  
Inc(BenchElapsed, Timer1.Interval);     if BenchElapsed >= 1000 then 
 begin      Memo1.Lines.Add('Test :' + IntToStr(Test) + '  ' +
 IntToStr(LinesDrawn) + '/sec');      BenchElapsed := 0;     
LinesDrawn := 0;      inc(Test);    end;     if Test >= MaxTests then 
  begin      Timer1.Enabled := False;      Memo1.Lines.Add('All Test
Done !');      BGRAVirtualScreen1.OnRedraw := nil;    end; 
end; procedure TForm1.FormDestroy(Sender: TObject);beginend; end.

----------------------------------------------------------------------
Gigatron · 2025-04-10 16:40

Hi,

This project is now finished, you can see where BGRA component is fast
or not.
You can learn how to jump to the different test, like a multipart demo
on Amiga