Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Реализация эффекта RGB Plasma на Delphi и Pascal: примеры кода и демонстрации

Delphi , Графика и Игры , Цвета и Палитра

 

В мире демосцены и компьютерной графики эффект "плазмы" занимает особое место. В этой статье мы рассмотрим, как создать эффект RGB Plasma с использованием Object Pascal (Delphi) и библиотеки BGRABitmap, вдохновленный классическими техниками, использовавшимися на компьютере Amiga.

Что такое RGB Plasma?

Plasma - это эффект плавно меняющихся цветовых градиентов, создающий впечатление "жидкого" или "органического" движения. На Amiga этот эффект достигался с помощью специального чипа Copper, который позволял изменять параметры изображения в реальном времени.

Базовый пример RGB Plasma

Рассмотрим первую версию кода, который создает эффект плазмы с вертикальными полосами:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
  StdCtrls, BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes, Math;

type
  { TForm1 }
  TForm1 = class(TForm)
    BGRAVirtualScreen1: TBGRAVirtualScreen;
    Panel1: TPanel;
    Green2_Spin: TSpinEdit;
    Blue3_Spin: TSpinEdit;
    Title_label: TLabel;
    Red1_Spin: TSpinEdit;
    Timer1: TTimer;
    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;
  LOffset,red1,green2,blue3 : integer;
  Line_dir : Integer;
  img : TBGRABitmap;
  cnt : single;
  YOffset,YOffset2,YOffset3 : integer;
  cop1,cop2,cop3 : TBGRABitmap;

implementation

{$R *.lfm}

procedure copper_bar(Bitmap: TBGRABitmap; xpos,y: Integer; baseR, baseG, baseB: Byte);
var
  i: Integer;
  r, g, b: Byte;
  y1, y2: Integer;
begin
  // Градиент от 0 до максимального значения цвета
  for i := 0 to 15 do
  begin
    r := Min(baseR * i div 15, 255);
    g := Min(baseG * i div 15, 255);
    b := Min(baseB * i div 15, 255);
    y1 := y + i * 2;
    y2 := y1 + 4;
    bitmap.FillRect(xpos, y1*8, xpos+8, y2*16, BGRA(r, g, b,130), dmSet);
  end;

  // Градиент от максимального значения до 0
  for i := 0 to 14 do
  begin
    r := Max(baseR - (baseR * (i + 1) div 15), 0);
    g := Max(baseG - (baseG * (i + 1) div 15), 0);
    b := Max(baseB - (baseB * (i + 1) div 15), 0);
    y1 := y + 34 + i * 2;
    y2 := y1 + 2;
    Bitmap.FillRect(xpos, y1*8, xpos+8, y2*16, BGRA(r, g, b,130), dmSet);
  end;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  cop1 := TBGRABitmap.Create(680,520);
  cop2 := TBGRABitmap.Create(680,520);
  cop3 := TBGRABitmap.Create(680,520);
  cnt := 0;
end;

procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
var
  i : Integer;
begin
  for i:=0 to 182 do
  begin
    YOffset  := Round(Sin((cnt + Time + i) * 0.02) * 10);
    YOffset2 := Round(Sin((cnt + Time - i) * 0.05) * 10);
    YOffset3 := Round(Sin((cnt - Time + i) * 0.07) * 10);

    copper_bar(cop1, i * 4,  YOffset,  red1, 0,0);
    copper_bar(cop2, i * 4,  YOffset2, 0, green2,0);
    copper_bar(cop3, i * 4,  YOffset3, 0, 0,blue3);
  end;

  bitmap.PutImage(0,0,cop1,dmxor);
  bitmap.PutImage(0,0,cop2,dmxor);
  bitmap.PutImage(0,0,cop3,dmxor);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  red1   := Red1_Spin.Value;
  green2 := Green2_Spin.Value;
  blue3  := Blue3_Spin.Value;
  cnt := cnt + 1.2;
  BGRAVirtualScreen1.RedrawBitmap;
end;

end.

Улучшенная версия с горизонтальными полосами

Следующий пример демонстрирует более сложный эффект с горизонтальными полосами:

procedure TForm1.copper_bar(Bitmap: TBGRABitmap; xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);
var
  i: Integer;
  r, g, b: Byte;
  y1, y2,sz,v: Integer;
begin
  sz :=680;
  v  := 0;
  Bitmap.FillRect(0,0,BGRAVirtualScreen1.Width,BGRAVirtualScreen1.Height,bgra(0,0,0),dmset);

  // Восходящий градиент
  for i := 0 to 15 do
  begin
    r := Min(baseR * i div 15, 255);
    g := Min(baseG * i div 15, 255);
    b := Min(baseB * i div 15, 255);
    y1 := y + i * ysize;
    y2 := y1 + ysize;
    v := i*ysize;
    bitmap.FillRect(xpos, y1, xpos+sz, y2, BGRA(r, g, b,255), dmSet);
  end;

  // Нисходящий градиент
  for i := 0 to 15 do
  begin
    r := Max(baseR - (baseR * i div 15), 0);
    g := Max(baseG - (baseG * i div 15), 0);
    b := Max(baseB - (baseB * i div 15), 0);
    y1 := (y + v + i * ysize);
    y2 := y1 + ysize;
    Bitmap.FillRect(xpos, y1, xpos+sz, y2, BGRA(r, g, b,255), dmSet);
  end;
end;

Эффект с текстом

Интересный вариант - совмещение эффекта плазмы с текстом:

procedure DrawMaskedText(Bitmap: TBGRABitmap; const Txt: string; x, y: Integer);
var
  TextMask: TBGRABitmap;
  BarsBitmap: TBGRABitmap;
  i : integer;
begin
  TextMask := TBGRABitmap.Create(Bitmap.Width, Bitmap.Height, BGRAPixelTransparent);
  TextMask.FontHeight := 44;
  TextMask.FontStyle := [fsBold];
  TextMask.TextOut(x, y, Txt, BGRAWhite);

  BarsBitmap := TBGRABitmap.Create(Bitmap.Width, Bitmap.Height, BGRAPixelTransparent);

  for i := 0 to 8 do
  begin
    copper_bar(BarsBitmap, 0 , i*64, red1, green2, blue3);
  end;

  BarsBitmap.ApplyMask(TextMask);
  Bitmap.PutImage(0, 0, BarsBitmap, dmDrawWithTransparency);

  BarsBitmap.Free;
  TextMask.Free;
end;

Растеризация с эффектом плазмы

Для создания эффекта "растеризации" можно использовать следующий подход:

procedure TForm1.Raster_bar(Bitmap: TBGRABitmap; xpos,y,ysize: Integer; baseR, baseG, baseB: Byte);
var
  i,v: Integer;
  r, g, b: Byte;
begin
  v  := 0;
  Bitmap.FillRect(0,0,BGRAVirtualScreen1.Width,ysize,bgra(0,0,0),dmset);

  // 32 полосы по 8 пикселей (всего 256 пикселей)
  for i := 0 to 31 do
  begin
    r := Min(baseR * i div 31, 255);
    g := Min(baseG * i div 31, 255);
    b := Min(baseB * i div 31, 255);
    v := i*8;
    bitmap.FillRect(xpos+i*8, y, xpos+i*8+8, y+ysize, BGRA(r, g, b,255), dmSet);
  end;

  for i := 0 to 31 do
  begin
    r := Max(baseR - (baseR * (i+1) div 31), 0);
    g := Max(baseG - (baseG * (i+1) div 31), 0);
    b := Max(baseB - (baseB * (i+1) div 31), 0);
    Bitmap.FillRect(xpos+v+(i*8), y, xpos+v+(i*8)+8, y+ysize, BGRA(r, g, b,255), dmSet);
  end;
end;

Советы по оптимизации

  1. Используйте предварительное вычисление значений - для плавности анимации можно предварительно вычислять значения синусов.

  2. Оптимизируйте количество перерисовок - устанавливайте оптимальный интервал таймера.

  3. Экспериментируйте с режимами смешивания - кроме dmXor, попробуйте dmLinearBlend, dmDrawWithTransparency.

  4. Используйте кэширование - если некоторые элементы не меняются, рисуйте их в отдельный битмап один раз.

Заключение

Эффект RGB Plasma - это отличный способ изучить работу с графикой в Delphi и Pascal. Представленные примеры демонстрируют различные подходы к созданию этого эффекта, от простых вертикальных полос до сложных композиций с текстом и анимацией. Библиотека BGRABitmap предоставляет все необходимые инструменты для реализации таких эффектов с высокой производительностью.

Экспериментируя с параметрами, цветами и алгоритмами, вы можете создавать уникальные визуальные эффекты, которые напоминают классическую демосцену или открывают новые возможности в компьютерной графике.

Создано по материалам из источника по ссылке.

Статья о реализации эффекта RGB Plasma на Delphi и Pascal с использованием библиотеки BGRABitmap, включающая примеры кода и советы по оптимизации.


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

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




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Цвета и Палитра ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-07-04 03:28:19/0.0063211917877197/0