[Erledigt] BitmapCompare nicht zuverlässig / Scanline Problem?

[berens]

Hallo,
das aktuelle Problem lässt mich mal wieder stark an mir selbst zweifeln.

Alte Aufgabe: Zwei Bitmaps vergleichen.

Ich schreibe gerade einen Softwaretest für die Prozedur BitmapCompare, und der läuft nicht sauber durch, da BitmapCompare nicht die erwarteten Ergebnisse zurückliefert.

In diesem konkreten Fall sind die Bitmaps -per Definition- ein Graphics.TBitmap, 5x5 px groß, 32Bit - also sollte es keine Probleme wegen nicht gesetztem AlphaKanal geben, beide Bitmaps werden immer 100% identisch gehandhabt.

Hier ist meine Testfunktion (in Arbeit):
(Ignoriert in diesem Beispiel _Target1 und 2)

Delphi-Quellcode:

function Test(_Target1, _Target2: TImage): Boolean;
  procedure DrawPattern(_TargetBitmap: Graphics.TBitmap);
  begin
    // Weißes Bild 5x5, schwarzer Rahmen außen, in der Mitte ein Punkt
    with _TargetBitmap.Canvas do begin
      Pen.Color := clBlack;
      Pen.Style := psSolid;
      Brush.Color := clWhite;
      Brush.Style := bsSolid;
      FillRect(Rect(0, 0, 5, 5));
      Rectangle(Rect(0, 0, 5, 5));
      Pixels[2, 2] := clBlack;
    end;
  end;

var
  bmp1, bmp2: Graphics.TBitmap;
begin
  Result := True;

  // Bitmaps erzeugen
  bmp1 := Graphics.TBitmap.Create;
  bmp2 := Graphics.TBitmap.Create;

  // bmp1 initialisieren
  bmp1.Width := 5;
  bmp1.Height := 5;
  bmp1.PixelFormat := pf32bit;
  with bmp1.Canvas do begin
    Pen.Color := clBlack;
    Pen.Style := psSolid;
    Brush.Color := clWhite;
    Brush.Style := bsSolid;
    FillRect(Rect(0, 0, 5, 5));
  end;

  // bmp2 --> 1:1 Kopie von bmp1. "Assign" oder Alles manuell setzten funktioniert beides.
  bmp2.Assign(bmp1);
//  bmp1.Width := 5;
//  bmp1.Height := 5;
//  bmp1.PixelFormat := pf32bit;
//  with bmp1.Canvas do begin
//    Pen.Color := clBlack;
//    Pen.Style := psSolid;
//    Brush.Color := clWhite;
//    Brush.Style := bsSolid;
//    FillRect(Rect(0, 0, 5, 5));
//  end;

  // Bilder müssen gleich sein; beide aktuell noch leer
  if not BitmapsAreEqual(bmp1, bmp2) then Result := False;

  // Zeichne das selbe Muster auf beide Bilder
  DrawPattern(bmp1);
  DrawPattern(bmp2);

  // Bilder müssen auch mit dem Muster gleich sein
  if not BitmapsAreEqual(bmp1, bmp2) then Result := False;

  // Einen Pixel manipulieren, Randfall Links-Oben
  bmp2.Canvas.Pixels[0, 0] := clWhite;
  // Bilder müssen UNTERSCHIEDLICH sein
  if BitmapsAreEqual(bmp1, bmp2) then Result := False;
  // wieder Originalmuster herstellen
  DrawPattern(bmp2);
  // hier müssen die Bilder wieder identisch sein
  if not BitmapsAreEqual(bmp1, bmp2) then Result := False;

  // Einen Pixel manipulieren, Randfall Links-Unten
  bmp2.Canvas.Pixels[0, 4] := clFuchsia;
  if BitmapsAreEqual(bmp1, bmp2) then Result := False;
  DrawPattern(bmp2);
  if not BitmapsAreEqual(bmp1, bmp2) then Result := False;

  // Einen Pixel manipulieren, Randfall Rechts-Oben
  bmp2.Canvas.Pixels[4, 0] := clLime;
  if BitmapsAreEqual(bmp1, bmp2) then Result := False; // HIER kommt TRUE zurück
  DrawPattern(bmp2);
  if not BitmapsAreEqual(bmp1, bmp2) then Result := False;

  // Einen Pixel manipulieren, Randfall Rechts-Unten
  bmp2.Canvas.Pixels[4, 4] := clRed;
  if BitmapsAreEqual(bmp1, bmp2) then Result := False; // HIER kommt TRUE zurück
  DrawPattern(bmp2);
  if not BitmapsAreEqual(bmp1, bmp2) then Result := False;


  // Einen Pixel manipulieren, Normalfall (Mitte, also nicht am Rand)
  bmp2.Canvas.Pixels[2, 2] := clBlue;
  if BitmapsAreEqual(bmp1, bmp2) then Result := False; // HIER kommt TRUE zurück
  DrawPattern(bmp2);
  if not BitmapsAreEqual(bmp1, bmp2) then Result := False;

  if not Result then begin
    sleep(0);
  end;

  _Target1.Picture.Assign(bmp1);
  _Target2.Picture.Assign(bmp2);

  FreeAndNil(bmp2);
  FreeAndNil(bmp1);

  if not Result then begin
    raise Exception.Create('FAIL: Test fehlgeschlagen.');
    Application.Terminate;
  end;
end;

BitmapsAreEqual ist nur 'ne Weiterleitung and CompareBitmap:

Delphi-Quellcode:

function BitmapsAreEqual(_Bitmap1, _Bitmap2: Graphics.TBitmap): Boolean;
begin
  Result := False;
  try
    if not assigned(_Bitmap1) then Exit;
    if not assigned(_Bitmap2) then Exit;

    if _Bitmap1.Width <> _Bitmap2.Width then Exit;
    if _Bitmap1.Height <> _Bitmap2.Height then Exit;

    Result := BitmapCompare(_Bitmap1, _Bitmap2);
  except
    on E: SysUtils.Exception do begin
      Log('BitmapsAreEqual', M, E.Message, ws_SEVERITY_EXCEPTION);
    end;
  end;
end;

Und BitmapCompare, zusammengeschrieben u.a. von https://www.delphipraxis.net/147071-...rgleichen.html

Delphi-Quellcode:

function BitmapCompare(pic1, pic2: Graphics.Tbitmap): Boolean;
var
  Pix1, Pix2 : PByte;
  y, k, x : Integer;
  r, g, b, r2, g2, b2: Byte;
  c1, c2: TColor;
const
  PixelFormatBytes: Array[TPixelFormat] of Byte = ( 0, 0, 0, 1, 0, 2, 3, 4, 0 );
begin
  result:=false;
  try
    if PixelFormatBytes[pic1.PixelFormat] <> PixelFormatBytes[pic2.PixelFormat] then Exit;
    if PixelFormatBytes[pic1.PixelFormat] = 0 then Exit; // PixelFormat wird nicht unterstützt
    if (pic1.Width <> pic2.Width) or (pic1.Height <> pic2.Height) then Exit;

    for y := 0 to pic2.Height - 1 do
    begin
      Pix1 := pic1.Scanline[y];
      Pix2 := pic2.Scanline[y];
      for x := 0 to pic2.Width - 1 do begin
         
        // Auswertung der Farbe nach RGB 
        HAL_Color2RGB(Pix1[x], r, g, b);
        HAL_Color2RGB(Pix2[x], r2, g2, b2);

        if (x = 4) and (y = 0) then begin
          c1 := pic1.Canvas.Pixels[4,0];
          c2 := pic2.Canvas.Pixels[4,0];

          sleep(0); // Hier ist nun also das Problem aufgetreten:
          // c1 = 0 = wie im Originalbild (bmp1) erwartet
          // c2 = 65280 = 00FF00 = clLime wie ich es in (bmp2) gesetzt habe 
          // r,g,b,r2,g2,b2 = 0 --> Warum?
          // pix1[x] = pix2[x] = 0 --> Warum?
          // --> kein Abbruch, da Bilder "angeblich" gleich sind 
        end;

        if Pix1[x] <> Pix2[x] then begin
          Exit; // ungleich, verlasse deshalb routine. Result ist in diesem Falle = False ...
        end;
      end;
    end;
    Result := true;
  except
    on E: SysUtils.Exception do begin
      Log('BitmapCompare', M, E.Message, ws_SEVERITY_EXCEPTION);
    end;
  end;
end;

Was mache ich hier falsch?