Порт графической сцены “Гром” с языка DarkBasic Pro на Lazarus 4.6 + SDL 2 + dglOpenGL + Debian 13

Пример кода порта графической сцены “Гром” с языка DarkBasic Pro на Lazarus 4.6 + SDL 2 + dglOpenGL + Debian 13. Медиа ресурсы которые использованы в графической сцене и сам исходный код на языке DarkBasic Pro можно скачать с сайта https://ant2on.narod.ru/source.htm или по прямой ссылке http://ant2on.narod.ru/download/storm.zip.

  

Рисунок 1. Пример работы программы "Гром"

 

program ogl_p5;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes,
  SysUtils,
  dglOpenGL,
  sdl2,
  sdl2_mixer,
  sdl2_ttf,
  Math;

const
  WINDOW_WIDTH  = 800;
  WINDOW_HEIGHT = 600;

type
  TRainDrop = record
    X, Y, Z: Single;
  end;

var
  Window: PSDL_Window = nil;
  GLContext: TSDL_GLContext = nil;
  Event: TSDL_Event;
  Running: Boolean = True;

  // Настройки симуляции
  NoRain: Integer = 100;
  CloudSize: Single = 500.0;
  CloudHeight: Single = 100.0;

  RainDrops: array of TRainDrop;
  SoundRain: PMIX_Music = nil;
  SoundThunder: PMix_Chunk = nil;
  FloorTextureID: GLuint;
  MatrixHeights: array[0..25, 0..25] of Single;

  // ---------- НОВАЯ СИСТЕМА КАМЕРЫ ----------
  CamX: Single = 5000.0;      // позиция камеры
  CamY: Single = 500.0;       // подняли начальную высоту для лучшего обзора
  CamZ: Single = 500.0;

  CamPitch: Single = 0.0;     // угол наклона (вверх/вниз)
  CamYaw: Single = -90.0;     // угол поворота (влево/вправо) – смотрим вдоль +Z? начальный угол -90 чтобы смотреть в сторону увеличения Z

  // Скорость и чувствительность
  MoveSpeed: Single = 300.0;   // единиц в секунду
  MouseSensitivity: Single = 0.2;

  // Флаги движения
  moveForward, moveBack, moveLeft, moveRight{, moveUp, moveDown}: Boolean;
  // НОВОЕ: Флаг захвата мыши
  MouseCaptured: Boolean = True;

  // Для дельты времени
  LastTime: UInt32 = 0;
  DeltaTime: Single = 0.0;

  ThunderActive: Boolean = False;
  Font: PTTF_Font = nil;

procedure InitFont;
begin
  if TTF_Init() = -1 then
  begin
    WriteLn('Ошибка TTF_Init: ', TTF_GetError());
    Exit;
  end;
  // Укажите путь к любому TTF-шрифту в вашей системе
  Font := TTF_OpenFont('/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf', 16);
  if Font = nil then
    WriteLn('Ошибка загрузки шрифта: ', TTF_GetError());
end;

procedure InitSystem;
var
  audio_rate: Integer;
  audio_format: Word;
  audio_channels: Integer;
  audio_buffers: Integer;
begin
  SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);

  if SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO) < 0 then
  begin
    WriteLn('Ошибка инициализации SDL2: ', SDL_GetError());
    Halt(1);
  end;

  audio_rate := 44100;
  audio_format := AUDIO_S16SYS;
  audio_channels := 2;
  audio_buffers := 2048;
  if Mix_OpenAudio(audio_rate, audio_format, audio_channels, audio_buffers) < 0 then
  begin
    WriteLn('Ошибка Mix_OpenAudio: ', Mix_GetError());
    SDL_Quit();
    Exit;
  end;

  SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
  SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
  SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
  SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 24);

  Window := SDL_CreateWindow(
    'SDL2 + dglOpenGL + Lazarus 4.6 + Debian 13',
    SDL_WINDOWPOS_CENTERED, SDL_WINDOWPOS_CENTERED,
    WINDOW_WIDTH, WINDOW_HEIGHT,
    SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN or SDL_WINDOW_RESIZABLE
  );
  if Window = nil then
    raise Exception.Create('Не удалось создать окно SDL2');

  GLContext := SDL_GL_CreateContext(Window);
  if GLContext = nil then
    raise Exception.Create('Не удалось создать контекст OpenGL');

  if not InitOpenGL then
    raise Exception.Create('Не удалось инициализировать dglOpenGL');
  ReadExtensions;
  ReadImplementationProperties;

  InitFont;

  // FIX: дальняя плоскость увеличена до 50000 (было 100)
  glViewport(0, 0, WINDOW_WIDTH, WINDOW_HEIGHT);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(45.0, WINDOW_WIDTH / WINDOW_HEIGHT, 0.1, 50000.0);
  glMatrixMode(GL_MODELVIEW);
  glClearColor(0.1, 0.1, 0.15, 1.0);

  // Включаем глубину
  glEnable(GL_DEPTH_TEST);
end;

procedure HandleResize(Width, Height: Integer);
begin
  if Height = 0 then Height := 1;
  glViewport(0, 0, Width, Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(45.0, Width / Height, 0.1, 50000.0);  // FIX
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
end;

// NEW: обработка ввода с клавиатуры (непрерывное состояние)
procedure ProcessKeyboardInput;
var
  KeyState: PUint8;
begin
  KeyState := SDL_GetKeyboardState(nil);
  moveForward := KeyState[SDL_SCANCODE_W] = 1;
  moveBack    := KeyState[SDL_SCANCODE_S] = 1;
  moveLeft    := KeyState[SDL_SCANCODE_A] = 1;
  moveRight   := KeyState[SDL_SCANCODE_D] = 1;
  //moveUp      := KeyState[SDL_SCANCODE_Q] = 1;   // подъём
  //moveDown    := KeyState[SDL_SCANCODE_E] = 1;   // спуск
end;

// NEW: обработка событий окна и клавиатуры
procedure HandleEvents;
begin
  while SDL_PollEvent(@Event) <> 0 do
  begin
    case Event.type_ of
      SDL_QUITEV: Running := False;
      SDL_WINDOWEVENT:
        if Event.window.event in [SDL_WINDOWEVENT_RESIZED, SDL_WINDOWEVENT_SIZE_CHANGED] then
          HandleResize(Event.window.data1, Event.window.data2);
      SDL_KEYDOWN:
        case Event.key.keysym.sym of
          SDLK_ESCAPE:
            begin
              if MouseCaptured then
              begin
                // Если мышь захвачена - освобождаем её, чтобы можно было нажать на кнопки окна
                SDL_SetRelativeMouseMode(SDL_FALSE);
                SDL_ShowCursor(SDL_ENABLE);
                MouseCaptured := False;
              end
              else
              begin
                // Если мышь уже свободна, повторное нажатие Esc закрывает игру
                Running := False;
              end;
            end;

          SDLK_F11:
            begin
              // Переключение полноэкранного режима (Borderless Fullscreen)
              if (SDL_GetWindowFlags(Window) and SDL_WINDOW_FULLSCREEN_DESKTOP) <> 0 then
                SDL_SetWindowFullscreen(Window, 0) // Выход из полноэкранного режима
              else
                SDL_SetWindowFullscreen(Window, SDL_WINDOW_FULLSCREEN_DESKTOP); // Разворот на весь экран
            end;
        end;

      SDL_MOUSEBUTTONDOWN:
        begin
          // Если мышь свободна и пользователь кликнул по окну, захватываем её обратно
          if not MouseCaptured then
          begin
            SDL_SetRelativeMouseMode(SDL_TRUE);
            SDL_ShowCursor(SDL_DISABLE);
            MouseCaptured := True;
          end;
        end;

      SDL_MOUSEMOTION:
        begin
          // Вращение камеры мышью (только если мышь захвачена)
          if MouseCaptured then
          begin
            CamYaw   := CamYaw   + Event.motion.xrel * MouseSensitivity;
            CamPitch := CamPitch - Event.motion.yrel * MouseSensitivity;
            if CamPitch > 89.0 then CamPitch := 89.0;
            if CamPitch < -89.0 then CamPitch := -89.0;
          end;
        end;
    end;
  end;
end;

procedure DrawHints;
var
  W, H: Integer;
  Lines: array of string;
  I: Integer;
  Surface: PSDL_Surface;
  TexID: GLuint;
  Color: TSDL_Color;
  XPos, YPos: Integer;
  BgHeight: Integer;
  MaxWidth: Integer;
  LineHeights: array of Integer;
  TotalHeight: Integer;
  ConvSurface: PSDL_Surface;
begin
  if Font = nil then Exit;

  SDL_GetWindowSize(Window, @W, @H);

  Lines := [
    'ESC - Освободить мышку (Нажмите повторно для выхода)',
    'LMB - Захватить мышку',
    'F11 - Во весь экран (Нажмите повторно для режима окна)'
  ];

  // Сначала вычисляем размеры всех строк
  SetLength(LineHeights, Length(Lines));
  MaxWidth := 0;
  TotalHeight := 0;
  Color.r := 255; Color.g := 255; Color.b := 255; Color.a := 255;

  for I := 0 to High(Lines) do
  begin
    Surface := TTF_RenderUTF8_Blended(Font, PChar(Lines[I]), Color);
    if Surface <> nil then
    begin
      LineHeights[I] := Surface^.h;
      if Surface^.w > MaxWidth then MaxWidth := Surface^.w;
      TotalHeight := TotalHeight + Surface^.h + 5;
      SDL_FreeSurface(Surface);
    end
    else
      LineHeights[I] := 0;
  end;

  // --- Сохраняем состояние OpenGL ---
  glPushAttrib(GL_ENABLE_BIT or GL_TEXTURE_BIT or GL_CURRENT_BIT);
  glMatrixMode(GL_PROJECTION);
  glPushMatrix;
  glLoadIdentity;
  glOrtho(0, W, H, 0, -1, 1);  // 2D-проекция: (0,0) — верхний левый угол
  glMatrixMode(GL_MODELVIEW);
  glPushMatrix;
  glLoadIdentity;

  glDisable(GL_DEPTH_TEST);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);

  XPos := 10;
  YPos := 10;

  // --- Полупрозрачная чёрная подложка ---
  BgHeight := TotalHeight + 10;
  glDisable(GL_TEXTURE_2D);
  glColor4f(0.0, 0.0, 0.0, 0.6);
  glBegin(GL_QUADS);
    glVertex2f(XPos, YPos);
    glVertex2f(XPos + MaxWidth + 20, YPos);
    glVertex2f(XPos + MaxWidth + 20, YPos + BgHeight);
    glVertex2f(XPos, YPos + BgHeight);
  glEnd;

  // --- Рендерим каждую строку текста ---
  YPos := YPos + 8;

  for I := 0 to High(Lines) do
  begin
    Surface := TTF_RenderUTF8_Blended(Font, PChar(Lines[I]), Color);
    if Surface <> nil then
    begin
      // Конвертируем поверхность в правильный формат
      ConvSurface := SDL_ConvertSurfaceFormat(Surface, SDL_PIXELFORMAT_ABGR8888, 0);
      if ConvSurface <> nil then
      begin
        glGenTextures(1, @TexID);
        glBindTexture(GL_TEXTURE_2D, TexID);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

        // Учитываем pitch поверхности
        glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
        glPixelStorei(GL_UNPACK_ROW_LENGTH, ConvSurface^.pitch div 4);

        glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, ConvSurface^.w, ConvSurface^.h, 0,
                     GL_RGBA, GL_UNSIGNED_BYTE, ConvSurface^.pixels);

        glPixelStorei(GL_UNPACK_ROW_LENGTH, 0);
        glPixelStorei(GL_UNPACK_ALIGNMENT, 4);

        SDL_FreeSurface(ConvSurface);

        glEnable(GL_TEXTURE_2D);
        glColor4f(1.0, 1.0, 1.0, 1.0);
        glBegin(GL_QUADS);
          // Правильные текстурные координаты (без инверсии Y, т.к. мы уже конвертировали)
          glTexCoord2f(0.0, 0.0); glVertex2f(XPos + 10, YPos);
          glTexCoord2f(1.0, 0.0); glVertex2f(XPos + 10 + Surface^.w, YPos);
          glTexCoord2f(1.0, 1.0); glVertex2f(XPos + 10 + Surface^.w, YPos + Surface^.h);
          glTexCoord2f(0.0, 1.0); glVertex2f(XPos + 10, YPos + Surface^.h);
        glEnd;

        glDeleteTextures(1, @TexID);
      end;

      YPos := YPos + Surface^.h + 5;
      SDL_FreeSurface(Surface);
    end;
  end;

  // --- Восстанавливаем состояние OpenGL ---
  glPopMatrix;
  glMatrixMode(GL_PROJECTION);
  glPopMatrix;
  glMatrixMode(GL_MODELVIEW);
  glPopAttrib;
end;

function GetGroundHeight(X, Z: Single): Single;
var
  GridSize: Single;
  CellX, CellZ: Integer;
  FracX, FracZ: Single;
  H00, H10, H01, H11: Single;
  HeightT, HeightB: Single;
begin
  GridSize := 400.0;
  if (X < 0) or (X >= 10000.0) or (Z < 0) or (Z >= 10000.0) then
    Exit(0.0);
  CellX := Trunc(X / GridSize);
  CellZ := Trunc(Z / GridSize);
  if CellX > 24 then CellX := 24;
  if CellZ > 24 then CellZ := 24;
  FracX := (X / GridSize) - CellX;
  FracZ := (Z / GridSize) - CellZ;
  H00 := MatrixHeights[CellX,     CellZ];
  H10 := MatrixHeights[CellX + 1, CellZ];
  H01 := MatrixHeights[CellX,     CellZ + 1];
  H11 := MatrixHeights[CellX + 1, CellZ + 1];
  HeightT := H00 + FracX * (H10 - H00);
  HeightB := H01 + FracX * (H11 - H01);
  Result := HeightT + FracZ * (HeightB - HeightT);
end;

// NEW: обновление позиции камеры с использованием дельты времени
procedure UpdateCamera;
var
  RadYaw: Single;
  Vel: Single;
  ForwardX, ForwardZ: Single;
  RightX, RightZ: Single;
  NewX, NewZ: Single;
  GroundY: Single;
const
  EyeHeight = 100.0;   // высота глаз над поверхностью
  EdgeMargin = 50.0;
begin
  Vel := MoveSpeed * DeltaTime;
  // Направление "вперёд" в горизонтальной плоскости (без учёта наклона)
  RadYaw := DegToRad(CamYaw);
  ForwardX := Cos(RadYaw);
  ForwardZ := Sin(RadYaw);
  RightX := -Sin(RadYaw);
  RightZ := Cos(RadYaw);

  NewX := CamX;
  NewZ := CamZ;

  if moveForward then
  begin
    NewX := NewX + ForwardX * Vel;
    NewZ := NewZ + ForwardZ * Vel;
  end;
  if moveBack then
  begin
    NewX := NewX - ForwardX * Vel;
    NewZ := NewZ - ForwardZ * Vel;
  end;
  if moveLeft then
  begin
    NewX := NewX - RightX * Vel;
    NewZ := NewZ - RightZ * Vel;
  end;
  if moveRight then
  begin
    NewX := NewX + RightX * Vel;
    NewZ := NewZ + RightZ * Vel;
  end;

  // Ограничиваем перемещение в пределах ландшафта (0..10000)
  if NewX < EdgeMargin then NewX := EdgeMargin;
  if NewX > 10000 - EdgeMargin then NewX := 10000 - EdgeMargin;
  // аналогично для Z
  if NewZ < EdgeMargin then NewZ := EdgeMargin;
  if NewZ > 10000 - EdgeMargin then NewZ := 10000 - EdgeMargin;

  CamX := NewX;
  CamZ := NewZ;

  // Привязываем высоту камеры к рельефу с добавлением EyeHeight
  GroundY := GetGroundHeight(CamX, CamZ);
  //CamY := GroundY + EyeHeight;
  // Плавное изменение высоты (сглаживание)
  CamY := CamY * 0.9 + (GroundY + EyeHeight) * 0.1;
end;

procedure ApplyCamera;
var
  LookDirX, LookDirY, LookDirZ: Single;
  RadYaw, RadPitch: Single;
begin
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  // Вычисляем вектор направления взгляда из углов Эйлера
  RadYaw   := DegToRad(CamYaw);
  RadPitch := DegToRad(CamPitch);
  LookDirX := Cos(RadPitch) * Cos(RadYaw);
  LookDirY := Sin(RadPitch);
  LookDirZ := Cos(RadPitch) * Sin(RadYaw);

  gluLookAt(CamX, CamY, CamZ,
            CamX + LookDirX, CamY + LookDirY, CamZ + LookDirZ,
            0.0, 1.0, 0.0);
end;

// ОСТАЛЬНЫЕ ФУНКЦИИ (MoveRain, DrawRain, GetGroundHeight, RegenRain, DrawMatrix, Thunder и т.д.)
// ------- без изменений, за исключением того, что RegenRain больше не привязан к камере, но это не мешает -------
const
  RainFallSpeed = 600.0; // единиц в секунду

procedure MoveRain;
var
  I: Integer;
begin
  for I := 0 to NoRain - 1 do
    RainDrops[I].Y := RainDrops[I].Y - RainFallSpeed * DeltaTime;
end;

procedure DrawRain;
var
  I: Integer;
begin
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE);
  glDepthMask(GL_FALSE);
  glColor4f(0.6, 0.7, 0.8, 0.3);
  glBegin(GL_LINES);
  for I := 0 to NoRain - 1 do
  begin
    glVertex3f(RainDrops[I].X, RainDrops[I].Y,       RainDrops[I].Z);
    glVertex3f(RainDrops[I].X, RainDrops[I].Y + 50.0, RainDrops[I].Z);
  end;
  glEnd;
  glDepthMask(GL_TRUE);
  glDisable(GL_BLEND);
end;

procedure RegenRain;
var
  I: Integer;
  GroundH: Single;
begin
  for I := 0 to NoRain - 1 do
  begin
    GroundH := GetGroundHeight(RainDrops[I].X, RainDrops[I].Z);
    if RainDrops[I].Y < GroundH then
    begin
      // Капли пересоздаются где-то над камерой, но камера теперь может летать высоко – пусть так
      RainDrops[I].X := CamX + Random(Trunc(CloudSize)) - Random(Trunc(CloudSize));
      RainDrops[I].Y := CamY + CloudHeight;
      RainDrops[I].Z := CamZ + Random(Trunc(CloudSize)) - Random(Trunc(CloudSize));
    end;
  end;
end;

procedure DrawMatrix;
var
  X, Z: Integer;
  GridSize: Single;
begin
  GridSize := 400.0;
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, FloorTextureID);
  glColor3f(1.0, 1.0, 1.0);
  glBegin(GL_QUADS);
  for X := 0 to 24 do
  begin
    for Z := 0 to 24 do
    begin
      glTexCoord2f(0.0, 0.0); glVertex3f(X * GridSize, MatrixHeights[X, Z], Z * GridSize);
      glTexCoord2f(1.0, 0.0); glVertex3f((X+1)*GridSize, MatrixHeights[X+1, Z], Z * GridSize);
      glTexCoord2f(1.0, 1.0); glVertex3f((X+1)*GridSize, MatrixHeights[X+1, Z+1], (Z+1)*GridSize);
      glTexCoord2f(0.0, 1.0); glVertex3f(X * GridSize, MatrixHeights[X, Z+1], (Z+1)*GridSize);
    end;
  end;
  glEnd;
  glDisable(GL_TEXTURE_2D);
end;

procedure DrawWhiteFlashMatrix;
var
  X, Z: Integer;
  GridSize: Single;
begin
  GridSize := 400.0;
  glDisable(GL_TEXTURE_2D);
  glColor3f(1.0, 1.0, 1.0);
  for X := 0 to 24 do
  begin
    glBegin(GL_QUADS);
    for Z := 0 to 24 do
    begin
      glVertex3f(X * GridSize, MatrixHeights[X, Z], Z * GridSize);
      glVertex3f((X+1)*GridSize, MatrixHeights[X+1, Z], Z * GridSize);
      glVertex3f((X+1)*GridSize, MatrixHeights[X+1, Z+1], (Z+1)*GridSize);
      glVertex3f(X * GridSize, MatrixHeights[X, Z+1], (Z+1)*GridSize);
    end;
    glEnd;
  end;
end;

procedure Thunder;
var
  Rand: Integer;
begin
  Rand := Random(201);
  if Rand = 120 then
  begin
    glClearColor(0.1, 0.1, 0.15, 1.0); // Возвращаем исходный цвет
    ThunderActive := True;
    if SoundThunder <> nil then
      Mix_PlayChannel(-1, SoundThunder, 0);
  end
  else
  begin
    glClearColor(0.0, 0.0, 0.0, 1.0);
    ThunderActive := False;
  end;
end;

procedure GenerateMatrix;
var
  x, z: Integer;
begin
  //Randomize;
  for x := 0 to 25 do
    for z := 0 to 25 do
      MatrixHeights[x, z] := Random * 200.0;
end;

procedure LoadFloorTexture;
var
  Surface: PSDL_Surface;
  MyFormat: GLint;
begin
  Surface := SDL_LoadBMP('floor1.bmp');
  if Surface = nil then Exit;
  glGenTextures(1, @FloorTextureID);
  glBindTexture(GL_TEXTURE_2D, FloorTextureID);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  MyFormat := GL_BGR;
  if Surface^.format^.BytesPerPixel = 4 then MyFormat := GL_BGRA;
  glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, Surface^.w, Surface^.h, 0, MyFormat, GL_UNSIGNED_BYTE, Surface^.pixels);
  SDL_FreeSurface(Surface);
end;

procedure UpdateFrame;
var
  CurrentTime: UInt32;
begin
  // Вычисляем дельту времени
  CurrentTime := SDL_GetTicks();
  DeltaTime := (CurrentTime - LastTime) / 1000.0;
  if DeltaTime > 0.1 then DeltaTime := 0.1; // защита от больших скачков
  LastTime := CurrentTime;

  ProcessKeyboardInput;
  UpdateCamera;
  MoveRain;
  RegenRain;
  Thunder;
end;

procedure RenderFrame;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity;
  ApplyCamera;
  if not ThunderActive then
    DrawMatrix
  else
    DrawWhiteFlashMatrix;
  DrawRain;
  DrawHints;
  SDL_GL_SwapWindow(Window);
end;

procedure CleanUp;
begin
  if Font <> nil then
  begin
    TTF_CloseFont(Font);
    TTF_Quit();
  end;
  if SoundRain <> nil then Mix_FreeMusic(SoundRain);
  if SoundThunder <> nil then Mix_FreeChunk(SoundThunder);
  Mix_CloseAudio();
  glDeleteTextures(1, @FloorTextureID);
  if GLContext <> nil then SDL_GL_DeleteContext(GLContext);
  if Window <> nil then SDL_DestroyWindow(Window);
  SDL_Quit();
end;

var
  I: Integer;
begin
  try
    InitSystem;

    SoundRain := Mix_LoadMUS('rain.wav');
    if SoundRain <> nil then Mix_PlayMusic(SoundRain, -1);
    SoundThunder := Mix_LoadWAV('thunder.wav');

    SetLength(RainDrops, NoRain);

    Randomize;
    for I := 0 to NoRain - 1 do
    begin
      RainDrops[I].X := CamX + Random(Trunc(CloudSize)) - Random(Trunc(CloudSize));
      RainDrops[I].Y := CamY + CloudHeight - Random(Trunc(CloudHeight));
      RainDrops[I].Z := CamZ + Random(Trunc(CloudSize)) - Random(Trunc(CloudSize));
    end;

    GenerateMatrix;
    LoadFloorTexture;

    // FIX: Захватываем мышь (относительный режим) для нормального управления
    // Инициализация захвата мыши
    MouseCaptured := True;
    SDL_SetRelativeMouseMode(SDL_TRUE);
    SDL_ShowCursor(SDL_DISABLE); // Скрываем системный курсор

    LastTime := SDL_GetTicks();
    Running := True;
    while Running do
    begin
      HandleEvents;
      UpdateFrame;
      RenderFrame;
      SDL_Delay(16);
    end;

  except
    on E: Exception do
      Writeln('Ошибка: ', E.Message);
  end;

  CleanUp;
end.

Показываем информацию о системе и компьютере на Lazarus 4.6 под Debian 13

Пример кода программы на Lazarus 4.6 под Debian 13. Прграмма получает информацию об объёме физической памяти, процессоре, операционной системе. Мной код скомпилирован, программа работает.

Рисунок 1. Пример работы программы "Информация о системе и компьютере"

unit p1_u1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  BaseUnix;

type

  { TAboutForm }

  TAboutForm = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Cpu: TLabel;
    Label3: TLabel;
    OS: TLabel;
    Mem: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private

  public
        procedure GetOSInfo;
        procedure GetCpuInfo; // Добавили процедуру сбора данных о CPU
        procedure GetMemInfo;
        procedure InitializeCaptions;

  end;

var
  AboutForm: TAboutForm;

implementation

{$R *.lfm}

procedure TAboutForm.FormCreate(Sender: TObject);
begin
     InitializeCaptions;
end;

procedure TAboutForm.Button1Click(Sender: TObject);
begin
     AboutForm.Close;
end;

procedure TAboutForm.GetOSInfo;
var
  UNameRec: utsname; // Структура для информации о системе
  DistroName, DistroVersion: string;
  List: TStringList;
begin
  // 1. Получаем информацию о ядре через системный вызов
  FillChar(UNameRec, SizeOf(UNameRec), 0);
  fpUname(UNameRec);

  // 2. Пытаемся узнать название дистрибутива из /etc/os-release
  DistroName := 'Linux'; // Значение по умолчанию
  DistroVersion := '';

  if FileExists('/etc/os-release') then
  begin
    List := TStringList.Create;
    try
      List.LoadFromFile('/etc/os-release');

      // Ищем ID (например, ubuntu) и PRETTY_NAME (например, Ubuntu 22.04.3 LTS)
      DistroName := List.Values['ID']; // Может вернуть 'ubuntu', 'debian' и т.д.
      if List.Values['PRETTY_NAME'] <> '' then
        DistroName := List.Values['PRETTY_NAME'];
    finally
      List.Free;
    end;
  end;

  // 3. Формируем строку
  // Пример результата: "Ubuntu 22.04.3 LTS (Kernel 5.15.0-76-generic)"
  if DistroName <> 'Linux' then
    OS.Caption := Format('%s (Kernel %s)', [DistroName, UNameRec.release])
  else
    OS.Caption := Format('Linux Kernel %s', [UNameRec.release]);
end;

procedure TAboutForm.GetMemInfo;
var
  List: TStringList;
  sLine, sVal: string;
  P: Integer;
  MemKB: QWord;
begin
  Mem.Caption := 'Unknown';

  // В Linux информация о памяти находится в файле /proc/meminfo
  if FileExists('/proc/meminfo') then
  begin
    List := TStringList.Create;
    try
      List.LoadFromFile('/proc/meminfo');

      // Ищем строку, начинающуюся с MemTotal:
      // Формат строки: MemTotal:       16384000 kB
      for sLine in List do
      begin
        if Pos('MemTotal:', sLine) > 0 then
        begin
          // Удаляем "MemTotal:"
          sVal := sLine;
          Delete(sVal, 1, 9);

          // Получаем первое число (оно может идти с пробелами)
          sVal := Trim(sVal);
          P := Pos(' ', sVal);
          if P > 0 then
            sVal := Copy(sVal, 1, P - 1);

          // Конвертируем и форматируем
          if TryStrToQWord(sVal, MemKB) then
            Mem.Caption := FormatFloat('#,###" KB"', MemKB);

          Break;
        end;
      end;
    finally
      List.Free;
    end;
  end;
end;

procedure TAboutForm.GetCpuInfo;
var
  List: TStringList;
  I: Integer;
  Line: string;
  CpuModel: string;
  CpuCores: string;
begin
  CpuModel := 'Unknown CPU';
  CpuCores := '0';

  if FileExists('/proc/cpuinfo') then
  begin
    List := TStringList.Create;
    try
      List.LoadFromFile('/proc/cpuinfo');

      for I := 0 to List.Count - 1 do
      begin
        Line := List[I];

        // Ищем строку с моделью процессора
        if Pos('model name', Line) = 1 then
        begin
          CpuModel := Copy(Line, Pos(':', Line) + 1, MaxInt);
          CpuModel := Trim(CpuModel); // Убираем лишние пробелы
        end;

        // Ищем количество ядер процессора
        if Pos('cpu cores', Line) = 1 then
        begin
          CpuCores := Copy(Line, Pos(':', Line) + 1, MaxInt);
          CpuCores := Trim(CpuCores);
        end;

        // Если нашли оба значения, выходим из цикла раньше
        if (CpuModel <> 'Unknown CPU') and (CpuCores <> '0') then
          Break;
      end;
    finally
      List.Free;
    end;
  end;

  // Формируем итоговую строку. Если данные не нашлись, выведется "Unknown CPU"
  if (CpuModel <> 'Unknown CPU') and (CpuCores <> '0') then
    Cpu.Caption := Format('%s (%s cores)', [CpuModel, CpuCores])
  else
    Cpu.Caption := 'Unknown CPU';
end;

procedure TAboutForm.InitializeCaptions;
begin
  // Теперь здесь только чистый последовательный вызов модулей
  GetOSInfo;
  GetCpuInfo;
  GetMemInfo;
end;

end.

Пример кода на Lazarus 4.6, dglOpenGL, SDL2 под Debian 13 . Инициализация SDL2, dglOpenGL.

Программа реализует пример инициализации SDL2 для создания окна и обработки событий окна на изменения размеров окна, закрытия окна по нажатию клавиши ESC. Инициализация dglOpenGL.

Рисунок 1. Демонстрация работы программы. Вращающийся треугольник.

Код проекта:

program ogl_p4;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,
  sysutils,
  sdl2lib,
  dglOpenGL;
const
  WINDOW_WIDTH  = 800;
  WINDOW_HEIGHT = 600;

var
  Window: PSDL_Window = nil;
  GLContext: TSDL_GLContext = nil;
  Event: TSDL_Event;
  Running: Boolean = True;
  RotateAngle: Single = 0.0;

procedure InitSystem;
begin
     // Загружаем SDL2 library из системных путей Debian 13 напрямую
     if Not SDL2LIB_Initialize(SDL_LibName) then
     begin
       raise Exception.Create('Не удалось динамически загрузить libSDL2.so через SDL2LIB_Initialize');
     end;

  // Инициализируем видеосистему SDL2
  if SDL_Init( SDL_INIT_VIDEO ) < 0 then
  begin
    WriteLn('Ошибка инициализации SDL2: ', SDL_GetError());
    Halt(1);
  end;

  // Настраиваем параметры OpenGL перед созданием окна
  SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
  SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
  SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
  SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 24);

  // Создаем окно через SDL2
  Window := SDL_CreateWindow(
    'SDL2 + dglOpenGL + Lazarus (Debian 13)',
    SDL_WINDOWPOS_CENTERED, SDL_WINDOWPOS_CENTERED,
    WINDOW_WIDTH, WINDOW_HEIGHT,
    SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN
    or SDL_WINDOW_RESIZABLE
  );

  if Window = nil then
    raise Exception.Create('Не удалось создать окно SDL2');

  // Создаем контекст OpenGL
  GLContext := SDL_GL_CreateContext(Window);
  if GLContext = nil then
    raise Exception.Create('Не удалось создать контекст OpenGL');

  // Загружаем внутренние указатели OpenGL (dglOpenGL подхватит контекст SDL2)
  if not InitOpenGL then
    raise Exception.Create('Не удалось инициализировать dglOpenGL через контекст SDL2');

  // Читаем расширения
  ReadExtensions;
  // Строку ReadImplementationProperties; лучше убрать, в некоторых версиях dglOpenGL под Linux она падает
  ReadImplementationProperties;

  // Базовая настройка сцены (Матрицы и проекция)
  glViewport(0, 0, WINDOW_WIDTH, WINDOW_HEIGHT);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  gluPerspective(45.0, WINDOW_WIDTH / WINDOW_HEIGHT, 0.1, 100.0);
  glMatrixMode(GL_MODELVIEW);
  glClearColor(0.1, 0.1, 0.15, 1.0);
end;

procedure HandleResize(Width, Height: Integer);
begin
  // Защита от деления на ноль, если окно свернули
  if Height = 0 then Height := 1;

  // Обновляем область вывода OpenGL на весь экран окна
  glViewport(0, 0, Width, Height);

  // Переключаемся на матрицу проекции для ее обновления
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();

  // Задаем перспективную или ортогональную проекцию
  // Пример для Перспективы (3D): fov = 45 градусов, ближний отсекатель = 0.1, дальний = 100.0
  gluPerspective(45.0, Width / Height, 0.1, 100.0);

  // Возвращаем матрицу модели для обычного рендеринга объектов
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
end;

procedure HandleEvents;
begin
  // Обрабатываем очередь сообщений SDL2
  while SDL_PollEvent(@Event) <> 0 do
  begin
    case Event.type_ of
      // Событие закрытия окна
      SDL_QUITEV:
        Running := False;
      SDL_WINDOWEVENT:
      begin
           // Проверяем конкретный подтип события
          case Event.window.event of
            SDL_WINDOWEVENT_RESIZED,SDL_WINDOWEVENT_SIZE_CHANGED:
            begin
              // Извлекаем новые параметры ширины и высоты из события
              // и обновляем матрицы
              HandleResize(Event.window.data1, Event.window.data2);
            end;
          end;
      end;
      SDL_KEYDOWN:
        begin
          if Event.key.keysym.sym = SDLK_ESCAPE then
            Running := False;
        end;
    end;
  end;
end;

procedure UpdateFrame;
begin
  RotateAngle := RotateAngle + 0.5;
  if RotateAngle >= 360.0 then
    RotateAngle := RotateAngle - 360.0;
end;

procedure RenderFrame;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity();

  // Отодвигаем камеру назад на 3 единицы по оси Z (объект окажется перед камерой)
  glTranslatef(0.0, 0.0, -3.0);

  glRotatef(RotateAngle, 0.0, 0.0, 1.0);

  // Рисуем простой треугольник
  glBegin(GL_TRIANGLES);
    glColor3f(1.0, 0.0, 0.0); glVertex2f(0.0, 1.0);
    glColor3f(0.0, 1.0, 0.0); glVertex2f(-1.0, -1.0);
    glColor3f(0.0, 0.0, 1.0); glVertex2f(1.0, -1.0);
  glEnd();

  SDL_GL_SwapWindow(Window);
end;

procedure CleanUp;
begin
  if GLContext <> nil then
    SDL_GL_DeleteContext(GLContext);

  if Window <> nil then
    SDL_DestroyWindow(Window);

  SDL_Quit();
end;

begin
  try
    InitSystem;

    // Главный цикл программы
    while Running do
    begin
      HandleEvents;
      UpdateFrame;
      RenderFrame;
      SDL_Delay(16);
    end;

  except
    on E: Exception do
      Writeln('Ошибка: ', E.Message);
  end;

  CleanUp;
end.

 

Как удалить pdf24 с удаленного компьютера в локальной сети при помощи PsExec

Нашёл способ удаления программы pdf24 на удалённом компьютере в локальной сети. Команду удаления на удалённом компьютере будем запускать при помощи программы PsExec.exe. Если инсталлятор pdf24 создан на базе msi пакета, то удаление проводится при помощи программы MsiExec.exe, которая присутствует по-умолчанию в Windows 10 x64. Если инсталлятор pdf24 создан в виде exe пакета, то удаление сводится к запуска специального деинсталлятора unins000.exe, который находися в папке, куда установлена программа pdf24, по-умолчанию это путь (C:\Program Files\PDF24\unins000.exe). Сразу скажу, что на удаленном компьютере вы должны быть администратором, то есть ваша учётная запись должна находится в группе Администраторы.

Если установщик pdf24 создан в виде msi пакета, то чтобы удалить pdf24 нам нужно узнать идентификатор продукта msi (product_guid) pdf24. Идентифактор продукта msi для pdf24 можно посмотреть в реестре Windows 10. На всех компьютерах, где был установлен msi пакет pdf24 версии 11.23.0 будет GUID {092211C0-0A7B-4D36-A70D-C6DD8236533E}. В реестре его можно посмотреть по следующему пути:

Компьютер\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\{092211C0-0A7B-4D36-A70D-C6DD8236533E}

В этой ветке найдите параметр UninstallString и там будет значение MsiExec.exe /I{092211C0-0A7B-4D36-A70D-C6DD8236533E}.

Взяв этот GUID сформируем команду удаления этого продукта с компьютера: "MsiExec.exe" /x {092211C0-0A7B-4D36-A70D-C6DD8236533E} /qn /norestart

/x – параметр удаления продукта

{092211C0-0A7B-4D36-A70D-C6DD8236533E} – GUID продукта для pdf24 версии 11.23.0

/qn – не выводить диалоги (окна) выбора ответа на вопрос (тихий режим удаления).

/norestart – не перезагружаем компьютер, если требуется.

Теперь применим эту команду удаления для pdf 24 на удалённый компьютер в локальной сети.

PsExec.exe \\pc01 -i -s -h -accepteula -nobanner "MsiExec.exe" /x {092211C0-0A7B-4D36-A70D-C6DD8236533E} /qn /norestart

\\pc01 – имя удалённого компьютера

i – интерактивный режим, позволяет взаимодействовать с текущей сессией рабочего стола пользователя.

s – права запуска учётной записи SYSTEM

h – запуск процесса с повышенными правами

accepteula - принимаем лицензионное соглашение, чтобы всплывающего окна не появилось

nobanner – скроем окно о правах

В том случае, если инсталлятор pdf24 в виде exe пакета, то команда удаления на локальном компьютере будет выглядить так: "C:\Program Files\PDF24\unins000.exe" /VERYSILENT /SUPPRESSMSGBOXES /NORESTART

/VERYSILENT – скрываем окно удаления и всё, что сним свзязано

/SUPPRESSMSGBOXES – закрываем все всплывающие сообщение в процессе удаления

/NORESTART - не перезагружаем компьютер, если требуется.

Теперь посмотрим команду удаления pdf24 программы в виде exe пакета на удалённом компьютере: PsExec.exe \\pc01 -i -h -accepteula -nobanner "C:\Program Files (x86)\PDF24\unins000.exe" /VERYSILENT /SUPPRESSMSGBOXES /NORESTART

На этом все. Данные команды работают. Сам проверил.

Минимальное OpenGL + SDL 2 приложение на языке Lisp (SBCL) под Windows 10

Я уже пытался освоить Lisp в этой статье (https://notidealrunner.blogspot.com/2013/01/common-lisp-fedora-17-kde.html). В конце статьи я сказал, что мы попробуем написать OpenGL программу на Lisp. Каким-то чудом это у меня получилось. Читаем ниже.

 

1. Установка диалекта Lisp (SBCL) на Windows 10

Для начала скачайте SBCL (Steel Bank Common Lisp) с официального сайта проекта по ссылке (https://www.sbcl.org/platform-table.html). На момент написания статьи на сайте доступна версия 2.5.9 Установка SBCL проста: следуйте инструкциям мастера установки. После установки путь до SBCL установится в переменную окружения PATH. Запустите командную строку и выполните команду sbcl --version. 

 

2. Установка менеджера пакетов Quicklisp

Скачайте quicklisp с официального сайта по ссылке (https://beta.quicklisp.org/quicklisp.lisp). Сохраните quicklisp.lisp, например, в папку c:\users\[ваш пользователь]\Downloads\. В командной строке выполните команду sbcl, после этого вы попадёте в командную строку sbcl. Для установки Quicklisp в C:\users\[ваш пользователь]\quicklisp и добавления его загрузку в инициализацию SBCL необходима выполнить следующие команды:

 

1) (load "c:/users/user/Downloads/quicklisp.lisp") — загрузит файл quicklisp.lisp

2) (quicklisp-quickstart:install) — установит менеджер пакетов

3) (ql:add-to-init-file) - добавит строку загрузки менеджера пакетов quicklisp в c:\users\[ваш пользователь]\.sbclrc 

 

3. Загрузка пакетов OpenGL и SDL 2

В SBCL для работы с OpenGL используют пакет cl-opengl для рисовки графики и для работы с SDL 2 используют пакет sdl2 для создания окна.

 

1) (ql:quickload "cl-opengl") – для OpenGL

2) (ql:quickload "sdl2") – для SDL 2

 

4. Пример кода на lisp с использованием OpenGL и SDL

 

(defpackage #:sdl2-opengl-triangle
  (:use :cl)
  (:export :run))

(in-package :sdl2-opengl-triangle)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload '("sdl2" "cl-opengl")))

(defparameter *window-width* 640)
(defparameter *window-height* 480)

(defun run()
  (sdl2:with-init (:video)
    (sdl2:with-window (window :title "OpenGL Triangle"
                              :w *window-width*
                              :h *window-height*
                              :flags '(:opengl :shown))
	(let ((context (sdl2:gl-create-context window)))
        (unwind-protect
             (progn
               (sdl2:gl-make-current window context)
               (gl:viewport 0 0 *window-width* *window-height*)
               
               ;; Основной цикл рендеринга
               (sdl2:with-event-loop (:method :poll)
                 (:quit () t)
                 (:keydown (:keysym keysym)
                           (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-escape)
                             (sdl2:push-event :quit)))
                 (:idle ()
                        ;; Очистка буфера
                        (gl:clear-color 0.1 0.1 0.1 1.0)
                        (gl:clear :color-buffer-bit)
                        
                        ;; Рисуем треугольник
                        (gl:begin :triangles)
                        (gl:color 1.0 0.0 0.0)  ; красный
                        (gl:vertex -0.5 -0.5 0.0)
                        (gl:color 0.0 1.0 0.0)  ; зелёный
                        (gl:vertex  0.5 -0.5 0.0)
                        (gl:color 0.0 0.0 1.0)  ; синий
                        (gl:vertex  0.0  0.5 0.0)
                        (gl:end)
                        
                        ;; Показываем кадр
                        (sdl2:gl-swap-window window)
                        
                        ;; Ограничиваем FPS (~60)
                        (sdl2:delay 16)
				  )
				)
             ;; Освобождение контекста
             (sdl2:gl-delete-context context)
			 )
		)
	)
	)
  )
)

5. Скачать SDL2.dll  

Прежде чем загружать и запускать пример на Lisp c OpenGL и SDL, вам необходимо скачать последние драйвера для вашей видеокарты, это позволит вам запускать OpenGL приложения и динамическую библиотеку SDL 2 для запуска приложений SDL 2. Скачать SDL 2 можно с официального сайта (https://github.com/libsdl-org/SDL/releases/tag/release-2.30.11). Последняя версия SDL 2 это 2.30.11. Скопируйте SDL2.dll в папку, где у вас установлен SBCL, рядом с файлом sbcl.exe. У меня это папка C:\Program Files\Steel Bank Common Lisp\.

 

6. Команда загрузки примера кода на Lisp и его запуск 

(load "h:/Programming/Projects/lisp/lisp_opengl_p1/sdl-opengl.lisp")

(sdl2-opengl-triangle:run)

 

Рисунок 1. Пример работы программы на Lisp с использованием OpenGL и SDL 2

 

Пример кода на Delphi и OpenGL. Переключение камеры, привязка камеры к объекту

Программа реализует пример переключения камеры между объектами, привязка камеры к объекту.

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

 

Код проекта:

unit ogl_p17_u1;

interface

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

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    h_RC: HGLRC; // Контекст рендеринга
    h_DC: HDC;   // Контекст устройства

    procedure AttachCameraToCube;
    procedure AttachCameraToCube2;
    procedure ReturnCameraToOrigPos;
    procedure InitGL;
    procedure DrawGLScene;
    procedure UpdateCamera;
    procedure HandleKeys;
    procedure DrawCube;
    procedure DrawCube2;
    procedure DrawTrack;
    procedure BuildFont;
    procedure glPrint(text: string);
    { Public declarations }
  end;

var
  Form1: TForm1;
   
  CubePos: array [0..2] of GLfloat = (0, 0, 0); // Позиция куба
  Cube2Pos: array [0..2] of GLfloat = (0, 0, 0); // Позиция куба 2
  Cube2PosCount: GLfloat = 1.0;
  Cube2Rot: GLfloat = 0.0;
  Cube2Speed: GLfloat = 1.0;
  CubeRot: GLfloat = 0.0; // Угол вращения куба
  CamPos: array [0..2] of GLfloat = (0, 5, 10); // Позиция камеры
  CamPitch: GLfloat; // Углы поворота камеры
  MoveSpeed: GLfloat = 0.1; // Скорость перемещения
  CamPosFlag: GLbyte;
  
const
  CAM_FREE = 0;
  CAM_CUBE1 = 1;
  CAM_CUBE2 = 2;
  FONT_BASE = 1000;

implementation

{$R *.dfm}

procedure TForm1.BuildFont;
var
  h_Font: HFONT;
begin
  h_Font := CreateFont(
    -16,
    0,
    0,
    0,
    FW_NORMAL,
    0,
    0,
    0,
    RUSSIAN_CHARSET,
    OUT_TT_PRECIS,
    CLIP_DEFAULT_PRECIS,
    ANTIALIASED_QUALITY,
    FF_DONTCARE or DEFAULT_PITCH,
    'Arial'                      
  );
  SelectObject(h_DC, h_Font);
  wglUseFontBitmaps(h_DC, 0, 256, FONT_BASE);
  DeleteObject(h_Font);
end;

procedure TForm1.glPrint(text: string);
begin
  glListBase(FONT_BASE);
  glCallLists(Length(text), GL_UNSIGNED_BYTE, PAnsiChar(AnsiString(text)));
end;

procedure TForm1.AttachCameraToCube;
begin
  CamPos[0] := CubePos[0] + 3;
  CamPos[1] := CubePos[1] + 4;
  CamPos[2] := CubePos[2] + 5;
end;

procedure TForm1.AttachCameraToCube2;
begin
  CamPos[0] := Cube2Pos[0] + 3;
  CamPos[1] := Cube2Pos[1] + 4;
  CamPos[2] := Cube2Pos[2] + 5;
end;

procedure TForm1.ReturnCameraToOrigPos;
begin
  CamPos[0] := 0;
  CamPos[1] := 5;
  CamPos[2] := 10;
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);

  if Assigned(wglSwapIntervalEXT) then
    wglSwapIntervalEXT(1);

  glClearColor(0.0, 0.0, 0.0, 1.0); // Чёрный фон
  glEnable(GL_DEPTH_TEST); // Включение теста глубины
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(45.0, 640/480, 0.1, 100.0); // Настройка перспективы
  glMatrixMode(GL_MODELVIEW);

  BuildFont;
end;

procedure TForm1.UpdateCamera;
begin
  glLoadIdentity;
  case CamPosFlag of
    CAM_FREE: // Исходная позиция
      gluLookAt(CamPos[0], CamPos[1], CamPos[2], 0, 0, 0, 0, 1, 0);
    CAM_CUBE1: // Следим за первым кубом
      gluLookAt(CamPos[0], CamPos[1], CamPos[2], CubePos[0], CubePos[1], CubePos[2], 0, 1, 0);
    CAM_CUBE2: // Следим за вторым кубом
      gluLookAt(CamPos[0], CamPos[1], CamPos[2], Cube2Pos[0], Cube2Pos[1], Cube2Pos[2], 0, 1, 0);
  end;
end;

procedure TForm1.HandleKeys;
var
  Angle: GLfloat;
begin
  if GetAsyncKeyState(VK_F1) < 0 then
  begin
    CamPosFlag := CAM_CUBE1;
    AttachCameraToCube;
  end;

  if GetAsyncKeyState(VK_F2) < 0 then
  begin
    CamPosFlag := CAM_CUBE2;
    AttachCameraToCube2;
  end;

  if GetAsyncKeyState(VK_F3) < 0 then
  begin
    CamPosFlag := CAM_FREE;
    ReturnCameraToOrigPos;
  end;

  if GetAsyncKeyState(VK_UP) < 0 then
  begin
    CubePos[2] := CubePos[2] - MoveSpeed;
    if CamPosFlag = CAM_CUBE1 then
      AttachCameraToCube;
  end;

  if GetAsyncKeyState(VK_DOWN) < 0 then
  begin
    CubePos[2] := CubePos[2] + MoveSpeed;
    if CamPosFlag = CAM_CUBE1 then
      AttachCameraToCube;
  end;

  if GetAsyncKeyState(VK_LEFT) < 0 then
  begin
    CubePos[0] := CubePos[0] - MoveSpeed;
    if CamPosFlag = CAM_CUBE1 then
      AttachCameraToCube;
  end;

  if GetAsyncKeyState(VK_RIGHT) < 0 then
  begin
    CubePos[0] := CubePos[0] + MoveSpeed;
    if CamPosFlag = CAM_CUBE1 then
      AttachCameraToCube;
  end;

  CubeRot := CubeRot + 2.0; // Вращение
  if CubeRot >= 360 then CubeRot := 0;

  // Движение и вращение второго куба
  Cube2PosCount := Cube2PosCount + Cube2Speed;
  if Cube2PosCount >= 360 then Cube2PosCount := 0;

  // Всегда обновляем позицию второго куба
  Angle := DegToRad(Cube2PosCount);
  Cube2Pos[0] := 5*Cos(Angle);
  Cube2Pos[1] := 0.5;
  Cube2Pos[2] := 5*Sin(Angle);

  
  Cube2Rot := Cube2Rot + 3.0; // Независимое вращение
  if Cube2Rot >= 360 then Cube2Rot := 0;
end;

procedure TForm1.DrawCube;
begin
  glColor3f(0, 0, 1); // Синий цвет
  glPushMatrix;
    glTranslatef(CubePos[0], CubePos[1], CubePos[2]);
    glRotatef(CubeRot, 0, 1, 0); // Вращение вокруг Y
    glutSolidCube(1.0); // Используем GLUT для простоты
  glPopMatrix;
end;

procedure TForm1.DrawCube2;
begin
  glColor3f(1, 0, 1); // Фиолетовый цвет
  glPushMatrix;
    glTranslatef(Cube2Pos[0], Cube2Pos[1], Cube2Pos[2]);
    glRotatef(Cube2Rot, 0, 1, 0);
    glutSolidCube(1.0);
  glPopMatrix;
end;

procedure TForm1.DrawTrack;
var
  i: Integer;
begin
  glColor3f(1, 1, 0); // Жёлтый цвет
  glBegin(GL_LINE_STRIP);
    for i := 0 to 360 do
      glVertex3f(5*Cos(DegToRad(i)), 0, 5*Sin(DegToRad(i)));
  glEnd;
end;

procedure TForm1.DrawGLScene;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity;

  UpdateCamera;
  HandleKeys;
  DrawTrack;
  DrawCube;
  DrawCube2;

// Сохраняем текущую матрицу
  glPushMatrix;
  
  // Переключаемся в 2D режим для текста
  glMatrixMode(GL_PROJECTION);
  glPushMatrix;
  glLoadIdentity;
  gluOrtho2D(0, ClientWidth, ClientHeight, 0); // 2D проекция
  
  glMatrixMode(GL_MODELVIEW);
  glPushMatrix;
  glLoadIdentity;
  
  // Отключаем тест глубины для текста
  glDisable(GL_DEPTH_TEST);
  
  // Устанавливаем цвет текста
  glColor3f(1.0, 1.0, 1.0); // Белый цвет
  
  // Рисуем текст
  glRasterPos2f(10, 20);
  glPrint('F1 - Синий куб');
  
  glRasterPos2f(10, 40);
  glPrint('F2 - Розовый куб');
  
  glRasterPos2f(10, 60);
  glPrint('F3 - Вся сцена');
  
  // Восстанавливаем настройки
  glEnable(GL_DEPTH_TEST);
  
  glPopMatrix; // MODELVIEW
  glMatrixMode(GL_PROJECTION);
  glPopMatrix; // PROJECTION
  glMatrixMode(GL_MODELVIEW);
  glPopMatrix; // исходная матрица

  SwapBuffers(h_DC);
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := False; 
  InitGL;
  KeyPreview := True;
  Visible := True;
  tmr1.Interval := 16;
  CamPosFlag := 0;
  Cube2PosCount := 0;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(45.0, ClientWidth/ClientHeight, 0.1, 100.0);
  glMatrixMode(GL_MODELVIEW);
end;

procedure TForm1.tmr1Timer(Sender: TObject);
begin
  DrawGLScene;
end;

end.

Пример кода на 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.