// Hiermit kann man zwei TBitmap auf Gleichheit prüfen (und so feststellen
// ob in einem von zwei scheinbar gleichen Bildern Informationen versteckt
// sind, wie z.B. Digimarc-Wasserzeichen o.ä.).
// siehe auch:  Binäre Dateien vergleichen

// Getestet mit D4 unter Win98

function breitenwert(bm: TBitmap): Integer; 
begin 
  case bm.pixelformat of 
    pf32bit: 
      Result := bm.width * 4; 
    pf24bit: 
      Result := bm.width * 3; 
    pf16bit, pf15bit: 
      Result := bm.width * 2; 
    pf8bit: 
      Result := bm.width; 
    pf4bit: 
      Result := bm.width div 2 + 1; 
    pf1bit: 
      Result := bm.width div 8 + 1; 
    else 
      Result := 0; 
    end; 
  dec(Result); 
end; 
 
function istgleich(bm1, bm2: TBitmap): Integer; 
var 
  x, y, br: Integer; 
  p1, p2: PByteArray; 
begin 
  Result := -1; 
  br := breitenwert(bm1); 
  if br < 1 then 
    exit; 
  Result := 0; 
  if (bm1.width <> bm2.width) or (bm1.height <> bm2.height) or 
    (bm1.pixelformat <> bm2.pixelformat) then 
    exit; 
  for x := 0 to bm1.height - 1 do 
  begin 
    p1 := bm1.scanline[x]; 
    p2 := bm2.scanline[x]; 
    for y := 0 to br do 
      if p1[y] <> p2[y] then 
        exit; 
  end; 
  Result := 1; 
end; 
 
procedure anzeigen(v: Integer); 
begin 
  case v of 
    - 1: 
      showmessage('Die Bilder können nicht verglichen werden.'); 
    0: 
      showmessage('Die Bilder sind ungleich.'); 
    1: 
      showmessage('Die Bilder sind gleich.'); 
  end; 
end; 
 
procedure TForm1.Button5Click(Sender: TObject); 
var 
  bm1, bm2: TBitmap; 
begin 
  bm1 := TBitmap.Create; 
  bm2 := TBitmap.Create; 
  bm1.LoadFromFile('d:\bilder\corel009.bmp'); 
  bm2.LoadFromFile('d:\bilder\corel009.bmp'); 
  anzeigen(istgleich(bm1, bm2)); 
  bm2.LoadFromFile('d:\bilder\corel004.bmp'); 
  anzeigen(istgleich(bm1, bm2)); 
  bm2.Free; 
  bm1.Free; 
end;