Bitmap Fadeout

procedure FadeOut(const BMP:TImage; Pause:integer) ;
   var
    BytesPorScan : integer;
    w,h : integer;
    p : pByteArray;
    counter : integer;
   begin
      If Not (BMP.Picture.Bitmap.PixelFormat
              in [pf24Bit, pf32Bit])
       then raise exception.create
          ('Error, Bitmap format not supported.') ;
      try
       BytesPorScan:=
        Abs(Integer(BMP.Picture.Bitmap.ScanLine[1])-
            Integer(BMP.Picture.Bitmap.ScanLine[0])) ;
      except
        raise exception.create('Error') ;
      end;
      for counter:=1 to 256 do
      begin
        for h:=0 to BMP.Picture.Bitmap.Height-1 do
        begin
          P:=BMP.Picture.Bitmap.ScanLine[h];
          for w:=0 to BytesPorScan-1 do
            if P^[w] >0 then P^[w]:=P^[w]-1;
        end;
        Sleep(Pause) ;
      BMP.Refresh;
      end;
end;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
begin
    FadeOut(Image1, 5) ;
end;