Benchmark Test bzw ein Versuch dazu^^

[t-z]

Hier habe ich mal einen Benchmark mit opbitmap64 genmacht. Den Test habe ich mit Lazarus 0.9.28.2 64 Bit unter Windows 7 Professional 64 Bit gemacht. Es wurde FPC 2.2.4 verwendet. Die Grundlast meines System sah folgendermaßen aus: 3,5 GB freier RAM (5 GB verfügbar), 5-10% Grundlast auf einem i5-760 (4*2,8 GHz). Dies ist mein Quellcode:

Code: Alles auswählen

unit Unit1; 
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, LCLType, IntfGraphics, fpImage, opbitmap, lclintf{GetTickCount};
 
type
  //TRGBTripleArray = array[0..32767] of TRGBTriple;
  //PRGBTripleArray = ^TRGBTripleArray;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 
 
var
  Form1: TForm1; 
 
implementation
 
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
const w = 2000;
const h = 2000;
const l = 10;
var
  SrcIntfImg: TLazIntfImage;
  T2: TBitmap;
  OP: TCanvasOPBitmap;
  px, py, i: integer;
  s, e: Cardinal;
  Row: PRGBTripleArray;
  Line:PAPixel32;
begin
  //OpBitmap
  OP := TCanvasOPBitmap.Create;
  OP.Width := w;
  OP.Height := h;
  s := GetTickCount;
  for i:=0 to l do
   for py := 0 to h - 1 do
    for px := 0 to w - 1 do Op.Canvas.Pixels[px, py] := clred;
 
  e := GetTickCount - s;
  Edit1.Text:=InttoStr(e);
  OP.free;
 
  //OpBitmap mit Scanline
  OP := TCanvasOPBitmap.Create;
  OP.Width := w;
  OP.Height := h;
  OP.PixelFormat:=pf32bit;
  s := GetTickCount;
  for i:=0 to l do
   for py := 0 to h - 1 do
   begin
    Line:=Op.ScanLine[pY];
    for px := 0 to w - 1 do
    begin
      Line^[px].Red:=255;
      Line^[px].Blue:=0;
      Line^[px].Green:=0;
     end;
   end;
  e := GetTickCount - s;
  Edit2.Text:=InttoStr(e);
 
  //LazIntfImg
  SrcIntfImg := TLazIntfImage.Create(0, 0);
  SrcIntfImg.DataDescription := GetDescriptionFromDevice(0);
  SrcIntfImg.SetSize(w, h);
 
  s := GetTickCount;
  for i:=0 to l do
   for py := 0 to h - 1 do
     for px := 0 to w - 1 do SrcIntfImg.Colors[px, py] := colRed;
 
  e := GetTickCount - s;
  Edit3.Text:=InttoStr(e);
  SrcIntfImg.Free;
 
  //LazIntfImg2
  SrcIntfImg := TLazIntfImage.Create(0, 0);
  SrcIntfImg.DataDescription := GetDescriptionFromDevice(0);
  SrcIntfImg.SetSize(w, h);
 
  s := GetTickCount;
  for i:=0 to l do
    for py := 0 to h - 1 do
      begin
         Row := SrcIntfImg.GetDataLineStart(py);
         for px := 0 to w - 1 do
           begin
             row^[px].rgbtBlue :=0;
             row^[px].rgbtGreen:=0;
             row^[px].rgbtRed  :=255;
           end;
      end;
  e := GetTickCount - s;
  Edit4.Text:=InttoStr(e);
  SrcIntfImg.Free;
 
  //TBitmap
  T2 := TBitmap.Create;
  T2.Height := w;
  T2.Width := h;
 
  s := GetTickCount;
  for i:=0 to l do
   for py := 0 to h - 1 do
     for px := 0 to w - 1 do T2.Canvas.Pixels[px, py] := clred;
 
  e := GetTickCount - s;
  Edit5.Text:=InttoStr(e);
 
  T2.Free;
end;
 
 
initialization
  {$I unit1.lrs}
 
end.

Leider ist das Ergebnis zumindest unter meinen Testbedingungen ein wenig anders:

OpBitmap: 1326ms
LazIntfImg: 1139ms
LazIntfImg2: 515ms
TBitmap: 14913ms

Edit: Nun auch mit OP-Scanline (Quelltext und Anhänge sind geändert):
OpBitmap: 1326ms
OPScanline: 452ms
LazIntfImg: 1139ms
LazIntfImg2: 531ms
TBitmap: 14726ms

[mschnell]

Bestehen Pläne, die OPbitmap.pas eines Tages in das Lazarus-Projekt zu integrieren? Bzw. was spricht nach deiner Auffassung dagegen?

Etwas ähnliches entwickelt sich mit dem "fpGUI" Widget Type. Momentan verwendet fpGUI direkt (ohne externen Widget Set wie gtk) X11. Einer der Entwickler möchte aber auch ein "nacktes" Memory-Array als Pixel "Framebuffer" implementieren. (Siehe engische Lazarus-Enrtwicklungs Mailing Liste.)

-Michael