procedure TForm1.FormCreate(Sender: TObject); 
begin 
  doublebuffered := true; // bei D4 nicht unbedingt nötig
  Image1.autosize := true; 
  Image1.Picture.loadfromfile('c:\haus.bmp'); 
end; 
 
function rech(p, f: integer): byte; // für 1. und 2.
asm 
  cmp eax, edx 
  je @raus 
  jl @plus 
  sub eax, 4 
  cmp eax, edx 
  jge @raus 
  jmp @gleich 
 @plus: 
  add eax, 4 
  cmp eax, edx 
  jle @raus 
 @gleich: 
  mov eax, edx 
 @raus: 
end; 
 
// 1. --- Ein Bild wird mit einem anderen überblendet --- 
 
procedure FadeOver(Image: TImage; gr: TGraphic; Pause: byte); 
var 
  schritt, b3, w, h: integer; 
  p, p2: pByteArray; 
  hlp: TBitmap; 
begin 
  hlp := TBitmap.create; 
  hlp.width := Image.Picture.width; 
  hlp.height := Image.Picture.height; 
  if not (Image.Picture.Graphic is TBitmap) then begin 
    hlp.canvas.draw(0, 0, Image.Picture.Graphic); 
    Image.Picture.Bitmap.assign(hlp); 
  end; 
  Image.Picture.Bitmap.pixelformat := pf24bit; 
  hlp.pixelformat := pf24bit; 
  hlp.canvas.stretchdraw(rect(0, 0, hlp.width, hlp.height), gr); 
  b3 := hlp.width * 3; 
  schritt := 0; 
  repeat 
    for h := 0 to hlp.Height - 1 do begin 
      p := Image.Picture.Bitmap.ScanLine[h]; 
      p2 := hlp.ScanLine[h]; 
      w := 0; 
      while w < b3 do begin 
        p[w] := rech(p[w], p2[w]); 
        p[w + 1] := rech(p[w + 1], p2[w + 1]); 
        p[w + 2] := rech(p[w + 2], p2[w + 2]); 
        inc(w, 3); 
      end; 
    end; 
    sleep(pause); 
    Image.refresh; 
    inc(schritt, 4); 
  until schritt > 256; 
  hlp.free; 
end; 
 
// Beispielaufruf

procedure TForm1.Button2Click(Sender: TObject); 
var 
  jp: TJpegImage; 
begin 
  jp := TJpegImage.create; 
  jp.loadfromfile('c:\frau.jpg'); 
  FadeOver(Image1, jp, 35); 
  jp.free; 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
var 
  bm: TBitmap; 
begin 
  bm := TBitmap.create; 
  bm.loadfromfile('c:\haus.bmp'); 
  FadeOver(Image1, bm, 35); 
  bm.free; 
end; 
 
 
// 2. --- ein Bild "verschwindet" --- 
// ('Farbe' sollte die Hintergrundfarbe sein) 
 
procedure FadeOut(Image: TImage; Farbe: TColor; Pause: byte); 
var 
  schritt, b3, w, h: integer; 
  p: pByteArray; 
  r, g, b: byte; 
  hlp: TBitmap; 
begin 
  if not (Image.Picture.Graphic is TBitmap) then begin 
    hlp := TBitmap.create; 
    hlp.width := Image.Picture.width; 
    hlp.height := Image.Picture.height; 
    hlp.canvas.draw(0, 0, Image.Picture.Graphic); 
    Image.Picture.Bitmap.assign(hlp); 
    hlp.free; 
  end; 
  Image.Picture.Bitmap.pixelformat := pf24bit; 
  Farbe := ColorToRGB(Farbe); 
  r := getrvalue(Farbe); 
  g := getgvalue(Farbe); 
  b := getbvalue(Farbe); 
  b3 := Image.Picture.Bitmap.width * 3; 
  schritt := 0; 
  repeat 
    for h := 0 to Image.Picture.Bitmap.Height - 1 do begin 
      p := Image.Picture.Bitmap.ScanLine[h]; 
      w := 0; 
      while w < b3 do begin 
        p[w] := rech(p[w], b); 
        p[w + 1] := rech(p[w + 1], g); 
        p[w + 2] := rech(p[w + 2], r); 
        inc(w, 3); 
      end; 
    end; 
    sleep(pause); 
    Image.refresh; 
    inc(schritt, 4); 
  until schritt > 256; 
end; 

// Beispielaufruf
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  FadeOut(Image1, clBtnFace, 35); 
end;

procedure FadeIn(Image: TImage; Farbe: TColor; Pause: byte); 
var 
  schritt, b3, w, h, z: integer; 
  p, p2: pByteArray; 
  r, g, b: byte; 
  hlp: TBitmap; 
begin 
  Farbe := ColorToRGB(Farbe); 
  hlp := TBitmap.create; 
  hlp.pixelformat := pf24bit; 
  hlp.width := Image.Picture.width; 
  hlp.height := Image.Picture.height; 
  hlp.canvas.draw(0, 0, Image.Picture.graphic); 
  with Image.Picture.Bitmap do begin 
    pixelformat := pf24bit; 
    width := Image.width; 
    height := Image.height; 
    with canvas do begin 
      brush.color := Farbe; 
      fillrect(cliprect); 
    end; 
  end; 
  r := getrvalue(Farbe); 
  g := getgvalue(Farbe); 
  b := getbvalue(Farbe); 
  b3 := Image.Picture.Bitmap.width * 3; 
  schritt := 0; 
  repeat 
    z := 256 - schritt; 
    for h := 0 to Image.Picture.Bitmap.Height - 1 do begin 
      p := Image.Picture.Bitmap.ScanLine[h]; 
      p2 := hlp.ScanLine[h]; 
      w := 0; 
      while w < b3 do begin 
        p[w] := (b * z + p2[w] * schritt) shr 8; 
        p[w + 1] := (g * z + p2[w + 1] * schritt) shr 8; 
        p[w + 2] := (r * z + p2[w + 2] * schritt) shr 8; 
        inc(w, 3); 
      end; 
    end; 
    sleep(pause); 
    Image.refresh; 
    inc(schritt, 4); 
  until schritt > 256; 
  hlp.free; 
end; 
 
// Beispielaufruf,
// Image1 sollte zu Anfang leer sein
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Image1.picture.loadfromfile('c:\lm.jpg'); 
  FadeIn(Image1, color, 35); 
end;