weniger Scanline aufrufe ... Graustufenbild

[Kas Ob.]

@Michael II, Nice ! this is the right way, by changing the operation from read and write in two different places stressing the CPU cache, do it once in sequential and fast move after that perform the the local operation in one place, CPU can perform 2-3 reads and one write per cycle, but let be real, if Delphi compiler managed to spit code that perform one read in 3 cycle i consider this is a Delphi win.

This way will win with Delphi every time :

Code:

  Move( InBmp.ScanLine[height-1]^, OutBmp.ScanLine[height-1]^, abs(deltascan)*height);

  for y := 0 to Height - 1 do
  begin
    OutPixel := DstScanline;
    for x := 0 to Width - 1 do
    begin
      if OutPixel^.Blue > Threshold then OutPixel^.Blue := Threshold;
      if OutPixel^.Red > Threshold then OutPixel^.Red := Threshold;
      if OutPixel^.Green > Threshold then OutPixel^.Green := Threshold;
      inc(OutPixels);
    end ;
     inc(PByte(DstScanline), deltascan);
  end ;

One thing though :
Check if InBmp is (=) OutBmp then skip the copy altogether.

[Michael II]

Hallo bernhardLA

für die Bearbeitung von 8Bit Graustufenbildern kannst du fast 1:1 den Code kopieren. Du musst einfach daran denken, dass ein Pixel nur noch 1 Byte Platz einnimmt.

Hier habe ich dir noch eine recht schnelle Variante für die Umwandlung RGB > GrauGrauGrau (24Bit -> 24Bit).

Du kannst den Farbwerten RGB Gewichte fr,fg,fb (fr+fg+fb sollte <=1 sein) zuordnen.

Da ich hier im UInt64 Bereich rechne (32 Bit würden wohl für diese Aufgabe auch reichen...), sind die Prozeduren v.a. in Windows64 (1 Mio Pixel im Millisekundenbereich) schnell (Windows32 ca. 7 Mal langsamer).

Wenn du immer mit festen Gewichten (fr,fg,fb) rechnen willst, dann lohnt es sich die Prozedur grau_test in Zeile OutPixel^.Blue := ( OutPixel^.Red * mg + OutPixel^.green* mb + OutPixel^.blue* mr + round_sh ) shr sh; entsprechend anzupassen und für mg,mb,mr,sh Konstanten zu verwenden. (Speedgewinn ca. 33%). mr,mg,mb und sh berechnest du mittels intRGB.


Viel Spass.

Delphi-Quellcode:

procedure intRGB( r, g, b : extended; var ir, ig, ib, shift : UInt64);
var
  i : Integer;
  mul : uint64;
  bestshift : UInt64;
  abserr, besterr, hr,hg,hb : extended;
  // Ziel: Bei der Ermittlung der Grauwerte aus (rot,grün,blau) auf Fliesskommazahlen verzichten
  // IN Gewichte r,g,b  grau:= r*rot+g*grün+b*blau
  // OUT ir,ig,ib,shift wobei grau := (ir*rot + ig*grün + ib*blau + 1 shl (shift-1)) shr shift
begin
  shift := 1;
  mul := 2;
  besterr := 4;
  hr := r;
  hg := g;
  hb := b;

  for i := 2 to 56 do
  begin
    hr := hr+hr;
    hg := hg+hg;
    hb := hb+hb;

    abserr := (abs(round(hr)-hr) + abs(round(hg)-hg) + abs(round(hb)-hb));

    if abserr < besterr then
    begin
      besterr := abserr;
      bestshift := shift;
    end;
    (* lesbarer wöre (weiter oben) abserr := .../mul
    schneller ist aber, auf die Division durch mul zu verzichten und stattdessen
    besterr zu verdoppeln:
    *)
    besterr := besterr + besterr;
    inc(shift);
    mul := mul shl 1;
  end;

  shift := bestshift;
  mul := UInt64( 1 ) shl shift;
  ir := round( r*mul);
  ig := round( g*mul);
  ib := round( b*mul);
end;

procedure grau_test(const InBmp : TBitmap; fr:extended=0.299; fg:extended= 0.587; fb:extended = 0.114 );
var  // InBmp OUT : pf24Bit
  SrcScanline : Pointer;
  OutPixel: PRGBTriple;
  deltascan : NativeInt;
  height, width, x, y : Integer;
  round_sh, mr,mg,mb, sh : UInt64;

begin
  Height := InBmp.Height;
  Width := InBmp.Width;
  if height = 0 then exit;

  // Standard YCbCr ITU R470 grau = 0.299*R+0.587*G+0.114*B
  // Alternativ G = 0,2126 R + 0,7152 G + 0,0722
  // GIMP  0.21 × R + 0.72 × G + 0.07 × B


  intRGB( fr,fg,fb, mr,mg,mb, sh );
  round_sh := UInt64( 1 ) shl (sh-1);

  SrcScanline := InBmp.ScanLine[height-1];

  if height > 1 then
  deltascan := NativeInt(InBmp.ScanLine[height-2]) - NativeInt(SrcScanline) else deltascan := width*3;

  for y := Height - 1 downto 0 do
  begin
    OutPixel := SrcScanline;
    for x := 0 to Width - 1 do
    begin
      OutPixel^.Blue := ( OutPixel^.Red * mg + OutPixel^.green* mb + OutPixel^.blue* mr + round_sh ) shr sh;
      OutPixel^.Green := OutPixel^.Blue;
      OutPixel^.Red := OutPixel^.Blue;
      inc(OutPixel);
    end;
    inc(PByte(SrcScanline), deltascan);
  end;
end;

Kleine Korrektur: In der vorher veröffentlichten RGB RGB Prozedur sollte stehen:
if height > 1 then
deltascan := ... else deltascan := width*3; (Damit es auch für Bitmaps mit Höhe 1 klappt.)


Ein Bild mit 753x1200 Bildpunkten auf Notebook 11th Gen Intel(R) Core(TM) i7-11800H wird in 966 Mikrosekunden in Grau umgewandelt. Das kann nur Delphi .

[Michael II]

Zitat von Kas Ob.:

One thing though :
Check if InBmp is (=) OutBmp then skip the copy altogether.

Hallo Kas Ob wie vergleichst du BitMaps schnell? Via Streams dauert bei mir der Vergleich für 1 Mio Pixel Bitmaps viel länger als das Rechnen; lohnt sich also nicht (ausser vielleicht für sehr grosse Bitmaps - habe ich nicht getestet). Oder meinst du nur Handle Vergleich?

Und dann noch Sorry für den intRGB Joke

Delphi-Quellcode:

procedure intRGB( dr, dg, db : double; var ir, ig, ib, shift : UInt64 );
const
  faktor = UInt64(1) shl 54;
begin
  shift := 54;
  ir := Round(dr * faktor);
  ig := Round(dg * faktor);
  ib := Round(db * faktor);
end;

tut's natürlich auch.

[Kas Ob.]

Zitat von Michael II:

Zitat von Kas Ob.:

One thing though :
Check if InBmp is (=) OutBmp then skip the copy altogether.

Oder meinst du nur Handle Vergleich?

That what i meant.

[dummzeuch]

Vergiss, was ich geschrieben habe. Ich sollte erst genau hinschauen und sicher sein, dass ich den Code verstanden habe, bevor ich kommentiere.

[Michael II]

Hallo Thomas
geht beides - du müsstest in deinem Code dann halt noch faktor als UInt64 definieren und das kostet ein wenig und shift kannst du nicht als const definieren (shift ist bereits ein Rückgabewert). Wenn man diese Dinge berücksichtigt, dann läuft dein Code in 4.74ms und der vorgeschlagene in 3.42ms pro Million Aufrufe durch. Da man bei Farbmatrizen den Aufruf meistens nur maximal 3 Mal pro Bitmap benötigt ist es egal. Wenn man die Prozedur häufiger aufruft spielt es eine Rolle.

Auch 3.4x ms schnell und etwas schöner ist

Delphi-Quellcode:

procedure intRGB( const dr, dg, db : double; var ir, ig, ib, shift : UInt64 );
const
  hshift = 54;
  faktor = UInt64(1) shl hshift;
begin
  shift := hshift;
  ir := Round(dr * faktor);
  ig := Round(dg * faktor);
  ib := Round(db * faktor);
end;

[dummzeuch]

Ich wollte schon die ganze Zeit nochmal das Timing für die Verarbeitung mit und ohne Assign testen, bin aber erst jetzt dazu gekommen:

Getestet wurden jeweils 1000 Durchläufe mit einer 1000x1000 Pixel Bitmap.

Algorithmus 1:

Code:

  fuer alle Pixel
    Lesen eines Pixels aus der Quell-Bitmap
    Schreiben des Pixels in die Ziel-Bitmap.
    Verarbeiten des Pixels in der Ziel-Bitmap

Algorithmus 2:

Code:

  Assign der Quell-Bitmap auf die Ziel-Bitmap
  fuer alle Pixel
    Verarbeiten eines Pixels mittels Pointer in die Ziel-Bitmap

Algorithmus 3:

Code:

  Move der Quell-Bitmap auf die Ziel-Bitmap
  fuer alle Pixel
    Verarbeiten eines Pixels mittels Pointer in die Ziel-Bitmap

Dabei bestand das Verarbeiten des Pixels aus einem Aufruf einer leeren Methode mit var-Parameter

Mono8:
Algorithmus 1: 3,979 ms/Durchlauf
Algorithmus 2: 3,140 ms/Durchlauf
Algorithmus 3: 3,141 ms/Durchlauf

BGR8:
Algorithmus 1: 3,870 ms/Durchlauf
Algorithmus 2: 4,111 ms/Durchlauf
Algorithmus 3: 5,596 ms/Durchlauf

Wobei die Schwankungen bei mehreren Tests im Bereich von ca. +/-50 ms lagen, d.h.:
* Bei Mono8 war mal Algorithmus 2 schneller, mal Algorithmus 3.
* Bei BGR8 war mal Algorithmus 1 schneller, mal lag er mit Algorithmus 2 gleichauf.

Irritierend finde ich, dass Algorithmus 3 bei BGR deutlich langsamer ist. Vielleicht habe ich da ja noch einen Bug eingebaut.

Verwendeter Code:

Mono8:

Delphi-Quellcode:

procedure TBitmap8_FilterPixels1(_SrcBmp, _DstBmp: TBitmap; _Callback: TPixel8FilterCallback);
const
  BytesPerPixel = 1;
var
  x: Integer;
  y: Integer;
  w: Integer;
  h: Integer;
  SrcLine: PByte;
  DstLine: PByte;
  SrcPixel: PByte;
  DstPixel: PByte;
  BytesPerLine: Integer;
begin
  _SrcBmp.PixelFormat := pf8bit;
  w := _SrcBmp.Width;
  h := _SrcBmp.Height;
  _DstBmp.Assign(nil);
  _DstBmp.PixelFormat := pf8bit;
  _DstBmp.Palette := MakeGrayPalette;
  TBitmap_SetSize(_DstBmp, w, h);

  if (h = 0) or (w = 0) then
    Exit; //==>

  BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;

  SrcLine := _SrcBmp.ScanLine[0];
  DstLine := _DstBmp.ScanLine[0];
  for y := 0 to h - 1 do begin
    SrcPixel := SrcLine;
    DstPixel := DstLine;
    for x := 0 to w - 1 do begin
      DstPixel^ := SrcPixel^;
      _Callback(x, y, DstPixel^);
      Inc(SrcPixel, BytesPerPixel);
      Inc(DstPixel, BytesPerPixel);
    end;
    Dec(SrcLine, BytesPerLine);
    Dec(DstLine, BytesPerLine);
  end;
end;

procedure TBitmap8_FilterPixels2(_SrcBmp, _DstBmp: TBitmap; _Callback: TPixel8FilterCallback);
const
  BytesPerPixel = 1;
var
  x: Integer;
  y: Integer;
  w: Integer;
  h: Integer;
  DstLine: PByte;
  DstPixel: PByte;
  BytesPerLine: Integer;
begin
  _SrcBmp.PixelFormat := pf8bit;
  w := _SrcBmp.Width;
  h := _SrcBmp.Height;
  _DstBmp.Assign(_SrcBmp);
  if (h = 0) or (w = 0) then
    Exit; //==>

  BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;

  DstLine := _DstBmp.ScanLine[0];
  for y := 0 to h - 1 do begin
    DstPixel := DstLine;
    for x := 0 to w - 1 do begin
      _Callback(x, y, DstPixel^);
      Inc(DstPixel, BytesPerPixel);
    end;
    Dec(DstLine, BytesPerLine);
  end;
end;

procedure TBitmap8_FilterPixels3(_SrcBmp, _DstBmp: TBitmap; _Callback: TPixel8FilterCallback);
const
  BytesPerPixel = 1;
var
  x: Integer;
  y: Integer;
  w: Integer;
  h: Integer;
  SrcBuffer: PByte;
  DstBuffer: PByte;
  DstLine: PByte;
  DstPixel: PByte;
  BytesPerLine: Integer;
begin
  _SrcBmp.PixelFormat := pf8bit;
  w := _SrcBmp.Width;
  h := _SrcBmp.Height;
  _DstBmp.Assign(nil);
  _DstBmp.PixelFormat := pf8bit;
  _DstBmp.Palette := MakeGrayPalette;
  TBitmap_SetSize(_DstBmp, w, h);

  if (h = 0) or (w = 0) then
    Exit; //==>

  BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;

  SrcBuffer := _SrcBmp.ScanLine[h - 1];
  DstBuffer := _DstBmp.ScanLine[h - 1];
  Move(SrcBuffer^, DstBuffer^, BytesPerLine * h);

  DstLine := AddToPtr(DstBuffer, BytesPerLine * (h - 1));
  for y := 0 to h - 1 do begin
    DstPixel := DstLine;
    for x := 0 to w - 1 do begin
      _Callback(x, y, DstPixel^);
      Inc(DstPixel, BytesPerPixel);
    end;
    Dec(DstLine, BytesPerLine);
  end;
end;

BGR8:

Delphi-Quellcode:

procedure TBitmap24_FilterPixels1(_SrcBmp, _DstBmp: TBitmap; _Callback: TPixel24FilterCallback);
const
  BytesPerPixel = 3;
var
  x: Integer;
  y: Integer;
  w: Integer;
  h: Integer;
  SrcLine: PByte;
  DstLine: PByte;
  SrcPixel: PByte;
  DstPixel: PByte;
  BytesPerLine: Integer;
begin
  _SrcBmp.PixelFormat := pf24bit;
  w := _SrcBmp.Width;
  h := _SrcBmp.Height;

  _DstBmp.PixelFormat := pf24bit;
  TBitmap_SetSize(_DstBmp, w, h);

  if (h = 0) or (w = 0) then
    Exit; //==>

  BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;

  SrcLine := _SrcBmp.ScanLine[0];
  DstLine := _DstBmp.ScanLine[0];
  for y := 0 to h - 1 do begin
    SrcPixel := SrcLine;
    DstPixel := DstLine;
    for x := 0 to w - 1 do begin
      PdzRgbTriple(DstPixel)^ := PdzRgbTriple(SrcPixel)^;
      _Callback(x, y, PdzRgbTriple(DstPixel)^);
      Inc(SrcPixel, BytesPerPixel);
      Inc(DstPixel, BytesPerPixel);
    end;
    Dec(SrcLine, BytesPerLine);
    Dec(DstLine, BytesPerLine);
  end;
end;

procedure TBitmap24_FilterPixels2(_SrcBmp, _DstBmp: TBitmap; _Callback: TPixel24FilterCallback);
const
  BytesPerPixel = 3;
var
  x: Integer;
  y: Integer;
  w: Integer;
  h: Integer;
  DstLine: PByte;
  DstPixel: PByte;
  BytesPerLine: Integer;
begin
  _SrcBmp.PixelFormat := pf24bit;
  w := _SrcBmp.Width;
  h := _SrcBmp.Height;
  _DstBmp.Assign(_SrcBmp);

  if (h = 0) or (w = 0) then
    Exit; //==>

  BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;

  DstLine := _DstBmp.ScanLine[0];
  for y := 0 to h - 1 do begin
    DstPixel := DstLine;
    for x := 0 to w - 1 do begin
      _Callback(x, y, PdzRgbTriple(DstPixel)^);
      Inc(DstPixel, BytesPerPixel);
    end;
    Dec(DstLine, BytesPerLine);
  end;
end;

procedure TBitmap24_FilterPixels3(_SrcBmp, _DstBmp: TBitmap; _Callback: TPixel24FilterCallback);
const
  BytesPerPixel = 3;
var
  x: Integer;
  y: Integer;
  w: Integer;
  h: Integer;
  SrcBuffer: PByte;
  DstBuffer: PByte;
  DstLine: PByte;
  DstPixel: PByte;
  BytesPerLine: Integer;
begin
  _SrcBmp.PixelFormat := pf24bit;
  w := _SrcBmp.Width;
  h := _SrcBmp.Height;
  _DstBmp.Assign(nil);
  _DstBmp.PixelFormat := pf24bit;
  TBitmap_SetSize(_DstBmp, w, h);

  if (h = 0) or (w = 0) then
    Exit; //==>

  BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;

  SrcBuffer := _SrcBmp.ScanLine[h - 1];
  DstBuffer := _DstBmp.ScanLine[h - 1];
  Move(SrcBuffer^, DstBuffer^, BytesPerLine * h);

  DstLine := AddToPtr(DstBuffer, BytesPerLine * (h - 1));
  for y := 0 to h - 1 do begin
    DstPixel := DstLine;
    for x := 0 to w - 1 do begin
      _Callback(x, y, PdzRgbTriple(DstPixel)^);
      Inc(DstPixel, BytesPerPixel);
    end;
    Dec(DstLine, BytesPerLine);
  end;
end;

Compiliert wurde mit Delphi 10.2, alle Optimierung an, Assertions aus.
Mein Rechner ist allerdings nicht gerade der schnellste: Intel Core I5-4590T mit 2 GHz
(ein Fujitsu Esprimo Q920 Mini PC)

[Michael II]

Hallo Thomas
ich weiss nicht was du in deiner _Callback tust - wahrscheinlich das in #1 ursprünglich verlangte (?).
Hast du deine Varianten 1,2,3 auf deinem Rechner auch "gegen" den Code aus #20 laufen lassen?
Gruss Michael

[Amateurprofi]

Zitat von Michael II:

Zitat von Amateurprofi:

Ich mache das immer so:

Ich in #13, #20, #25 auch .

Hallo Michael,
sorry, ich hab nicht den ganzen Thread gelesen, nur #30, ansonsten hätte ich mir meinen Kommentar gespart.

[dummzeuch]

Zitat von Michael II:

ich weiss nicht was du in deiner _Callback tust - wahrscheinlich das in #1 ursprünglich verlangte (?).

Wie ich schrieb: Nichts.

Zitat von dummzeuch:

Dabei bestand das Verarbeiten des Pixels aus einem Aufruf einer leeren Methode mit var-Parameter

Zitat von Michael II:

Hast du deine Varianten 1,2,3 auf deinem Rechner auch "gegen" den Code aus #20 laufen lassen?

Nein. Ich wollte lediglich diese 3 bzw. 6 Varianten timen. Allerdings ist Algorithmus 3 mit dem Move ziemlich genau das, was auch in #20 steht.