TCanvas.Pixels[] optimieren - Wer hilft mit?

[blackdrake]

Hallo.

Ich arbeite viel mit TImages und verwende häufig Pixels[], um einzelne Pixel zu bearbeiten oder sie in zwei X-Y-For-Schleifen abzurufen. Leider werden die Programme dadurch sehr langsam. Ich habe mich seit heute mal mit den Scanlines beschäftigt und möchte eine Klasse schreiben, die ein TImage um eine optimierte Pixels[]-Property erweitert.

Die Klasse funktioniert bereits mit dem 24 Bit Speicherbelegung. Die Klasse muss aber noch unbedingt auf die anderen Werte von TPixelFormat portiert werden. Könnt ihr mir dabei helfen? Es würde mich sehr freuen, wenn ihr euch daran beteiligen könnt, sodass alle Farbtiefen unterstützt werden und die direkte Verwendung von Pixels[] endlich mal performant möglich ist.

Hier mein Code für 24-Bit-Bilder:

Delphi-Quellcode:

type
  TRGBArray = array[0..32767] of TRGBTriple;
  PRGBArray = ^TRGBArray;

  // TExtImage.Pixels[x,y] übernimmt die Funktion von
  // TImage.Picture.Bitmap.Canvas.Pixels[x,y] mit höherer
  // Performance.

  TExtImage = class(TImage)
  private
    function GetPixel(X, y: integer): TColor;
    procedure SetPixel(X, Y: integer; Value: TColor);
  public
    property Pixels[X, Y: integer]: TColor read GetPixel write SetPixel;
  end;

procedure TExtImage.SetPixel(X, Y: integer; Value: TColor);
var
  Row: PRGBArray;
begin
  if Self.Picture.Bitmap.PixelFormat = pf24Bit then
  begin
    Row := Picture.Bitmap.Scanline[Y];
    Row[X].rgbtRed   := GetRValue(Value);
    Row[X].rgbtGreen := GetGValue(Value);
    Row[X].rgbtBlue  := GetBValue(Value);
  end
  else
  begin
    // TODO: Auch andere PixelFormat's unterstützen!
    Picture.Bitmap.Canvas.Pixels[X, Y] := Value;
  end;
end;

function TExtImage.GetPixel(X, Y: integer): TColor;
var
  Row: PRGBArray;
begin
  if Picture.Bitmap.PixelFormat = pf24Bit then
  begin
    Row := Picture.Bitmap.Scanline[Y];
    result := RGB(Row[X].rgbtRed, Row[X].rgbtGreen, Row[X].rgbtBlue);
  end
  else
  begin
    // TODO: Auch andere PixelFormat's unterstützen!
    result := Picture.Bitmap.Canvas.Pixels[X, Y];
  end;
end;

(Die Klasse wäre eigentlich perfekt als Helferklasse für ein TCanvas, doch dann wäre die Abwärtskompatibilität futsch...)

Hier der Performancevergleich von Pixels[] bei meiner 24 Bit Farbtiefe Variante:

TCanvas: 1887 ms
TExtImage: 127 ms

(3 Mittelwerte im Debugger, 500 MHz, Testreferenzgrafik)

Gruß
blackdrake

---

Anhang: Die Testroutine:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  x: TExtImage;
  i, j: integer;
  s, e: TDateTime;
  col: TColor;
  Hour, Min, Sec, MSec: word;
begin
  x := TExtImage.Create(self);
  x.Parent := self;
  x.Picture.LoadFromFile('Test.bmp');
  x.AutoSize := true;

  s := Now();
  for i := 0 to x.Width - 1 do
  for j := 0 to x.Height - 1 do
  begin
    col := x.Pixels[i,j];
    col := col and clGray;
    x.Pixels[i,j] := col;
  end;
  e := Now();
  DecodeTime(e-s, Hour, Min, Sec, MSec);
  ShowMessageFmt('%d,%d', [Sec, MSec]);
end;

Die Referenzgrafik ist zu finden unter: http://www.delphipraxis.net/internal...017959#1017959