Как работать с Fade для TImage

Delphi , Графика и Игры , Изображения

Автор: http://www.swissdelphicenter.ch

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..32767] of TRGBTriple;

  /////////////////////////////////////////////////
  //                  Fade In                    //
  /////////////////////////////////////////////////

procedure FadeIn(ImageFileName: TFileName);
var
  Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow: PRGBTripleArray;
  x, y, step: integer;
begin
  // Bitmaps vorbereiten / Preparing the Bitmap //
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit //
    Bitmap.LoadFromFile(ImageFileName);
    BaseBitmap := TBitmap.Create;
    try
      BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      // Fading //
      for step := 0 to 32 do
      begin
        for y := 0 to (Bitmap.Height - 1) do
        begin
          BaseRow := BaseBitmap.Scanline[y];
          // Farben vom Endbild holen / Getting colors from final image //
          Row := Bitmap.Scanline[y];
          // Farben vom aktuellen Bild / Colors from the image as it is now //
          for x := 0 to (Bitmap.Width - 1) do
          begin
            Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5;
              // Fading //
            Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;
        Form1.Canvas.Draw(0, 0, Bitmap);
          // neues Bild ausgeben / Output new image //
        InvalidateRect(Form1.Handle, nil, False);
        // Fenster neu zeichnen / Redraw window //
        RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      BaseBitmap.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;

/////////////////////////////////////////////////
//                  Fade Out                   //
/////////////////////////////////////////////////

procedure FadeOut(ImageFileName: TFileName);
var
  Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow: PRGBTripleArray;
  x, y, step: integer;
begin
  // Bitmaps vorbereiten / Preparing the Bitmap //
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit //
    Bitmap.LoadFromFile(ImageFileName);
    BaseBitmap := TBitmap.Create;
    try
      BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      // Fading //
      for step := 32 downto 0 do
      begin
        for y := 0 to (Bitmap.Height - 1) do
        begin
          BaseRow := BaseBitmap.Scanline[y];
          // Farben vom Endbild holen / Getting colors from final image //
          Row := Bitmap.Scanline[y];
          // Farben vom aktuellen Bild / Colors from the image as it is now //
          for x := 0 to (Bitmap.Width - 1) do
          begin
            Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5;
              // Fading //
            Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;
        Form1.Canvas.Draw(0, 0, Bitmap);
          // neues Bild ausgeben / Output new image //
        InvalidateRect(Form1.Handle, nil, False);
        // Fenster neu zeichnen / Redraw window //
        RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      BaseBitmap.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FadeIn('C:\TestImage.bmp')
end;

{*****************************}
{by Yucel Karapinar, ykarapinar@hotmail.com }

{ Only for 24 ve 32 bits bitmaps }

procedure FadeOut(const Bmp: TImage; Pause: Integer);
var
  BytesPorScan, counter, w, h: Integer;
  p: pByteArray;
begin
  if not (Bmp.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
    raise Exception.Create('Error, bitmap format is not supporting.');
  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;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FadeOut(Image1, 1);
end;

Код, предоставленный в этом проекте Delphi, демонстрирует создание эффекта fade-in и fade-out для изображения с помощью компонентов TBitmap и TCanvas.

Процедура FadeIn Эта процедура принимает имя файла изображения в качестве входного параметра и применяет эффект fade-in к нему. Вот, что код делает:

1. Создает два объекта TBitmap, Bitmap и BaseBitmap.
2. Загружает указанное изображение в файле в Bitmap с помощью LoadFromFile.
3. Присваивает загруженное изображение BaseBitmap.
4. Проводит 33 раза (от шага = 0 до 32) следующие операции:
   • Для каждой итерации рассчитывает фактор.fade (step) и использует его для смешивания цветов оригинального изображения с цветами базового изображения.
   • Рисует полученное изображение на Form1.Canvas.
   • Невалидит окно и перерисовывает его с помощью RedrawWindow.

Процедура FadeOut Эта процедура принимает имя файла изображения в качестве входного параметра и применяет эффект fade-out к нему. Код похож на процедуру FadeIn, но проходит в обратном порядке (от шага = 32 до 0).

Использование Чтобы использовать эти процедуры, создайте два кнопки (Button1 и Button2) на вашем форме и добавьте следующий код:

procedure TForm1.Button1Click(Sender: TObject);
begin
  FadeIn('C:\TestImage.bmp');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FadeOut(Image1, 1); // Image1 - компонент TImage на вашем форме
end;

Ограничения Предоставленный код работает только с 24- и 32-битными изображениями. Если вы попытаетесь использовать его с другими форматами, он будет вызывать исключение.

Кроме того, эффект fade-out использует функцию Sleep для задержки на указанный интервал (1 миллисекунда в этом случае). Это может не быть подходящим для всех сценариев, особенно если вы работаете с анимациями или приложениями GUI, которые требуют точного времени.

Статья описывает использование компонента TImage в Delphi для выполнения эффекта fade-in и fade-out изображений.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Изображения ::