Bitmaps vergleichen

[TForm1]

Hallo zusammen,

ich habe noch eine Frage bezüglich Bitmaps und zwar möchte ich 2 Bitmaps miteinander vergleichen und falls die Entsprechenden Pixel sich gleichen (oder zumindest ähnlich sind) diejenigen Pixel einfärben und danach wird das gesamte Bild in ner Datei gespeichert.

Delphi-Quellcode:

procedure TFoo.CompareFrame;
var
  x,y: integer;
  lPixel: ^TPixelArray;
  lCompPixel: ^TPixelArray;
begin
  for y:= 0 to FFrame.Height-1 do
  begin
    lPixel:= FFrame.ScanLine[y];
    lCompPixel:= FCompFrame.ScanLine[y];
    for x:= 0 to FFrame.Width-1 do
    begin
        if (abs(lCompPixel^[0]-lPixel^[0])<=Frandomfactor) and
           (abs(lCompPixel^[1]-lPixel^[1])<=Frandomfactor) and
           (abs(lCompPixel^[2]-lPixel^[2])<=Frandomfactor) then
        begin
          lPixel^[0]:= GetBValue(FColor);
          lPixel^[1]:= GetGValue(FColor);
          lPixel^[2]:= GetRValue(FColor);
        end;

      inc(lPixel);
      inc(lCompPixel);
    end;
  end;
end;

Dabei ist

Delphi-Quellcode:

TPixelArray = array[0..2] of Byte;

Danach wird FFrame mit SaveToFile() gespeichert. Das Pixelformat ist ebenfalls pf24bit, hab ich nach dem Laden aus der Datei so festgelegt.

Problem jetzt: Der Code läuft genau so durch wie er soll, der Debugger schmeißt auch keine Fehlermeldung, aber es wird trotzdem kein Pixel ordnungsgemäß eingefärbt, obwohl genug ähnliche Pixel drin sein sollten und die Farbzuweisung auch oft genug durchgeführt wird(hab ich per Breakpoint getestet).

Das System mit dem TPixelArray hab ich von hier, weil ich es zunächst als einfacher betrachtet hab als mit PRGBTriple. Aber daran kann es doch nicht liegen oder?

[SMO]

Bei mir funktioniert das problemlos.
Habe es minimal modifiziert, um es testen zu können:

Delphi-Quellcode:

var
  BmpA, BmpB: TBitmap;

procedure Test(BmpIn, BmpInOut: TBitmap; Threshold: Byte; Color: TColor);
var
  x, y: Integer;
  PixelA, PixelB: PRGBTriple;
begin
  Assert(BmpIn.Width = BmpInOut.Width);
  Assert(BmpIn.Height = BmpInOut.Height);
  BmpIn.PixelFormat := pf24bit;
  BmpInOut.PixelFormat := pf24bit;
  Color := ColorToRGB(Color);
  for y := 0 to BmpIn.Height-1 do
  begin
    PixelA := BmpIn.ScanLine[y];
    PixelB := BmpInOut.ScanLine[y];
    for x := 0 to BmpIn.Width - 1 do
    begin
      if (Abs(PixelA.rgbtBlue - PixelB.rgbtBlue) <= Threshold) and
         (Abs(PixelA.rgbtGreen - PixelB.rgbtGreen) <= Threshold) and
         (Abs(PixelA.rgbtRed - PixelB.rgbtRed) <= Threshold) then
      begin
        PixelB.rgbtBlue := GetBValue(Color);
        PixelB.rgbtGreen := GetGValue(Color);
        PixelB.rgbtRed := GetRValue(Color);
      end;
      Inc(PixelA);
      Inc(PixelB);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BmpA := TBitmap.Create;
  BmpA.LoadFromFile('d:\test1.bmp');
  BmpB := TBitmap.Create;
  BmpB.LoadFromFile('d:\test2.bmp');
  Test(BmpA, BmpB, 10, clGreen);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, BmpA);
  Canvas.Draw(BmpA.Width, 0, BmpB);
end;

[TForm1]

Ah ok dann kann es ja nicht an der Methode liegen...

ich hab deinen Code auch mal bei mir ausgetestet, allerdings will Lazarus das nicht kompilieren, der stört sich an der Zeile mit PixelA.rgbtBlue mit dem Fehler: illegal qualifier.. :gruebel:

[SMO]

Dann probiere mal PixelA^.rgbtBlue (analog für alle anderen Vorkommen); das ist strenggenommen die korrekte Form, denn PixelA und PixelB sind ja Pointer auf Records und müssen deshalb per "^" dereferenziert werden. In Delphi kann man sich das hier praktischerweise sparen. Wann genau das eingeführt wurde, weiß ich nicht.

[TForm1]

Ja stimmt genau hatt ich vergessen:roll:

Jetzt klappts bei mir auch:thumb:

Werd ich mal versuchen das ganze mit PRGBTriple in mein richtiges Programm zu übertragen, mal schauen obs dann auch klappt...

[TForm1]

Hmm... in meinem richtigen Programm funktionierts immer noch nicht d.h. der Fehler muss irgendwo anders liegen.

Was eventuell noch in Frage käme, wäre die Speicherung der Bitmaps über SaveToFile(). Da hab ich nämlich noch eine Verständnisfrage: Was passiert wenn die angegebene Datei bereits existiert? Wird die dann einfach überschrieben? Das könnte nämlich die Lösung sein weil ich nämlich die Bitmap danach in eine bereits vorhandene Datei schreiben möchte...

[Luckie]

Kommt drauf an wie du es implementiert hast. Ein einfaches SveToFile schreibt einfach die Datei und interessiert sich nicht für eine schon bestehende. Ein SaveDialog kann man entsprechend konfigurieren.

[TForm1]

Also werden die vorhandenen Dateien einfach überschrieben? Weil das wäre ja genau das was ich brauche...

[Luckie]

Na ja, dürfte ja nicht so schwer sein dies an Hand des Zeitstempels festzustellen.

[SMO]

Mal 'ne ganz dumme Frage: du führst SaveToFile schon für das richtige Objekt aus, oder?
Und ja, die Datei sollte einfach überschrieben werden.
Du könntest mal mehr von deinem Code zeigen, vielleicht liegt der Fehler woanders.