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.

[TForm1]

Also ich habe jetzt mal eine Modifikation von dem Testcode oben vorgenommen und die BmpA und BmpB jeweils danach noch mal gespeichert.

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  BmpA := TBitmap.Create;
  BmpA.LoadFromFile('/Users/home/test1.bmp');
  BmpB := TBitmap.Create;
  BmpB.LoadFromFile('/Users/home/test2.bmp');
  Test(BmpA, BmpB, 40, clGreen);
  BmpA.SaveToFile('/Users/home/test1.bmp');
  BmpB.SaveToFile('/Users/home/testErgebnis.bmp');
end;

Ergebnis ist, dass mit SaveToFile das Bitmap ohne die Veränderungen gespeichert wird, warum auch immer...:gruebel:
Also kann es nur am SaveToFile() liegen.

[SMO]

Zitat:

Zitat von TForm1 (Beitrag 1322851)

Ergebnis ist, dass mit SaveToFile das Bitmap ohne die Veränderungen gespeichert wird, warum auch immer...:gruebel:
Also kann es nur am SaveToFile() liegen.

Nicht zwingend. Lässt du dir das Bitmap anzeigen, z.B. so wie in meinem Code im OnPaint-Event des Hauptfensters? Falls nicht, mach das mal. Wäre interessant zu wissen, ob die Änderungen dort sichtbar sind oder nicht. Falls sie sichtbar sind, dann liegt es wohl wirklich an SaveToFile. Falls nicht, dann liegt das Problem woanders.

[TForm1]

Doch eben genau das. Ich habs so anzeigen lassen wie in deinem Code, funktioniert auch prima nur sobald ich speicher wird die Änderung nicht mit gespeichert...

[SMO]

Dann hat die FreePascal-Version von TBitmap da wohl einen bösen Bug.

[TForm1]

Hmm.. dann lad ich mir mal den aktuellen FreePascal- Compiler runter...

Danke trotzdem für die Hilfe!:thumb:

[Dejan Vu]

Zwei einfache Verifikationen:
1. Lösch die Datei vorher. Funktioniert es?
2. Speicher die Datei unter einem anderen Namen. Und nun?

[TForm1]

@Dejan Vu

hab ich alles ausprobiert, keine Variante funktioniert, er speichert die Bitmap immer ohne die Veränderung in dem Zustand wie er sie geladen hat..

[Klaus01]

.. mhm sollte keinen Unterschied machen,
aber kannst Du in der "Test" Methode BmpIn und BmpOut mal als var Parameter deklarieren?

Grüße
Klaus

[TForm1]

@Klaus01: Grad getestet, auch mit var klappts nicht...

Vllt lad ich mir mal Graphics32 runter und probiers damit, ist ja eh ganz sinnvoll...