// Hiermit kann eine Bitmap mit dem Scherenschnitt eines Bildes
// erstellt werden. Im ersten Fall transparent, im zweiten Fall
// mit einem Hintergrund bestimmter Farbe. Voraussetzung ist,
// dass die Quelle einen durchgehenden Hintergrund hat (hier blau).

// Getestet mit D2010 unter Win10
 

		Beispiel 1
		Beispiel 2

function schwarz(Src: TGraphic; Dst: TBitmap; TranspaColor: TColor; 
  Grund: PColor = nil): Boolean; 
var 
  hlp: TBitmap; 
begin 
  if Src.Transparent then 
    result := false 
  else 
  begin 
    Dst.Width := Src.Width; 
    Dst.Height := Src.Height; 
    Dst.Canvas.Draw(0, 0, Src); 
    Dst.Mask(TranspaColor); 
    if Grund <> nil then 
    begin 
      hlp := TBitmap.Create; 
      with hlp do 
      begin 
        Canvas.Brush.color := Grund^; 
        Width := Src.Width; 
        Height := Src.Height; 
        Canvas.Draw(0, 0, Dst); 
        Dst.Assign(hlp); 
        FreeAndNil(hlp); 
      end; 
    end; 
    result := True; 
  end; 
end; 
 
 
// Beispiel 1 
 
procedure TForm2.Button1Click(Sender: TObject); 
var 
  bmp: TBitmap; 
  entfernen: TColor; 
begin 
  bmp := TBitmap.Create; 
  bmp.LoadFromFile('D:\Bilder\Geld.bmp'); 
  Canvas.Draw(10, 10, bmp); 
  entfernen := bmp.Canvas.Pixels[0, 0]; 
  if schwarz(bmp, bmp, entfernen) then 
    Canvas.Draw(10 + bmp.Width, 10, bmp); 
  FreeAndNil(bmp); 
end; 
 
// Beispiel 2 
 
procedure TForm2.Button2Click(Sender: TObject); 
var 
  bmp: TBitmap; 
  entfernen, neu: TColor; 
begin 
  neu := clRed; 
  bmp := TBitmap.Create; 
  bmp.LoadFromFile('D:\Bilder\Geld.bmp'); 
  Canvas.Draw(10, 10, bmp); 
  entfernen := bmp.Canvas.Pixels[0, 0]; 
  if schwarz(bmp, bmp, entfernen, @neu) then 
    Canvas.Draw(10 + bmp.Width, 10, bmp); 
  FreeAndNil(bmp); 
end;