// Die Pixel einer Farbe in einem Bitmap werden transparent

// Getestet mit D4 unter Win98 und XP


Variante 1: Mittels der Prozedur Canvas.Draw

var 
  bm: TBitmap; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  bm := tbitmap.create; 
  bm.loadfromfile('D:\Bilder\bingo.bmp'); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bm.free; 
end; 
 
procedure drawt(cnv: TCanvas; bild: TBitmap; leer: TColor; x, y: Integer); 
begin 
  bild.transparent := true; 
  bild.transparentcolor := leer; 
  cnv.draw(x, y, bild); 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  drawt(form1.canvas, bm, clblack, 100, 50); 
end;



//-----------------------------------------------------------

Variante 2: Mittels BitBlt

var 
  bmp1, bmp2, bmp3, bmp4: TBitmap; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  bmp1 := TBitmap.Create; 
  bmp2 := TBitmap.Create; 
  bmp3 := TBitmap.Create; 
  bmp4 := TBitmap.Create; 
  bmp2.Monochrome := true; 
  bmp3.Monochrome := true; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bmp1.Free; 
  bmp2.Free; 
  bmp3.Free; 
  bmp4.Free; 
end; 
 
procedure DrawT(Cnv: TCanvas; x, y: Integer; Bmp: TBitmap; clTransparent: TColor); 
begin 
  bmp1.Width := Bmp.Width; bmp1.Height := Bmp.Height; 
  bmp2.Width := Bmp.Width; bmp2.Height := Bmp.Height; 
  bmp3.Width := Bmp.Width; bmp3.Height := Bmp.Height; 
  bmp4.Width := Bmp.Width; bmp4.Height := Bmp.Height; 
  BitBlt(bmp2.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY); 
  BitBlt(bmp3.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmp2.Canvas.Handle, 0, 0, NOTSRCCOPY); 
  BitBlt(bmp1.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY); 
  BitBlt(bmp1.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmp3.Canvas.Handle, 0, 0, SRCAND); 
  BitBlt(bmp4.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Cnv.Handle, x, y, SRCCOPY); 
  BitBlt(bmp4.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmp2.Canvas.Handle, 0, 0, SRCAND); 
  BitBlt(bmp4.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmp1.Canvas.Handle, 0, 0, SRCINVERT); 
  BitBlt(Cnv.Handle, x, y, Bmp.Width, Bmp.Height, bmp4.Canvas.Handle, 0, 0, SRCCOPY); 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button6Click(Sender: TObject); 
var b: TBitmap; 
begin 
  b := TBitmap.create; 
  b.loadfromfile('d:\bilder\bingo.bmp'); 
  drawt(canvas, 100, 100, b, clwhite); 
  b.free; 
end; 


//-----------------------------------------------------------

Variante 3: Mittels ScanLine

var 
  hintergr, objekt: TBitmap; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  hintergr := TBitmap.create; 
  objekt := TBitmap.create; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  hintergr.free; 
  objekt.free; 
end; 
 
procedure BildAufBild(i, j: integer; untergr, bild: TBitmap; transpa: TColor); 
var 
  pu, pb: PByteArray; 
  x, y, z, hoch, breit, links, oben: integer; 
  r, g, b: byte; 
begin 
  untergr.pixelformat := pf24bit; 
  bild.pixelformat := pf24bit; 
  if j < 0 then oben := abs(j) else oben := 0; 
  if i < 0 then links := i * -3 else links := 0; 
  if j + bild.height > untergr.height then 
    hoch := untergr.height - j - 1 
  else hoch := bild.height - 1; 
  if bild.width + i > untergr.width then 
    breit := (untergr.width - i) * 3 - 1 
  else breit := bild.width * 3 - 1; 
  z := i * 3; 
  transpa := colortorgb(transpa); 
  r := getrvalue(transpa); 
  g := getgvalue(transpa); 
  b := getbvalue(transpa); 
  for y := oben to hoch do begin 
    pb := bild.scanline[y]; 
    pu := untergr.scanline[y + j]; 
    x := links; 
    while x <= breit do begin 
      if (pb[x] <> b) or (pb[x + 1] <> g) or (pb[x + 2] <> r) 
        then begin 
        pu[x + z] := pb[x]; 
        pu[x + 1 + z] := pb[x + 1]; 
        pu[x + 2 + z] := pb[x + 2]; 
      end; 
      inc(x, 3); 
    end; 
  end; 
end; 
 
// -------- Beispielaufrufe ----------------- 
 
// Ein Bitmap wird auf ein anderes gezeichnet, 
// dabei werden alle weißen Flächen durchsichtig. 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  hintergr.loadfromfile('hintergrund.bmp'); 
  objekt.loadfromfile('objekt.bmp'); 
  BildAufBild(15, 5, hintergr, objekt, clWhite); 
  canvas.draw(20, 20, hintergr); 
end; 
 
 
// Ein Bitmap wird über Form1 gelegt, 
// alles schwarzen Stellen werden transparent. 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  hintergr.assign(GetFormImage); 
  objekt.loadfromfile('d:\bilder\bingo.bmp'); 
  BildAufBild(100, 100, hintergr, objekt, clBlack); 
  canvas.draw(0, 0, hintergr); 
end; 

//-----------------------------------------------------------

Variante 4: Mittels TransparentBlt. Erst ab NT verfügbar!

function TransparentBlt(DC: HDC; p2, p3, p4, p5: Integer; 
  DC6: HDC; p7, p8, p9, p10: Integer; p11: UINT): BOOL; stdcall; 
  external 'msimg32.dll' name 'TransparentBlt'; 
 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  TransparentBlt(canvas.handle, 500, 200, Image1.width, Image1.height, 
    Image1.canvas.handle, 0, 0, Image1.width, Image1.height, clWhite); 
end; 


Zugriffe seit 6.9.2001 auf Delphi-Ecke