Hintergrund ändern bei einem Bild

[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;