Плавное исчезание изображения в TBitmap

Тема в разделе "Delphi", создана пользователем WinHack, 27 ноя 2016.

  1. WinHack
    Поместите TImage (Image1) в Delphi, подготовьте и загрузите растровое изображение 24 или 32 бит в него; поместите TButton (Button1) и поместите этот код в его событие OnClick:

    Код:
    procedure TForm1.Button1Click(Sender: TObject) ;
    
       procedure FadeOut(const BMP:TImage; Pause:integer) ;
        var
         BytesPorScan : integer;
         w,h : integer;
         p : pByteArray;
         counter : integer;
    
        begin
           { Это работает только с 24 или 32 битными bitmaps }
           If Not (BMP.Picture.Bitmap.PixelFormat
                   in [pf24Bit, pf32Bit])
            then raise exception.create
               ('Ошибка, формат изображения не поддерживается.') ;
    
           try
            BytesPorScan:=
             Abs(Integer(BMP.Picture.Bitmap.ScanLine[1])-
                 Integer(BMP.Picture.Bitmap.ScanLine[0])) ;
           except
             raise exception.create('Error') ;
           end;
    
           { Уменьшаем RGB для каждого пиксела }
           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; {procedure FadeOut}
       begin {button1_click}
         FadeOut(Image1,5) ;
       end;