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