Hintergrund ändern bei einem Bild

[mimi]

Hallo,
ich habe mehre bilder(siehe anhang)
testa.bmp ist das orginal bild
test.bmp ein bild mit einem objekt drauf
test2.bmp drauf möchte ich nur das objekt von test kopiren das dachte ich mir so:
Ich schau auf test und dann auf testa sobalt sich ein pixlel unterscheidet habe ich das objekt und das möchte ich auf dem neuen hintergrund zeichen(ich hoffe ihr habt es verstanden)
hier noch ein bischen code:

Delphi-Quellcode:

procedure TForm1.CompareImages(image1, image2: TImage);
var
  x,y:Integer;
begin
  for y:=0 to 51 do begin
    for x:=0 to 64 do begin
      if Image2.Picture.Bitmap.Canvas.Pixels[x,y] <> Image1.Picture.Bitmap.Canvas.Pixels[x,y] then
        Form1.Image4.Canvas.Pixels[x,y]:=Image3.Picture.Bitmap.Canvas.Pixels[x,y]
      else
        Form1.Image4.Canvas.Pixels[x,y]:=Image2.Picture.Bitmap.Canvas.Pixels[x,y]
    end;
  end;
end;

das problem jetzt: das bild sieht falsch aus, es klappt so nicht.

[SirThornberry]

Ich hab mir das ganze angeschaut und musste feststellen das es schlicht an den Bildern liegt!!
Der Hintergrund ist nicht wirklich der Hintergrund von dem Bild mit dem Mann!!

Naja, war ja nur knapp über eine halbe Stunde die ich dafür inestiert hab und das für einen Fehler der nicht sein muss!!!

[mimi]

das habe ich auch vermutet aber das 100% der hintergrund. das was in testA zu sehen ist wirklich der hintergrund von test.bmp. wenn du beide bilder mit Paint öffnest wirst du das auch sehen.

[SirThornberry]

das kommt dir nur so vor weil dein auge die gleichen Fababstufungen nicht sieht!! Wenn du einfach mal in das Hintergrund bild mit Paint was reinmalst und dieses bild dann anstelle des aktuellen Bildes mit dem Mann nimmst wirst du sehen das es funktioniert!

Zum Beispiel hat das pixel von dem einen Bild die werte ( 1, 3, 11 ) und das andere Pixel die Werte ( 0, 0, 8 ). Da die Werte so gering sind (in richtung 0) wirken beiden Pixel schwarz sind aber eben nicht identisch.

[Airblader]

Scanline zu verwenden wäre übrigens besser, da du sonst wohl sehr schnell Performanceprobleme bekommst

air

[SirThornberry]

Da muss ich Airblader zustimmen. Allerdings hab ich bei meinem Testprogramm gemerkt das es mit scanline bedeutend mehr aufwand ist da man darauf achten muss das nicht verschiedene Farbtiefen verwendet werden. Wenn allerdings sichergestellt ist das alle Bilder mit der gleichen Farbtiefe vorhanden sind und diese auch feststeht ist der Aufwand nicht wirklich vorhanden.

Da die Bilder ja annähernd gleich sind hab ich eine Funktion geschrieben die mit Toleranz arbeitet:

Delphi-Quellcode:

function TransferPicPart(ANewBG, ACurrBG, ACurrPic: TBitmap; AColorTol: Byte=0): Boolean;
  function LIsSameVal(AVal1, AVal2: Integer): Boolean;
  begin
    result := Abs(AVal1 - AVal2) <= AColorTol;
  end;

  function LIsSameCol(ACol1, ACol2: PRGBTriple): Boolean;
  begin
    result := LIsSameVal(ACol1.rgbtBlue, ACol2.rgbtBlue) and
              LIsSameVal(ACol1.rgbtGreen, ACol2.rgbtGreen) and
              LIsSameVal(ACol1.rgbtRed, ACol2.rgbtRed);
  end;
var LCurrBG, LCurrPic: TBitmap;
    LNewBGPix, LCurrBGPix, LCurrPicPix: PRGBTriple;
    LCountX, LCountY: Integer;
begin
  if (ACurrBG.Width = ACurrPic.Width) and (ACurrBG.Height = ACurrPic.Height) and (ANewBG.PixelFormat = pf24bit) then
  begin
    LCurrBG  := TBitmap.Create;
    LCurrPic := TBitmap.Create;
    if (ACurrBG.Width = ANewBG.Width) and (ACurrBG.Height = ANewBG.Height) then
    begin
      LCurrBG.Assign(ACurrBG);
      LCurrPic.Assign(ACurrPic);
    end else begin
      LCurrBG.Width   := ANewBG.Width;
      LCurrBG.Height  := ANewBG.Height;
      LCurrBG.Canvas.StretchDraw(Rect(0, 0, ANewBG.Width, ANewBG.Height), ACurrBG);

      LCurrPic.Width  := ANewBG.Width;
      LCurrPic.Height := ANewBG.Height;
      LCurrPic.Canvas.StretchDraw(Rect(0, 0, ANewBG.Width, ANewBG.Height), ACurrPic);
    end;
    LCurrBG.PixelFormat := pf24bit;
    LCurrPic.PixelFormat := pf24bit;

    for LCountY := ANewBG.Height - 1 downto 0 do
    begin
      LNewBGPix := ANewBG.ScanLine[LCountY];
      LCurrBGPix := LCurrBG.ScanLine[LCountY];
      LCurrPicPix := LCurrPic.ScanLine[LCountY];
      for LCountX := ANewBG.Width - 1 downto 0 do
      begin
        if not(LIsSameCol(LCurrBGPix, LCurrPicPix)) then
          LNewBGPix^ := LCurrPicPix^;
        inc(LNewBGPix);
        inc(LCurrBGPix);
        inc(LCurrPicPix);
      end;
    end;


    LCurrBG.Free;
    LCurrPic.Free;
    result := True;
  end else
    result := False;
end;

Und jetzt der Beispielaufruf mit dem das ganze bei den leicht unterschiedlichen Bildern doch funktioniert:

Delphi-Quellcode:

var LBmpNewBG, LBmpBG, LBmp: TBitmap;
begin
  //Erstellen und Laden der Bitmaps
  LBmpNewBG := TBitmap.Create;  //neuer Hintergrund
  LBmpBG    := TBitmap.Create;  //Hintergrund von dem Bild mit Mann
  LBmp      := TBitmap.Create;  //Bild wo Mann und Hintergrund drauf sind
  LBmpNewBG.LoadFromFile('newbg.bmp');
  LBmpBG.LoadFromFile('manbg.bmp');
  LBmp.LoadFromFile('man.bmp');

  //mit einem Toleranzwert von 10 klappt das ganze dann doch. Wenn also ein Blauwert 75 ist und der andere 78 zählt der Blauwert des Pixels als identisch
  TransferPicPart(LBmpNewBG, LBmpBG, LBmp, 10);
  Image1.Picture.Graphic := LBmpNewBG;

  LBmp.Free;
  LBmpBG.Free;
  LBmpNewBG.Free;

[mimi]

irgenwie verstehe ich den aufrufe nicht:
ich habe 4. Timage komponenten:
Image1: Ohne man also nur der orgeinal hintergrund
Image2:Hintergrund mit Man
Image3: Der neue hintergrund
Image4: dort soll der neu hintergrund mit dem Man angezeigt werden.
TransferPicPart(Image3.Picture.Bitmap, Image1.Picture.Bitmap, Image2.Picture.Bitmap, 10);
so habe ich es versucht und es wird in image4 nichts angezeigt

[SirThornberry]

das bild wird dann in image3 geändert. Da mit Scanline gearbeitet wird musst du dem TImage auch sagen das es sich updaten soll bzw. das form mal minimieren und dann neu hochbringen, dann siehst du das sich was geändert hat.

Du kannst es auch so machen:

Delphi-Quellcode:

//Damit bekommt Image4 den Hintergrund von Image3
Image4.Picture.Graphic := Image3.Picture.Bitmap;
//Und jetzt wird auf Image4 noch der Mann gemalt
TransferPicPart(Image4.Picture.Bitmap, Image1.Picture.Bitmap, Image2.Picture.Bitmap, 10);

[mimi]

besten dank:
ich hatte es so versucht

Delphi-Quellcode:

  TransferPicPart(Image3.Picture.Bitmap, Image1.Picture.Bitmap, Image2.Picture.Bitmap, 10);
  Image4.Picture.Graphic := Image3.Picture.Bitmap;

so hat es auch funktioniert zum schluss, aber ich mache es jetzt so wie du es vorgeschlagen hast.
Vielen Dank nochmals.....