weniger Scanline aufrufe ... Graustufenbild

[bernhard_LA]

unter https://blog.dummzeuch.de/2019/12/12...lls-in-delphi/
gib es ein code fragment um mit weniger Scanline Zugriffen eine Bild/Bitmap Bearbeitung durch zuführen.
Meine Komplette Umsetzung ist unten eingefügt.

Frage : Diese Methode ist auf Assert(_InBmp.PixelFormat = pf24bit);
also 24bit Bitmaps ausgelegt. Wie würde eine Code Variante aussehen welche pf8bit und pf16 bit auch unterstützt ?

Delphi-Quellcode:

var  FImageOut : TBitmap;

begin
     FImageOut := TBitmap.CReate;
     try

        CreateSpecialImage (  FImage  , FImageOut, 100 );

        OutImage.Picture.Bitmap.Assign(FImageOut);
     finally
       // FImageOut.Free;
     end;

Delphi-Quellcode:

uses  Types, classes, Vcl.Graphics;
type

  TRgbTriple = packed record
    // do not change the order of the fields, do not add any fields
    Blue: Byte;
    Green: Byte;
    Red: Byte;
  end;

  PRgbTriple =^TRgbTriple;

  TRgbTripleArray = packed array[0..MaxInt div SizeOf(TRgbTriple) - 1] of TRgbTriple;
  PRgbTripleArray = ^TRgbTripleArray;


  procedure CreateSpecialImage(const InBmp, OutBmp: TBitmap; Threshold: Byte);


implementation

function AddToPtr(const _Ptr: Pointer; _Offset: NativeInt): Pointer; inline;
begin
  Result := Pointer(NativeInt(_Ptr) + _Offset);
end;

function PtrDiff(const _Ptr1, _Ptr2: Pointer): NativeInt; inline;
begin
  Result := NativeInt(_Ptr1) - NativeInt(_Ptr2);
end;


procedure CreateSpecialImage(const InBmp, OutBmp: TBitmap; Threshold: Byte);

var
  BytesPerPixel: NativeInt;
  InScanLine0: Pointer;
  InBytesPerLine: NativeInt;
  OutBytesPerLine: NativeInt;
  OutScanLine0: Pointer;

  InPixel: PRgbTriple;
  OutPixel: PRgbTriple;
  Pixel: TRgbTriple;
  x, y: Integer;
  Height, Width : Integer;
begin
  Height := inBMP.Height;
  Width :=  inBmp.Width;
  OutBmp.Width := Width;
  OutBmp.Height := Height;
  InBmp.PixelFormat := pf24bit;
  OutBmp.PixelFormat := pf24bit;

  BytesPerPixel := SizeOf(Pixel);
  InScanLine0 := InBmp.ScanLine[0];
  InBytesPerLine := NativeInt(InBmp.ScanLine[1]) - NativeInt(InScanLine0);
  OutScanLine0 := OutBmp.ScanLine[0];
  OutBytesPerLine := NativeInt( OutBmp.ScanLine[1]) - NativeInt(OutScanLine0);
  OutPixel := OutScanLine0;
  for y := 0 to Height - 1 do begin
    for x := 0 to Width - 1 do begin
      InPixel := AddToPtr(InScanLine0, InBytesPerLine * y + x * BytesPerPixel);
      Pixel := InPixel^;
      ///
      /// doSomething(Pixel);
      ///
      if Pixel.Blue >  Threshold  then  Pixel.Blue := Threshold;
      if Pixel.red >  Threshold  then  Pixel.red := Threshold;
      if Pixel.Green >  Threshold  then  Pixel.Green := Threshold;


      OutPixel := AddToPtr(OutScanLine0, OutBytesPerLine * y + x * BytesPerPixel);
      OutPixel^ := Pixel;
    end;
  end;

end;

[Kas Ob.]

Hi,

First you need to define 16bit and 8bit bit per pixel format, because there is many !

8bit and 16bit are so old when different systems had different color space, example : 8bit pixel either colored or gray, in colored case is it 332 or 233 for RGB or BGR ...
Same goes for 16bit, is there Alpha, in case of alpha then mostly it is 5551 or 1555 if not then 555 or 565, is it BGR(A) or (A)RGB...

Searching for good resource is semi-useless, again unless you have one specific format to follow,.. the best i could find is this :
https://learn.microsoft.com/en-gb/wi...ith-16-bit-rgb
and if we talk Windows Bitmap then this might give a little insight too https://en.wikipedia.org/wiki/BMP_file_format

notice
1) in the first link from Microsoft, the pixel decode is done by masking and bit shifting, again there is only two mentioned here RGB 555 and RGB 565, not mention for Alpha.
2) For converting these color, 5bit or 6bit to 8bit per color you need to multiply by 8 or by 4, this operation is bit shifting by 3 or 2, making a single color of 5bit [0..31] go in [0..255] and for 6bit [0..63] do the same.
3) you can change threshold mentioned in the code within the range of [0..31] or shift it accordingly to fit the 5/6 bit : talking about the following part

Code:

      if Pixel.Blue > Threshold then Pixel.Blue := Threshold;
      if Pixel.red > Threshold then Pixel.red := Threshold;
      if Pixel.Green > Threshold then Pixel.Green := Threshold;

after performing the compare and adjust you need to repack the pixel bits, or perform this on the bits directly.

As for 8bit the as above but 8bit bitmap are very rare and almost dead format and most importantly it is very wide in range !, this format or to be more accurate the lack of unified/standardized format goes to 80s and the its color space is might hard to work with,

Why working with 8bit Windows Bitmap (or 8bit DIB) is hard ? because When we talk Windows Bitmap then the there is a table define these 8bit colors representing 256 color value predefined to be used within this 8bit bitmap, so such bitmap will have lookup table with 256 value, the the pixel with grab the value form there, these values can be 8bit, 16bit.. 24bit color value..

Now on bright side for 8bit Windows Bitmap with lookup table, you can adjust the lookup table against the threshold, you don't need to walk the pixels at all !

Hope that help and clear.

[Kas Ob.]

Found a resource might be helpful at last.

https://stackoverflow.com/questions/...-grayscale-bmp

From the first answer, though the question and the code is to make a gray scale 8bit bitmap from colored

Code:

            var entry = bmp.Palette.Entries[index];
            var gray = (int)(0.30 * entry.R + 0.59 * entry.G + 0.11 * entry.B);
            newPalette.Entries[index] = Color.FromArgb(gray, gray, gray);

This line is adjusting the palette (i was looking for this word!!) i used lookup table or predefined color table.

[dummzeuch]

Ich habe in der Unit u_dzGraphicUtils, auf der der Code im Blogpost ursprünglich basierte, weitere Funktionen zur Bitmap-Bearbeitung, die auch mit 8 Bit (Graustufen) und 32 Bit (TBitmap32) arbeiten. Vielleicht hilft Dir das ja weiter. Vermutlich kann man sie relativ leicht auch an 16 Bit anpassen (wenn man weiß, wie die Farben oder Graustufen kodiert werden. Es kan sogar sein, dass in der Unit auch Code für 12 und 16 Bit Graustufen vorhanden ist. Es ist schon ewig her, ich erinnere mich nicht mehr wirklich daran.

(Die Unit ist Teil meiner dzlib.)

[dummzeuch]

Zitat:

Zitat von Kas Ob. (Beitrag 1533287)

As for 8bit the as above but 8bit bitmap are very rare and almost dead format and most importantly it is very wide in range !, this format or to be more accurate the lack of unified/standardized format goes to 80s and the its color space is might hard to work with,

Actually, the 8 bit greyscale (Mono8) is a common format used in machine vision cameras. To use that in bitmaps, they need a greyscale palette. Which then makes access quite easy, because the byte value directly represents the brightness of the pixel.

Zitat:

Zitat von Kas Ob. (Beitrag 1533287)

Why working with 8bit Windows Bitmap (or 8bit DIB) is hard ? because When we talk Windows Bitmap then the there is a table define these 8bit colors representing 256 color value predefined to be used within this 8bit bitmap, so such bitmap will have lookup table with 256 value, the the pixel with grab the value form there, these values can be 8bit, 16bit.. 24bit color value..

As for generic 8 bit color bitmaps you are right: These are very uncommon nowadays, because memory and storage size are no longer limited and graphics cards / monitors generally use 24 bits or even more.

[Kas Ob.]

Zitat:

Zitat von dummzeuch (Beitrag 1533290)

Actually, the 8 bit greyscale (Mono8) is a common format used in machine vision cameras. To use that in bitmaps, they need a greyscale palette. Which then makes access quite easy, because the byte value directly represents the brightness of the pixel.

That makes sense, thank you for the links.

[Michael II]

Dein Code ist viel zu kompliziert und dadurch auch langsam.

So könntest du es für 24Bit tun. Und für die anderen Formate natürlich ähnlich.

Delphi-Quellcode:

procedure CreateSpecialImage(const InBmp, OutBmp: TBitmap; Threshold: Byte);
var
  OutPixel: PRgbTriple;
  height, width, x, y: Integer;

begin
  OutBmp.Assign(InBmp);

  Height := OutBmp.Height;
  Width := OutBmp.Width;

  for y := 0 to Height - 1 do
  begin
    OutPixel := OutBmp.ScanLine[y];
    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(OutPixel);
    end;
  end;
end;

[himitsu]

Im CreateSpecialImage kann ein IF/Assert nicht schaden, wenn das PixelFormat nicht stimmt, sonst kann man sich hier den Speicher zerschießen (z.B. wenn pf1 bis bf16 und somit der Speicher kleiner wäre)

Zitat:

Zitat von Michael II (Beitrag 1533293)

Dein Code ist viel zu kompliziert

Da es überall der selbe Code/Threshold ist ... :angle2:

Delphi-Quellcode:

var OutByte: PByte;  // mit aktiver Pointer-Arithmetic

  for y := 0 to Height - 1 do
  begin
    OutByte := OutBmp.ScanLine[y];
    for x := Width * 3 - 1 downto 0 do
    begin
      if OutByte^ > Threshold then
        OutByte^ := Threshold;
      Inc(OutByte);
    end;
  end;

  for y := 0 to Height - 1 do
  begin
    OutByte := OutBmp.ScanLine[y];
    for OutByte := OutByte to OutByte + Width * 3 - 1 do
      if OutByte^ > Threshold then
        OutByte^ := Threshold;
  end;

Man bräuchte nur "einmal" ScanLine abzufragen, da alle Lines hintereinander liegen,
aber da die Linien an im Speicher ausgerichtet/aligned sind (auf 4 Bytes),
sind eventuell nachträglich noch Bytes eingefügt.

Wenn Width ein Vielfaches von 4, dann nicht ... sonst nach jeder Line aufgerundet werden
oder man arbeitet z.B. mit pf32bit.

Außerdem aufpassen, dass die Lines meistens unten anfangen zu zählen, also die letzte Line zuerst im Speicher liegt.

[dummzeuch]

Zitat:

Zitat von Michael II (Beitrag 1533293)

Dein Code ist viel zu kompliziert und dadurch auch langsam.

So könntest du es für 24Bit tun. Und für die anderen Formate natürlich ähnlich.

Delphi-Quellcode:

procedure CreateSpecialImage(const InBmp, OutBmp: TBitmap; Threshold: Byte);
var
  OutPixel: PRgbTriple;
  height, width, x, y: Integer;

begin
  OutBmp.Assign(InBmp);

  Height := OutBmp.Height;
  Width := OutBmp.Width;

  for y := 0 to Height - 1 do
  begin
    OutPixel := OutBmp.ScanLine[y];
    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(OutPixel);
    end;
  end;
end;

Von wegen langsam:
Dein Code ruft TBitmap.Scanline Width*Height-mal auf. Jeder dieser Aufrufe ist extrem lahm, wenn auch schon wesentlich schneller als der Zugriff auf TBitmap.Canvas.Pixel[x,y]. Genau das war der Punkt in meinem Blog-Post, auf den Bernhard im ersten Post verwiesen hat. Und da er jedes Pixel sowieso nochmal anpasst, kann er auch gleich die erste Bitmap pixelweise lesen und die zweite schreiben, das spart dann auch noch das TBitmap.Assign.

Edit: Und Himitsu hat recht: Da die Grenze für alle Farben dieselbe ist, kann man die RGB-Bytes auch einfach mittels einer Schleife von 3*Width byteweise abarbeiten statt ein PRgbTriple zu verwenden. Ob das von der Performance her nochmal einen großen Unterschied macht, weiß ich aber nicht. Die Vermeidung der Scanline-Aufrufe bringt deutlich mehr.

[Michael II]

Dann Sorry - macht es so wie es besser ist - ich lasse aber meinen Code als sehr schlechtes Beispiel stehen; ein Mahnmal für "wie man es nicht tun sollte". Danke für die wertvollen Inputs.

[Michael II]

Zitat:

Zitat von himitsu (Beitrag 1533294)

Da es überall der selbe Code/Threshold ist ... :angle2:

Und da Threshold wahrscheinlich eh fast immer 0 ist geht's noch einfacher ;-).

[dummzeuch]

Zitat:

Zitat von Michael II (Beitrag 1533296)

Dann Sorry - macht es so wie es besser ist - ich lasse aber meinen Code als sehr schlechtes Beispiel stehen; ein Mahnmal für "wie man es nicht tun sollte". Danke für die wertvollen Inputs.

Es ist kein schlechtes Beispiel, wie man es nicht machen sollte, sondern im Gegenteil ein gutes Beispiel, wie man es lesbar programmieren kann, aber eben nicht die effizienteste Methode dafür. Solange die Performance kein Problem ist, würde ich es vermutlich genauso programmieren. Mein erster Ansatz sah damals auch so aus, war aber eben zu langsam für die Anwendung (Helligkeitsausgleich für riesige Graustufen-Bilder, die zu tausenden verarbeitet werden mussten). Mittels Profiling habe ich dann herausgefunden, was man wie beschleunigen kann.

[Michael II]

Eigentlich wollte ich ja nix mehr dazu schreiben, aber es "nervt" halt doch ein wenig, wenn behauptet statt gemessen wird ;-).

Fünf Mal 1000 Bilder der Grösse 1000x1000 umgewandelt.

Die in #1 vorgestellte Lösung benötigt auf meinem nicht mehr allzu frischen Notebook im Schnitt 4950ms.
Meine in #7 benötigt 2011ms und diese hier (unten) 1373ms (wobei man das ganz sicher schöner und auch ein wenig schneller...)

Delphi-Quellcode:

procedure CreateSpecialImage2(const InBmp, OutBmp: TBitmap; Threshold: Byte);
var
  StartPixel : Pointer;
  OutPixel: PRgbTriple;
  deltascan : NativeInt;
  height, width, x, y: Integer;

begin
  OutBmp.Assign(InBmp);
  StartPixel := OutBmp.ScanLine[0];
  deltascan := NativeInt(OutBmp.ScanLine[1]) - NativeInt(StartPixel);

  Height := OutBmp.Height;
  Width := OutBmp.Width;

  for y := 0 to Height - 1 do
  begin
    OutPixel := StartPixel;
    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(OutPixel);
    end;
    inc(PByte(StartPixel), deltascan);
  end;
end;

[himitsu]

OK, man kann natürlich auch noch mit SSE/MMX anfangen, also mit nur einem Befehl jeweils 8 Bytes auf einmal,
oder mit CUDA bzw. OpenCL (OK, das wohl eher nicht).

Und natürlich noch Assembler.

[dummzeuch]

Zitat:

aber es "nervt" halt doch ein wenig, wenn behauptet statt gemessen wird .

Hey, ich hatte gemessen, nur eben vor 5 Jahren und nicht heute.

In #13 ist immernoch ein Aufruf von Scanline zuviel, denn Scanline[0] hattest Du ja bereits in StartPixel abgespeichert.

Theoretisch kann man die Differenz zwischen zwei Scanlines auch direkt berechnen, das spart dann nochmal einen Aufruf pro Bitmap:

Delphi-Quellcode:

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

Das ist auch schneller als ein Auruf von

Delphi-Quellcode:

  Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32)

(Ja, das hatte ich auch gemessen, wobei ein Blick in den BytesPerScanline-Code ausreicht, um zu verstehen wieso.)

BytesPerPixel = 1 für pf8Bit, und = 3 für pf24Bit.

Weshalb allerdings die Lösung mit TBitmap.Assign schneller sein soll als die ohne, ist mir gerade unklar, denn wie gesagt, ich hatte das damals gemessen. Bei neueren Delphis gibt es TBitmap.SetSize, was schneller ist als Höhe und Breite getrennt zu setzen wie in #1. Es kann auch einen Unterschied machen, ob man PixelFormat zuerst setzt und dann die Größe ändert oder umgekehrt.

Edit: Es ist vermutlich die unnötige Berechnung von InPixel und OutPixel für jedes Pixel:

Delphi-Quellcode:

  InPixel := AddToPtr(InScanLine0, InBytesPerLine * y + x * BytesPerPixel);
// ...
  OutPixel := AddToPtr(OutScanLine0, OutBytesPerLine * y + x * BytesPerPixel);

Da kann man in beiden for-Schleife mit Inc bzw. Dec arbeiten, wie Du das in #13 gemacht hast. Das hatte ich in meinem Code später noch geändert, nachdem ich den Blogpost geschrieben hatte.

Als "Beweis", hier der Code aus u_dzGraphicUtils, wie ich ihn schließlich verwendet habe, wobei das der generische Code mit einem Callback ist. Den Filter direkt in der Schleife zu implementieren ist natürlich schneller, da man jeweils den Callback-Aufruf spart.

Delphi-Quellcode:

procedure TBitmap24_FilterPixels(_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
  Assert(Assigned(_SrcBmp));

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

  if h = 0 then
    Exit; //==>

  BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
  Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));

  SrcLine := _SrcBmp.ScanLine[0];
  DstLine := _DstBmp.ScanLine[0];
  for y := 0 to h - 1 do begin
    Assert(SrcLine = _SrcBmp.ScanLine[y]);
    Assert(DstLine = _DstBmp.ScanLine[y]);
    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;

Und hier derselbe Code fuer eine 8 Bit Graustufen-Bitmap, nach dem der OP ja gefragt hatte:

Delphi-Quellcode:

procedure TBitmap8_FilterPixels(_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
  Assert(Assigned(_SrcBmp));

  _SrcBmp.PixelFormat := pf8bit;
  _DstBmp.Assign(nil);
  _DstBmp.PixelFormat := pf8bit;
  w := _SrcBmp.Width;
  h := _SrcBmp.Height;
  _DstBmp.Palette := MakeGrayPalette;
  TBitmap_SetSize(_DstBmp, w, h);

  if h = 0 then
    Exit; //==>

  BytesPerLine := ((w * 8 * BytesPerPixel + 31) and not 31) div 8;
  Assert(BytesPerLine = Graphics.BytesPerScanline(w, BytesPerPixel * 8, 32));

  SrcLine := _SrcBmp.ScanLine[0];
  DstLine := _DstBmp.ScanLine[0];
  for y := 0 to h - 1 do begin
    Assert(SrcLine = _SrcBmp.ScanLine[y]);
    Assert(DstLine = _DstBmp.ScanLine[y]);
    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;

Die Assertions sollte man natürlich ausschalten oder rauslöschen, denn sonst wird unnötig Graphics.BytesPerScanline aufgerufen. Ebenso sollte Overflow Checking und Range Checking ausgeschaltet sein. Vgl. die ganzen IFDEFs am Anfang der Unit.

Wobei ich mich gerade selbst frage, weshalb ich da in der inneren Schleife nicht mit Inc ohne zweiten Parameter und dem passenden Pointer-Typ für SrcPixel und DstPixel gearbeitet habe. Vielleicht aus Kompatiblitätsgründen mit uralt-Delphi-Versionen? Deshalb gibt es auch die (inline)-Prozedur TBitmap_SetSize, welches für neuere Delphis TBitmap.SetSize aufruft, und für ältere notgedrungen TBitmap.Width und .Height getrennt setzt.

[Michael II]

Zitat:

Zitat von dummzeuch (Beitrag 1533302)

Weshalb allerdings die Lösung mit TBitmap.Assign schneller sein soll als die ohne, ist mir gerade unklar, denn wie gesagt, ich hatte das damals gemessen.

Bin gerade zu müde, um es nachzumessen ;-).

Du kopierst in deinen Schleifen Pixel für Pixel von Src nach Dst. Mit einem Assign wird das in einem Rutsch vor der Schleife getan und du kannst dich dann in der Schleife nur noch mit Dst beschäftigen und Src komplett weglassen.

Wie gesagt: Gemessen habe ich nicht - aber wenn das Assign() (seit es Assign() gibt) nicht schneller sein sollte als dein "Pixel für Pixel" und Src mitschleifen, dann stimmt was mit Assign() nicht.

(Es gibt Situationen in welchen eine Pixel für Pixel Verarbeitung sinnvoll oder notwendig ist.)


Nebenbei: Wenn ich dein 8Bit Graustufenbeispiel richtig interpretiere, gehst du davon aus, dass Src die gleiche Palette verwendet wie du sie für Dst in deinem Code festlegst.

[dummzeuch]

Zitat:

Zitat von Michael II (Beitrag 1533340)

Nebenbei: Wenn ich dein 8Bit Graustufenbeispiel richtig interpretiere, gehst du davon aus, dass Src die gleiche Palette verwendet wie du sie für Dst in deinem Code festlegst.

Das ist korrekt. Ich habe noch nie ein 8Bit-Graustufen-Bild gesehen, das eine andere Palette als die Standard-Palette benutzt hat, welche dem Pixel-Wert x den RGB-Wert RGB(x,x,x) zuordnet, also das, was Kameras unter MONO8 verstehen. Es mag natürlich sein, dass es solche Spezialfälle gibt, aber der Aufwand, sie zu unterstützen, ist mir einfach viel zu groß.

[himitsu]

Aber natürlich hätte man da dann auch die Qual der Wahl
* einfach nur die kleine Farbtabelle umrechnen
* oder ben jedes Pixel, wo man dann aber aufassen muß, dass wirklich nur eine sortierte Grautabelle vorliegt.

[bernhard_LA]

very Basic Nachfrage : Die Definitionen in windows unit wurden nicht verwendet, weil zu langsam ... ?

Delphi-Quellcode:

{$ALIGN 1}
  PRGBTriple = ^TRGBTriple;
  {$EXTERNALSYM tagRGBTRIPLE}
  tagRGBTRIPLE = record
    rgbtBlue: Byte;
    rgbtGreen: Byte;
    rgbtRed: Byte;
  end;
  TRGBTriple = tagRGBTRIPLE;
  {$EXTERNALSYM RGBTRIPLE}
  RGBTRIPLE = tagRGBTRIPLE;
{$ALIGN ON}

[Michael II]

Hallo Thomas dein in #15 gezeigter 24Bit Bitmap Code auf #1 angewendet läuft bei mir nun in 1820ms (1000 Mal 1000x1000Pixel) durch.

Delphi-Quellcode:

procedure DZeuch(_SrcBmp, _DstBmp: TBitmap; Threshold: Byte);
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;
  _DstBmp.PixelFormat := pf24bit;
  w := _SrcBmp.Width;
  h := _SrcBmp.Height;
  _DstBmp.SetSize( w, h);

  if h = 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)^;
      if PdzRgbTriple(DstPixel)^.Blue > Threshold then PdzRgbTriple(DstPixel)^.Blue := Threshold;
      if PdzRgbTriple(DstPixel)^.Green > Threshold then PdzRgbTriple(DstPixel)^.Green:= Threshold;
      if PdzRgbTriple(DstPixel)^.Red > Threshold then PdzRgbTriple(DstPixel)^.Red:= Threshold;
      Inc(SrcPixel, BytesPerPixel);
      Inc(DstPixel, BytesPerPixel);
    end;
    Dec(SrcLine, BytesPerLine);
    Dec(DstLine, BytesPerLine);
  end;
end;

Du hast Recht. Assign macht (für den vorliegenden Fall) viele unnötige Dinge. Wenn ich darauf verzichte (man gewinnt ca. 0.5ms), dann läuft mein Code in 810ms:

Delphi-Quellcode:

procedure CreateSpecialImage3(const InBmp, OutBmp : TBitmap; Threshold: Byte);
var  // InBmp, OutBmp pf24Bit
  SrcScanline, DstScanline : Pointer;
  OutPixel: PRGBTriple;
  deltascan : NativeInt;
  height, width, x, y: Integer;
begin
  Height := InBmp.Height;
  Width := InBmp.Width;
  OutBmp.PixelFormat := pf24Bit;
  OutBmp.SetSize(width,height);
  if height = 0 then exit;

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

  if height > 1 then
  deltascan := NativeInt(OutBmp.ScanLine[height-2]) - NativeInt(DstScanline) else deltascan := 0;

  Move( SrcScanline^, DstScanline^, deltascan*height);

  for y := Height - 1 downto 0 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(OutPixel);
    end;
     inc(PByte(DstScanline), deltascan);
  end;
end;

Natürlich gibt's wie erwähnt wurde noch Assembler und breite Register (habe ich auch schon mal woanders genutzt - mein Rechner wurde dann wegen der Hitze runter getaktet...), Grpahics32, GDI+ (Clone)... - aber 1000 Bilder zu 1000*1000*24 Bit Bitmaps mit den "doofen" alten Grafikfunktionen in 810ms ist schon recht schnell.

[bernhard_LA]

@ Michael :

die Zeile will bei mir nicht :

Delphi-Quellcode:

 
  ....

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

[Michael II]

Hallo bernhard_LA ich kann aus deiner Grafik nix lesen. (Tipp: Meldungen in der IDE kann man auch als Text kopieren ;-).)

Hast du mal einen Break Point gesetzt und geprüft, ob die beteiligten Elemente initialisiert sind (InBmp muss Pixelformat=pf24Bit aufweisen, OutBmp muss vor dem Aufruf erzeugt worden sein [sollte ich wohl in der Prozedur prüfen und meckern, falls nicht OK]) und sinnvolle Werte gespeichert sind? Ich nehme mal an, dass height >= 1 ist (sonst würde es bereits beim Ermitteln von deltascan knallen).

Ich habe den Code oben angepasst. Neu wird auf height=0 und beim Ermitteln von deltascan auf height>1 getestet.

In gewissen Anwendungsfällen willst du eventuell gar nicht InBmp und OutBmp verwenden, sondern nur eine BitMap; zum Beispiel TuWas(b). Dann gibt's nix zu moven.

In anderen Fällen verwendest du InBmp und OutBmp, aber du berechnest aus InBmp direkt OutBmp. Dann musst du auch nix moven, benötigst aber in der Schleife auch einen Zeiger für die InBmp Pixel.

[dummzeuch]

Zitat:

Zitat von bernhard_LA (Beitrag 1533356)

very Basic Nachfrage : Die Definitionen in windows unit wurden nicht verwendet, weil zu langsam ... ?

Delphi-Quellcode:

{$ALIGN 1}
  PRGBTriple = ^TRGBTriple;
  {$EXTERNALSYM tagRGBTRIPLE}
  tagRGBTRIPLE = record
    rgbtBlue: Byte;
    rgbtGreen: Byte;
    rgbtRed: Byte;
  end;
  TRGBTriple = tagRGBTRIPLE;
  {$EXTERNALSYM RGBTRIPLE}
  RGBTRIPLE = tagRGBTRIPLE;
{$ALIGN ON}

Ich erinnere mich nicht mehr, warum ich damals die Deklaration selbst gemacht habe. Evtl. gab es sie in älteren Delphi-Versionen nicht. Mein Code muss immer mindestens bis Delphi 2007 rückwärtscompatibel sein, da viele meiner Projekte noch nicht umgestellt sind und damls 2019 waren es eigentlich noch fast alle. Außerdem habe ich für einige Funktionen Enhanced Records verwendet. Das könnte man heute zwar mit Record Helpern implementieren, aber nicht mit Delphi 2007, wenn ich mich recht erinnere.

[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:

Zitat von Kas Ob. (Beitrag 1533378)

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:

Zitat von Michael II (Beitrag 1533607)

Zitat:

Zitat von Kas Ob. (Beitrag 1533378)

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:

Delphi-Quellcode:

 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;

Hallo Thomas,
mir fiel auf, dass Du die BytesPerLine selbst errechnest.
Ich mache das immer so:

Delphi-Quellcode:

DstLine := _DstBmp.ScanLine[0];
if h>1 then BytesPerLine:=NativeInt(_DstBmp.ScanLine[1]) - NativeInt(DstLine)
   else BytesPerLine:=0;

Und

Delphi-Quellcode:

Inc(NativeInt(DstLine), BytesPerLine);

Das erspart Überraschungen wenn die Zeilen in der Bitmap dann doch mal umgekehrt gespeichert sind.

[Michael II]

Zitat:

Zitat von Amateurprofi (Beitrag 1535161)

Ich mache das immer so:

Ich in #13, #20, #25 auch ;-).

[Amateurprofi]

Zitat:

Zitat von Michael II (Beitrag 1535162)

Zitat:

Zitat von Amateurprofi (Beitrag 1535161)

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:

Zitat von Michael II (Beitrag 1535158)

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

Wie ich schrieb: Nichts.

Zitat:

Zitat von dummzeuch (Beitrag 1535150)

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

Zitat:

Zitat von Michael II (Beitrag 1535158)

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.

[dummzeuch]

Zitat:

Zitat von Amateurprofi (Beitrag 1535161)

mir fiel auf, dass Du die BytesPerLine selbst errechnest.
Ich mache das immer so:

Delphi-Quellcode:

DstLine := _DstBmp.ScanLine[0];
if h>1 then BytesPerLine:=NativeInt(_DstBmp.ScanLine[1]) - NativeInt(DstLine)
   else BytesPerLine:=0;

Und

Delphi-Quellcode:

Inc(NativeInt(DstLine), BytesPerLine);

Das erspart Überraschungen wenn die Zeilen in der Bitmap dann doch mal umgekehrt gespeichert sind.

Ja, in meinem ursprünglichen Code (im ersten Beitrag verlinkt) war das auch noch so, aber das war ein weiterer Aufruf von ScanLine und bei mir geht es um die möglichst effiziente Verarbeitung von 1000en von Bildern.

Ich habe bisher noch keine Bitmap gesehen, die nicht umgedreht gespeichert war (wobei die alle von unseren internen Programmen erzeugt werden, ist also kein Wunder). Und wenn das irgendwann passiert, merkt man das ziemlich schnell, weil es eine Access Violation gibt.

[Michael II]

Wenn es dir um Effizienz geht (deine Scanline "Optimierung"), dann solltest du bei zeitkritischen Anwendungen auf die Callback Funktion verzichten. Damit sparst du viel mehr Nanosekunden ;-).
Und wenn du das nicht willst: In vielen Anwendungsfällen kannst du sicher auf die Weitergabe von x,y an deine Callbackfunktion verzichten.
Ich habe auch rasch gemessen: 1220x753 Bild, 1000 Durchläufe:
0: Ist meine Prozedur von weiter oben, 1,2,3 sind deine (mit Callbackfunkton ohne Parameter x,y).
Du hast geschrieben deine 3 sei ähnlich 0; punkto Speed sind sie es nicht. Der Aufruf der Callbackfunktion bremst natürlich in mehrfacher Hinsicht (Prozessorcache, mehr Code).

64Bit App
i7-13620H @ 2.40GHz Win11 Home
0 : 1.184 sec
1 : 4.827
2 : 3.646
3 : 4.074

i7-11800H @ 2.30GHz Win11 Pro
0 : 1.388
1 : 5.765
2 : 4.309
3 : 4.924

AMD EPYC-Rome, 2350 Mhz WinServer 2022
0 : 2.461
1 : 6.577
2 : 5.283
3 : 6.988

Intel Xeon Cascadelake, 2394 MHz WinServer 2019
0 : 3,333
1 : 11,51
2 : 8,333
3 : 10,16