Funktion zum Vergleich zweier Bilder, falsche Ergebnisse...

[burning]

Hi,
Die folgende Prozedur ist von
http://www.tipps.delphi-source.de/gr...020911-8.shtml
Wenn ich mit ihr zwei genau gleich große Bilder vergleiche, so liefert sie die absurdesten Ergebnisse...

Bsp:
1. ich liefere 2 Bilder von der Größe 5*8. Sie sind beide komplett grau, bis auf den Pixel ganz links oben im ersten Bild.
2. Das Programm gibt an, dass es 3 Unterschiede gibt, was ja eindeutig 2 zuviel sind.

Wenn ich das eine Bild noch weiter verändert hab, so zeigte er mal zu wenige, mal zu viele Fehler an.

Woran kann das liegen?

Code:

procedure CompareImages(Image1, Image2: TImage);
var x, y: integer;
  anzahl_unterschiede: LongInt;
  zeile1, zeile2: PByteArray;
  prozent: single;
const schwellenwert=5;
  // Erst wenn die Unterschiede den Schwellenwert überschreiten,
  // wird die Abweichung registriert.
begin
  anzahl_unterschiede:=0;
  for y:=0 to image1.Picture.Bitmap.height-1 do begin
    zeile1:=image1.Picture.Bitmap.scanline[y];
    zeile2:=image2.Picture.Bitmap.scanline[y];
    for x:=0 to image1.Picture.Bitmap.width-1 do
      if abs(zeile1[x]-zeile2[x])>schwellenwert then
        inc(anzahl_unterschiede);
    if image1.Picture.Bitmap.height*image1.Picture.Bitmap.width>0 then
      prozent:=100*(anzahl_unterschiede/(image1.Picture.Bitmap.height*
      image1.Picture.Bitmap.width))
    else
      prozent:=0;
    form1.label1.caption:='Unterschiede:'+FloatToStr(prozent)+'%';
    form1.label2.caption:='Unterschiede:'+IntToStr(anzahl_unterschiede);
  end;
end;

[burning]

Durch Rumprobieren bin ich jetzt zu dem Ergebnis gekommen, dass ein Unterschied im ersten Pixel von links in einer Zeile genau 3 Unterschiede ergibt und ein Unterschied im zweiten Pixel von links genau 2 weitere Unterschiede ergibt. Unterschiede in den restlichen Pixeln der Bilder ergeben keine weiteren Unterschiede!
Aber hinter den Fehler bin ich immernoch nicht gekommen...

[roderich]

schätze mal, das liegt daran, daß dein Bild ein TrueColor-Bitmap ist, d.h. vermutlich mit 3 oder 4 Byte pro Pixel.
Damit sind in deinem PByteArray (ist ja ein Zeiger auf ein BYTE-Array) bei einem unterschiedlichen Pixel bis zu 3 Byte unterschiedlich.

Roderich

[burning]

stimmt...danke.
nur sehe ich jetzt keine möglichkeit, das noch irgendwie umzuschreiben...muss wohl was neues her...

/EDIT2:
wie ein
image1.Picture.Bitmap.PixelFormat:=pf24bit;
image2.Picture.Bitmap.PixelFormat:=pf24bit;
wunder wirken kann...
...oder auch nicht...das Ergebnis is immernoch falsch!

[roderich]

kann ich mir nicht vorstellen, dass das so schwierig ist umzuscheiben.


mit Image.Bitmap.PixelFormat kriegst du die Farbtiefe raus, z.B. pf32bit
dann mußt du deine for-Schleife einfach entsprechend anpassen.

oder du setzt selber Image.Bitmap.PixelFormat := pf32bit und greifst dann mit einem Array of TColor drauf zu statt dem PByteArray

Roderich

[burning]

hmm...zeig mal, wie du dir das vorstellst, so blick ich das grad ned...

[roderich]

so aus dem Kopf:

Delphi-Quellcode:

type
  TColorArray = array of TColor;
  pTColorArray = ^TColorArray;
var
  zeile1, zeile2: pTColorArray;

dann noch das PixelFormat auf pf32Bit setzen und der Rest wie gehabt

Roderich

[burning]

aha...daneke...nur jetzt krieg ichs nichtmal mehr soweit, dass ichs kompilieren kann...

btw:

Code:

procedure TForm1.Button1Click(Sender: TObject);
var
  b1, b2: TBitmap;
  c1, c2: PByte;
  x, y, i,
  different: Integer; // Counter for different pixels
begin
  b1 := Image1.Picture.Bitmap;
  b2 := Image2.Picture.Bitmap;
  Assert(b1.PixelFormat = b2.PixelFormat); // they have to be equal
  different := 0;
  for y := 0 to b1.Height - 1 do
  begin
    c1 := b1.Scanline[y];
    c2 := b2.Scanline[y];
    for x := 0 to b1.Width - 1 do
      for i := 0 to BytesPerPixel - 1 do // 1, to 4, dep. on pixelformat
      begin
        Inc(different, Integer(c1^ <> c2^));
        Inc(c1);
        Inc(c2);
      end;
  end;
end;

funktioniert auch nicht...
...und blicks absolut nimma.
kann mir irgendjemand nen hinweis auf ein vollständiges codebeispiel geben? bitte...

[burning]

24 bit image ->

Code:

procedure CompareImages(Image1, Image2: TImage);
var
  b1, b2: TBitmap;
  c1, c2: PByte;
  x, y, i,
  different: Integer; // Counter for different pixels
begin
  b1 := Image1.Picture.Bitmap;
  b2 := Image2.Picture.Bitmap;
  Assert(b1.PixelFormat = b2.PixelFormat); // they have to be equal
  different := 0;
  for y := 0 to b1.Height - 1 do
  begin
    c1 := b1.Scanline[y];
    c2 := b2.Scanline[y];
    for x := 0 to b1.Width - 1 do
      for i := 0 to 3 - 1 do // 1, to 4, dep. on pixelformat
      begin
        Inc(different, Integer(c1^ <> c2^));
        Inc(c1);
        Inc(c2);
      end;
  end;
      form1.label1.caption:='Unterschiede:';
    form1.label2.caption:='Unterschiede:'+IntToStr(different);
end;

-> 3 fach zu hohes ergebnis, wenn man die anzahl der unterschiedlichen pixel haben will!

[Phantom1]

ist ja auch logisch, da du jeden farbanteil einen pixel vergleichst (Rot/Grün/Blau).

so sollte es aber gehen:

Code:

procedure CompareImages(image1, image2: TImage);
var
  a, b: TBitmap;
  c1, c2: PInteger;
  x, y, different: Integer;
begin
  a:=Image1.Picture.Bitmap;
  b:=Image2.Picture.Bitmap;
  a.PixelFormat:=pf32bit;
  b.PixelFormat:=pf32bit;
  different:=0;
  for y:=0 to a.Height-1 do begin
    c1:=a.Scanline[y];
    c2:=b.Scanline[y];
    for x:=0 to a.Width-1 do begin
      Inc(different, Integer(c1^<>c2^));
      Inc(c1);
      Inc(c2);
    end;
  end;
  form1.label2.caption:='Unterschiede:'+IntToStr(different);
end;