понедельник, 6 октября 2025 г.

Пример кода на Delphi и OpenGL. Три разных варианта пламени

Выкладываю три варианта пламени, визуальные эффекты получились прикольные.

1) Пламя зелёное

Рисунок 1. Пример работы программы зелёного пламени

Код проекта:

unit ogl_p9_u1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, dglOpenGL, Math;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    procedure tmr1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    FireTexture: GLuint;
    buffer: array[0..199, 0..319] of Word;
    h_DC: HDC;     // Хранение контекста устройства
    h_RC: HGLRC;   // Хранение контекста рендеринга
    procedure InitGL;
    procedure SetupViewport;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitGL; // Исправлено имя процедуры инициализации
  Randomize;
  FillChar(buffer, SizeOf(buffer), 0);
  tmr1.Interval := 50;
end;

procedure TForm1.InitGL;
begin
  // Инициализация OpenGL
  InitOpenGL; // Инициализация библиотеки
  h_DC := GetDC(Handle);
  
  // Создание контекста с правильными атрибутами
  h_RC := CreateRenderingContext(h_DC, [opDoubleBuffered], 32, 24, 8, 0, 0, 0);
  ActivateRenderingContext(h_DC, h_RC);

  // Настройка параметров OpenGL
  glClearColor(0.0, 0.0, 0.0, 1.0); // Черный фон
  SetupViewport;

  // Создание текстуры с правильным форматом
  glGenTextures(1, @FireTexture);
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
  glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 320, 200, 0, 
               GL_RGB, GL_UNSIGNED_SHORT_5_6_5, nil); // Исправлен формат
end;

procedure TForm1.SetupViewport;
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluOrtho2D(0, 320, 200, 0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
  x, y, xPrev, xNext: Integer;
  sum: Cardinal;
begin
  // Активация контекста перед использованием
  ActivateRenderingContext(h_DC, h_RC);

  // Генерация новых пикселей
  for x := 0 to 319 do
    buffer[199, x] := IfThen(Random(2) = 1, $F800, $0000);

  // Распространение пламени
  for y := 198 downto 0 do
    for x := 0 to 319 do
    begin
      xPrev := (x - 1 + 320) mod 320;
      xNext := (x + 1) mod 320;
      sum := buffer[y+1, xPrev] + buffer[y+1, x] + buffer[y+1, xNext];
      //buffer[y, x] := sum div 3;
      buffer[y, x] := (sum div 3) and $FFE0; // Уменьшаем интенсивность
    end;

  // Обновление текстуры
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, 320, 200, 
                 GL_RGB, GL_UNSIGNED_SHORT_5_6_5, @buffer[0][0]);

  // Отрисовка
  glClear(GL_COLOR_BUFFER_BIT);
  glEnable(GL_TEXTURE_2D);
  glBegin(GL_QUADS);
    glTexCoord2f(0, 0); glVertex2f(0, 0);
    glTexCoord2f(1, 0); glVertex2f(320, 0);
    glTexCoord2f(1, 1); glVertex2f(320, 200);
    glTexCoord2f(0, 1); glVertex2f(0, 200);
  glEnd;

  SwapBuffers(h_DC); // Используем сохраненный контекст
end;



procedure TForm1.FormDestroy(Sender: TObject);
begin
   // Корректное удаление ресурсов
  glDeleteTextures(1, @FireTexture);
  wglMakeCurrent(0, 0);
  wglDeleteContext(h_RC);
  ReleaseDC(Handle, h_DC);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  ActivateRenderingContext(h_DC, h_RC); // Активируем контекст
  SetupViewport;
  Invalidate;
end;

end.

2) Пламя синие

Рисунок 2. Пример работы программы синего пламени

Код проекта:

unit ogl_p10_u1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, dglOpenGL, Math;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    FireTexture: GLuint;
    FirePalette: array[0..255] of TRGBQuad;
    buffer: array[0..199, 0..319] of Byte;
    h_DC: HDC;
    h_RC: HGLRC;
    procedure InitGL;
    procedure SetupViewport;
    procedure GeneratePalette;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitGL;
  Randomize;
  FillChar(buffer, SizeOf(buffer), 0);
  GeneratePalette;
  tmr1.Interval := 50;
end;

procedure TForm1.GeneratePalette;
var
  i: Integer;
begin
  // Правильная огненная палитра (красный -> оранжевый -> желтый)
  for i := 0 to 255 do
  begin
    // Черное ядро пламени
    if i < 32 then
    begin
      FirePalette[i].rgbRed := i * 2;
      FirePalette[i].rgbGreen := 0;
      FirePalette[i].rgbBlue := 0;
    end
    // Красная зона
    else if i < 96 then
    begin
      FirePalette[i].rgbRed := 255;
      FirePalette[i].rgbGreen := (i - 32) * 4;
      FirePalette[i].rgbBlue := 0;
    end
    // Оранжевая зона
    else if i < 160 then
    begin
      FirePalette[i].rgbRed := 255;
      FirePalette[i].rgbGreen := 128 + (i - 96) * 2;
      FirePalette[i].rgbBlue := (i - 96) * 4;
    end
    // Желтое ядро
    else
    begin
      FirePalette[i].rgbRed := 255;
      FirePalette[i].rgbGreen := 255;
      FirePalette[i].rgbBlue := (i - 160) * 16;
    end;
  end;
end;

procedure TForm1.InitGL;
begin
  InitOpenGL;
  h_DC := GetDC(Handle);
  
  h_RC := CreateRenderingContext(h_DC, [opDoubleBuffered], 32, 24, 8, 0, 0, 0);
  ActivateRenderingContext(h_DC, h_RC);

  glClearColor(0.0, 0.0, 0.0, 1.0);
  SetupViewport;

  glGenTextures(1, @FireTexture);
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 320, 200, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
end;

procedure TForm1.SetupViewport;
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluOrtho2D(0, 320, 200, 0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
  x, y, xPrev, xNext: Integer;
  sum: Integer;
  rgbBuffer: array[0..199, 0..319] of TRGBQuad;
begin
  // Генерация огня с большей интенсивностью
  for x := 0 to 319 do
    buffer[199, x] := 160 + Random(96);  // Старт с горячих цветов

  // Улучшенный алгоритм распространения
  for y := 198 downto 0 do
    for x := 0 to 319 do
    begin
      xPrev := (x - 1 + 320) mod 320;
      xNext := (x + 1) mod 320;

      sum := buffer[y+1, xPrev] + 
             buffer[y+1, x] * 2 + 
             buffer[y+1, xNext] + 
             buffer[y+2, x] + 
             Random(4);  // Добавляем шум

      //buffer[y, x] := Max(0, (sum div 5) - 1);
      buffer[y, x] := Max(0, (sum div 5) - (y div 70)); // Усиливаем затухание с высотой
    end;

  // Конвертация в RGB с коррекцией цвета
  for y := 0 to 199 do
    for x := 0 to 319 do
    begin
      // Применяем гамма-коррекцию
      rgbBuffer[y, x] := FirePalette[Min(255, buffer[y, x] * 2)];
      rgbBuffer[y, x].rgbBlue := rgbBuffer[y, x].rgbBlue div 4;  // Уменьшаем синий
    end;

  // Обновление текстуры
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, 320, 200, 
                 GL_RGBA, GL_UNSIGNED_BYTE, @rgbBuffer);

  // Рендеринг
  glClear(GL_COLOR_BUFFER_BIT);
  glEnable(GL_TEXTURE_2D);

  glBegin(GL_QUADS);
    glTexCoord2f(0, 0); glVertex2f(0, 0);
    glTexCoord2f(1, 0); glVertex2f(320, 0);
    glTexCoord2f(1, 1); glVertex2f(320, 200);
    glTexCoord2f(0, 1); glVertex2f(0, 200);
  glEnd;

  SwapBuffers(h_DC);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  glDeleteTextures(1, @FireTexture);
  wglMakeCurrent(0, 0);
  wglDeleteContext(h_RC);
  ReleaseDC(Handle, h_DC);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  ActivateRenderingContext(h_DC, h_RC);
  SetupViewport;
  Invalidate;
end;

end.

3) Пламя красное

Рисунок 3. Пример работы программы красного пламени 

 Код проекта:

unit ogl_p11_u1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, dglOpenGL, Math;

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
    FireTexture: GLuint;
    FirePalette: array[0..255] of TRGBQuad;
    buffer: array[0..199, 0..319] of Byte;
    h_DC: HDC;
    h_RC: HGLRC;
    procedure InitGL;
    procedure SetupViewport;
    procedure GeneratePalette;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitGL;
  Randomize;
  FillChar(buffer, SizeOf(buffer), 0);
  GeneratePalette;
  tmr1.Interval := 50;
end;

procedure TForm1.GeneratePalette;
var
  i: Integer;
begin
  // Правильная огненная палитра (без синих оттенков)
  for i := 0 to 255 do
  begin
    case i of
      0..63:   // Черный -> Темно-красный
      begin
        FirePalette[i].rgbRed := i;
        FirePalette[i].rgbGreen := 0;
        FirePalette[i].rgbBlue := 0;
      end;
      64..127: // Красный -> Оранжевый
      begin
        FirePalette[i].rgbRed := 255;
        FirePalette[i].rgbGreen := (i - 64) * 2;
        FirePalette[i].rgbBlue := 0;
      end;
      128..191: // Оранжевый -> Желтый
      begin
        FirePalette[i].rgbRed := 255;
        FirePalette[i].rgbGreen := 128 + (i - 128);
        FirePalette[i].rgbBlue := 0;
      end;
      192..255: // Желтый -> Белый
      begin
        FirePalette[i].rgbRed := 255;
        FirePalette[i].rgbGreen := 255;
        FirePalette[i].rgbBlue := (i - 192) * 4;
      end;
    end;
  end;
end;

procedure TForm1.InitGL;
begin
  InitOpenGL;
  h_DC := GetDC(Handle);
  
  h_RC := CreateRenderingContext(h_DC, [opDoubleBuffered], 32, 24, 8, 0, 0, 0);
  ActivateRenderingContext(h_DC, h_RC);

  glClearColor(0.0, 0.0, 0.0, 1.0);
  SetupViewport;

  glGenTextures(1, @FireTexture);
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA8, 320, 200, 0, GL_BGRA, GL_UNSIGNED_BYTE, nil);
end;

procedure TForm1.SetupViewport;
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluOrtho2D(0, 320, 200, 0);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  glDeleteTextures(1, @FireTexture);
  wglMakeCurrent(0, 0);
  wglDeleteContext(h_RC);
  ReleaseDC(Handle, h_DC);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  ActivateRenderingContext(h_DC, h_RC);
  SetupViewport;
  Invalidate;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
  x, y, xPrev, xNext: Integer;
  sum: Integer;
  rgbBuffer: array[0..199, 0..319] of TRGBQuad;
begin
  // Генерация основания пламени с большей интенсивностью
  for x := 0 to 319 do
    buffer[199, x] := Min(255, 192 + Random(64));

  // Улучшенный алгоритм распространения пламени
  for y := 198 downto 0 do
    for x := 0 to 319 do
    begin
      xPrev := (x - 1 + 320) mod 320;
      xNext := (x + 1) mod 320;

      // Новое ядро пламени с турбулентностью
      sum := (buffer[y+1, xPrev] +
             buffer[y+1, x] * 2 +
             buffer[y+1, xNext] +
             buffer[y+2, x] * 2) div 6;

      // Добавляем случайные колебания
      buffer[y, x] := Max(0, sum - 1 + Random(3) - 1);
    end;

  // Конвертация в RGB
  for y := 0 to 199 do
    for x := 0 to 319 do
      rgbBuffer[y, x] := FirePalette[Min(255, buffer[y, x] + Random(8))];

  // Обновление текстуры
  glBindTexture(GL_TEXTURE_2D, FireTexture);
  glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, 320, 200,
                 GL_BGRA, GL_UNSIGNED_BYTE, @rgbBuffer);

  // Рендеринг
  glClear(GL_COLOR_BUFFER_BIT);
  glEnable(GL_TEXTURE_2D);
  glBegin(GL_QUADS);
    glTexCoord2f(0, 0); glVertex2f(0, 0);
    glTexCoord2f(1, 0); glVertex2f(320, 0);
    glTexCoord2f(1, 1); glVertex2f(320, 200);
    glTexCoord2f(0, 1); glVertex2f(0, 200);
  glEnd;

  SwapBuffers(h_DC);
end;

end.

Комментариев нет:

Отправить комментарий