AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia FreePascal Bitmaps vergleichen
Thema durchsuchen
Ansicht
Themen-Optionen

Bitmaps vergleichen

Ein Thema von TForm1 · begonnen am 28. Nov 2015 · letzter Beitrag vom 1. Dez 2015
Antwort Antwort
TForm1

Registriert seit: 11. Jan 2014
128 Beiträge
 
FreePascal / Lazarus
 
#1

Bitmaps vergleichen

  Alt 28. Nov 2015, 13:49
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 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?
Der Fehler sitzt immer vor dem Computer...
  Mit Zitat antworten Zitat
SMO

Registriert seit: 20. Jul 2005
178 Beiträge
 
Delphi XE6 Professional
 
#2

AW: Bitmaps vergleichen

  Alt 28. Nov 2015, 17:09
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;
  Mit Zitat antworten Zitat
TForm1

Registriert seit: 11. Jan 2014
128 Beiträge
 
FreePascal / Lazarus
 
#3

AW: Bitmaps vergleichen

  Alt 28. Nov 2015, 17:40
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..
Der Fehler sitzt immer vor dem Computer...
  Mit Zitat antworten Zitat
SMO

Registriert seit: 20. Jul 2005
178 Beiträge
 
Delphi XE6 Professional
 
#4

AW: Bitmaps vergleichen

  Alt 28. Nov 2015, 18:09
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.
  Mit Zitat antworten Zitat
TForm1

Registriert seit: 11. Jan 2014
128 Beiträge
 
FreePascal / Lazarus
 
#5

AW: Bitmaps vergleichen

  Alt 28. Nov 2015, 18:47
Ja stimmt genau hatt ich vergessen

Jetzt klappts bei mir auch

Werd ich mal versuchen das ganze mit PRGBTriple in mein richtiges Programm zu übertragen, mal schauen obs dann auch klappt...
Der Fehler sitzt immer vor dem Computer...
  Mit Zitat antworten Zitat
TForm1

Registriert seit: 11. Jan 2014
128 Beiträge
 
FreePascal / Lazarus
 
#6

AW: Bitmaps vergleichen

  Alt 28. Nov 2015, 22:22
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...
Der Fehler sitzt immer vor dem Computer...
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 04:49 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz