uses jpeg; 
var 
  bm1, bm2: TBitmap; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  bm1 := TBitmap.create; 
  bm2 := TBitmap.create; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bm2.free; 
  bm1.free; 
end; 
 
function vermischt(gr1, gr2: TGraphic; xversatz, yversatz: integer; 
  Transparenz: byte): tbitmap; 
var x, y, h, b, l, o: integer; 
  p1, p2: PBytearray; 
  procedure zuweisen(bm: TBitmap; gr: TGraphic); 
  begin 
    if gr is TIcon then begin 
      bm.width := gr.width; 
      bm.height := gr.height; 
      bm.canvas.draw(0, 0, gr); 
    end else bm.assign(gr); 
  end; 
begin 
  zuweisen(bm1, gr1); 
  zuweisen(bm2, gr2); 
  bm1.pixelformat := pf24bit; 
  bm2.pixelformat := pf24bit; 
  result := bm1; 
  h := yversatz + bm2.height - 1; 
  if h > result.height - 1 then h := result.height - 1; 
  if yversatz < 0 then o := 0 else o := yversatz; 
  xversatz := xversatz * 3; 
  if xversatz < 0 then l := 0 else l := xversatz; 
  b := xversatz + bm2.width * 3 - 1; 
  if b > result.width * 3 - 1 then b := result.width * 3 - 1; 
  for y := o to h do begin 
    p1 := result.scanline[y]; 
    p2 := bm2.scanline[y - yversatz]; 
    for x := l to b do begin 
      p1[x] := (p1[x] * transparenz + p2[x - xversatz] * (255 - transparenz)) 
        div 255; 
    end; 
  end; 
end; 
 
// ein Bild wird nach rechts unten versetzt 
// halbtransparent über ein anderes Bildes gelegt 
procedure TForm1.Button3Click(Sender: TObject); 
var basis, auflage: tbitmap; 
  links, oben: integer; 
begin 
  basis := tbitmap.create; 
  auflage := tbitmap.create; 
  basis.loadfromfile('d:\bilder\m\b002.bmp'); 
  auflage.loadfromfile('d:\bilder\m\b005.bmp'); 
  links := basis.width div 3; 
  oben := basis.height div 3; 
  canvas.draw(0, 0, vermischt(basis, auflage, links, oben, 128)); 
  auflage.free; 
  basis.free; 
end; 
 
// ein Bild wird mit einem anderen überblendet 
procedure TForm1.Button4Click(Sender: TObject); 
var basis, auflage: tbitmap; 
  x, schwelle, stufe: byte; 
begin 
  x := 255; 
  schwelle := 170; 
  stufe := 3; 
  basis := tbitmap.create; 
  auflage := tbitmap.create; 
  basis.loadfromfile('d:\bilder\m\b002.bmp'); 
  auflage.loadfromfile('d:\bilder\m\b011.bmp'); 
  schwelle := (schwelle div stufe) * stufe; // Teilbarkeit sicherstellen 
  x := (x div stufe) * stufe; 
  canvas.draw(0, 0, basis); 
  repeat 
    dec(x, stufe); 
    canvas.draw(0, 0, vermischt(basis, auflage, 0, 0, x)); 
    application.processmessages; 
    if x = schwelle then x := stufe; 
  until x = 0; 
  auflage.free; 
  basis.free; 
end; 
 
// der untere Teil eines Bildes verschwindet von Form1 
procedure TForm1.Button5Click(Sender: TObject); 
var basis: TJpegImage; 
  auflage: tbitmap; 
  x, schwelle, stufe: byte; 
  halb: integer; 
begin 
  x := 245; 
  schwelle := 120; 
  stufe := 4; 
  basis := tjpegimage.create; 
  auflage := tbitmap.create; 
  basis.loadfromfile('d:\zeitung\monalisa.jpg'); 
  auflage.width := basis.width; 
  halb := basis.height div 2; 
  auflage.height := halb; 
  auflage.canvas.brush.color := color; 
  auflage.canvas.fillrect(auflage.canvas.cliprect); 
  x := (x div stufe) * stufe; 
  schwelle := (schwelle div stufe) * stufe; 
  canvas.draw(0, 0, basis); 
  repeat 
    dec(x, stufe); 
    canvas.draw(0, 0, vermischt(basis, auflage, 0, halb + 1, x)); 
    application.processmessages; 
    if x = schwelle then x := stufe; 
  until x = 0; 
  auflage.free; 
  basis.free; 
end; 
 
// ein Icon wird in ein JPeg eingeblendet 
procedure TForm1.Button6Click(Sender: TObject); 
var auflage: TIcon; 
  basis: TJPegImage; 
  x, schwelle, stufe: byte; 
begin 
  x := 255; 
  schwelle := 175; 
  stufe := 2; 
  auflage := ticon.create; 
  basis := tjpegimage.create; 
  auflage.loadfromfile('d:\icon2\raum.ico'); 
  basis.loadfromfile('d:\zeitung\monalisa.jpg'); 
  schwelle := (schwelle div stufe) * stufe; // Teilbarkeit sicherstellen 
  x := (x div stufe) * stufe; 
  canvas.draw(100, 100, basis); 
  repeat 
    dec(x, stufe); 
    canvas.draw(100, 100, vermischt(basis, auflage, 0, 0, x)); 
    application.processmessages; 
    sleep(50); 
    if x = schwelle then x := stufe; 
  until x = 0; 
  auflage.free; 
  basis.free; 
end;