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

[hoika]

Hallo,
hast du das mal durchgesteppt (F5,F7,F8).
Es scheint doch mit HAL_Color2RGB( zu tun zu haben, wo wir keinen Quellcode haben.

Du hast doch etwas, was viele nicht haben, ein funktionierendes Beispiel.

[berens]

Ja stimmt, da das nachvollziehbar ist, hätte ich eigentlich direkt ein Demoprojekt draus machen können.

Siehe Anhang, angepasste Version ohne externe Abhängigkeiten.

[hoika]

Hallo,
ich versteh deinen Code nicht komplett.
Aber schau dir mal das Beispiel hier an, dort werden anderen Datentypen benutzt.

http://docs.embarcadero.com/products..._ScanLine.html

[Fritzew]

Na ja Du vergleichst Äpfel mit Birnen......

Delphi-Quellcode:

// Hier vergleichst Du Byte......
    if Pix1[x] <> Pix2[x] then begin
          Exit; // ungleich, verlasse deshalb routine. Result ist in diesem Falle = False ...
        end else begin // bedeutet Pix1[x] = Pix2[x]
          c1 := pic1.Canvas.Pixels[x,y];
          c2 := pic2.Canvas.Pixels[x,y];
// und hier Integer
          if c1 <> c2 then begin
            ShowMessage('ACHTUNG: Farbe unterschiedlich, obwohl Scanline angeblich identisch???'
                        + #13#10#13#10 + IntToStr(c1) + ' // ' + IntToStr(c2));
          end;
        end;

Lies Dir mal die Hilfe zu Scanline durch.

[berens]

Danke für die Antworten.

Das ScanLine-Beispiel habe ich auch zur Verifizierung meines Codes verwendet; ich kann nichts erkennen, was ich falsch gemacht hätte.

Zitat:

Na ja Du vergleichst Äpfel mit Birnen......

Nunja, hier muss ich doch Einspruch erheben. Trotzdem erstmal danke, dass Du Dich mit dem Thema auseinandersetzt.
Man muss natürlich berücksichtigen, dass der Code aus dem Anhang zur Verdeutlichung angepasst und erweitert wurde, was in der fertigen Version natürlich so nicht sein soll. Doch zum eigentlichen Thema:

Delphi-Quellcode:

// Hier vergleichst Du Byte......
    if Pix1[x] <> Pix2[x] then begin

Das hier ist der Code, der in der fertigen Version verwendet werden soll. Beide Bitmaps sind im Pixelformat 32-Bit, entsprechend sollte Pix1[x] ein 4 Byte langer Wert sein (jede Farbe R G B und der Alphakanal; jeweils ein Byte). Somit kann ich imo durchaus sagen: Wenn Bild1[x] = Bild2[x], dann sind die Farben Rot, Grün, Blau und der Alpha Wert auf beiden Seiten identisch. Halten wir das erstmal so fest: Ich vergleiche vergleichbare Werte, und erhalte das Ergebnis: Die Farben auf beiden Bildern sind 1:1 identisch.

Delphi-Quellcode:

        end else begin // bedeutet Pix1[x] = Pix2[x]
          c1 := pic1.Canvas.Pixels[x,y];
          c2 := pic2.Canvas.Pixels[x,y];
// und hier Integer
          if c1 <> c2 then begin

An dieser Stelle muss man betonen, dass es nur die detaillierte Fehlersuche darstellt. Das Else bedeutet ja automatisch in diesem Zusammenhang "Pix1[x] = Pix2[x]". Das bedeutet wiederum: der Pixel in Bild1 ist 1:1 identisch mit dem Pixel in Bild2.
Nun lese ich mit (der exorbitant langsamen) Funktion "Pixels" die Farbe (TColor) genau der selben Pixel aus, die ich eben schon mit Scanline geprüft habe. ScanLine sagte ja, dass genau dieser Pixel in Bild 1 und 2 jeweils für R, G, B und A den Wert "0" hat, und somit auf beiden Bildern identisch ist (in beiden Bildern "Schwarz", obwohl eigentlich in Bild 2 "grün"). c1 besagt nun: in Bild 1 ist der Pixel Schwarz (korrekt) und: in Bild 2 ist dieser Pixel grün (korrekt).

Durch die Verschachtelung der Anweisungen habe ich im Endeffekt die Abfrage "Sind die Pixel auf beiden Bildern identisch? (Scanline-Verfahren)" und "Sind die Pixel auf beiden Bildern identisch? (Pixel-Verfahren)". Beide Abfragen müssen korrekterweise das gleiche ausgeben, tun sie aber nicht - ScanLine liefert eine falsche Antwort.

Das Vergleichsverfahren kann ich nicht komplett auf die "Pixels"-Prüfung umstellen, da diese viel zu langsam ist; ich muss mit ScanLine Arbeiten. Das Pixelsverfahren ist hier nur einprogrammiert, um den Fehler von Scanline "nachweisen" zu können.

Also: Was mache ich an ScanLine falsch?

Zwecks lesbarkeit, hier nochmal die aktuelle Version:

Delphi-Quellcode:

function BitmapCompare(pic1, pic2: Graphics.Tbitmap): Boolean;
var
  Pix1, Pix2 : PByte;
  y, k, x : Integer;
  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

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

        if Pix1[x] <> Pix2[x] then begin
          Exit; // ungleich, verlasse deshalb routine. Result ist in diesem Falle = False ...
        end else begin // bedeutet Pix1[x] = Pix2[x]
          c1 := pic1.Canvas.Pixels[x,y];
          c2 := pic2.Canvas.Pixels[x,y];
          if c1 <> c2 then begin
            ShowMessage('ACHTUNG: Farbe unterschiedlich, obwohl Scanline angeblich identisch???'
                        + #13#10#13#10 + IntToStr(c1) + ' // ' + IntToStr(c2));
          end;
        end;

      end;
    end;
    Result := true;
  except
    on E: SysUtils.Exception do begin
    end;
  end;
end;

[Zacherl]

ScanLine liefert dir einen Zeiger auf den ersten Pixel der Zeile. Du vergleichst hier mit if c1 <> c2 then jeweils zwei Zeiger, was nicht wirklich zielführend ist

Falsch gelesen

Fritz hat schon recht. Der Vergleich sollte je nach PixelFormat mit den korrekten Datentypen durchgeführt werden. Warum? Ganz einfach: Ausgehend von 32-Bit hättest du ScanLine[0] = 1. Pixel = Scanline + $00 aber ScanLine[1] = 2. Pixel = Scanline + $04 . Da du aber PByte über den Array Operator indizierst, ist bei dir ScanLine[1] = Scanline + $01 was "irgendwo" im 1. Pixel liegt. Kann man natürlich auch so machen, aber dann sollte deine Schleife nicht bis .Width laufen, sondern bis .Width * 4 (und die Diskrepanz zu .Pixels musst du dann natürlich bewusst ignorieren, da du in diesem Falle mit ScanLine auf Byte Granularität arbeitest, .Pixels aber immer auf den kompletten Pixeln).

[Fritzew]

Entschuldige das ich widerspreche......

Das ist Deine Deklaration......

Delphi-Quellcode:

var
  Pix1, Pix2 : PByte;

Zitat:

entsprechend sollte Pix1[x] ein 4 Byte langer Wert sein

ja sollte....

Schau doch mal mit dem Debugger da rein und schau mal was Dir ein Pix1[x] für einen Wert liefert

Ich bleibe bei den Äpfel und Birnen

[berens]

Nochmal danke für die Rückmeldungen.

Den "Äpfel mit Birnen"-Hinweis bezog ich die ganze Zeit darauf, dass ich an der einen Stele pix1=pix2 vergleiche, und an der anderen Stelle c1=c2. Aber -wenn ich's denn nun richtig verstehe- wolltest Du wohl sagen, pByte sich nicht für einen 4-Stelligen Byte-Vergleich eignet, respektive für die Arbeit mit Scanline generell. Das ist ein wichtiger Hinweis und kam bis dato bei mir so nicht an.

Mit dem Ansatz, dass schlicht der Datentyp für meine ScanLine-Variable falsch ist, habe ich hier im Forum wieder die Beispiele gefunden, die ich ursprünglich gesucht hatte. Diese arbeiten nicht mit pByte, sondern mit TRGBTripple(Array) oder TRGBQuad(Array) (teilweise selbstdefinierte Typen). Spontan konnte ich die Beispiele nicht adequat auf mein Problem übertragen (in den Beispielen ging es meist um's kopieren, nicht vergleichen), deshalb habe ich nochmal gegoogle und bin auf folgende Lösung gestoßen, die mein Problem löst, und nun auch mit Scanline die richtigen Werte zurückgibt:

https://www.tek-tips.com/viewthread.cfm?qid=1626211

Delphi-Quellcode:

function GetPixelSize(informat: TPixelFormat): Integer;
  // returns proper byte size for input
  begin
    case informat of
      pf8bit: Result := 1;
      pf16bit: Result := 2;
      pf24bit: Result := 3;
      pf32bit: Result := 4;
    else
      Result := 0;
    end;
  end;

function MyBitmapsAreSame(Bitmap1, Bitmap2: TBitmap): Boolean;
var
  scanptr1, scanptr2: pointer;
  i: integer;
  PixelSize: byte;
begin
  Result := false;
  if (Bitmap1.Width = Bitmap2.Width) and
     (Bitmap1.Height = Bitmap2.Height) and
     (Bitmap1.PixelFormat = Bitmap2.PixelFormat) then
    begin
      PixelSize := GetPixelSize(Bitmap1.PixelFormat);
      for i := 0 to (Bitmap1.Height-1) do
        begin
          scanptr1 := Bitmap1.ScanLine[i];
          scanptr2 := Bitmap2.ScanLine[i];
          Result := CompareMem(scanptr1, scanptr2, Bitmap1.Width*PixelSize);
          if Result = false then break;
        end;
    end;
end;

Nochmals danke für die Beiträge!

[hoika]

Hallo,
und genau dafür gibt es dieses Forum.

PS:
Danke, Daniel