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

Пример кода на Delphi и OpenGL. Вращение камеры, управление камерой.

Нашёл на форуме по программированию (Ссылка) частично не рабочий код, довёл его до работоспособности. Пример показывает вращение камеры и управление камерой с клавиатуры.

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

unit p1_u1;

interface

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

type
  TForm1 = class(TForm)
    tmr1: TTimer;
    tmr2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure tmr2Timer(Sender: TObject);
  private
    { Private declarations }
    newCount, frameCount, lastCount : LongInt;
    fpsRate : GLfloat;

    procedure MyInitOpenGL(dc:HDC);
    procedure PaintGL(dc:HDC);
    procedure SetDCPixelFormat(DC:HDC);
    procedure SetLight;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  hgc:HGLRC;
  tx,ty,tz:GLfloat;
  gox,goy,goz:GLfloat;
  buf:TBitmap;
  LightPos:array [0..3] of GLfloat=(-1.5,0.0,-3.0,1.0);
  LightAmb:array [0..3] of GLfloat=(0.5,0.5,0.5,1.0);
  LightDif:array [0..3] of GLfloat=(1.0,1.0,1.0,1.0);
  glFog_Color:array [0..3] of GLfloat=(0.5,0.5,0.5,1.0);
  
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

  // Инициализация переменных
  goz := -8;
  tx := 0; // Инициализация tx
  ty := 0; // Инициализация ty
  tz := 0; // Инициализация tz
  gox := 0; // Инициализация goX
  goy := 0; // Инициализация goY

  // Установка заголовка формы
  Form1.Caption := 'x=' + FloatToStr(tx) + '  y=' + FloatToStr(ty);

  // Инициализация OpenGL
  MyInitOpenGL(Canvas.Handle);
  PaintGL(Canvas.Handle);

  // Установка параметров OpenGL
  glViewport(0, 0, ClientWidth, ClientHeight);
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_LIGHTING);
  glEnable(GL_LIGHT0);
  glEnable(GL_COLOR_MATERIAL);
  glEnable(GL_POLYGON_SMOOTH);
  
  // Установка матрицы проекции
  glMatrixMode(GL_PROJECTION);
  glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
  glDepthFunc(GL_LEQUAL);
  
  // Возврат к матрице модели
  glMatrixMode(GL_MODELVIEW);

  // Запоминаем текущее время
  lastCount := GetTickCount;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

  if Key=VK_ESCAPE then Form1.Close;

  // Проверка нажатия клавиш без Shift
  if not (ssShift in Shift) then
  begin
    if Key = VK_UP then
      tx := tx + 1;
    if Key = VK_DOWN then
      tx := tx - 1;
    if Key = VK_LEFT then
      ty := ty - 1;
    if Key = VK_RIGHT then
      ty := ty + 1;
    if Key = VK_INSERT then
      tz := tz + 0.3;
    if Key = VK_DELETE then
      tz := tz - 0.3;
  end;

  // Проверка нажатия клавиш с Shift
  if ssShift in Shift then
  begin
    if Key = VK_UP then
      goz := goz + 0.3;
    if Key = VK_DOWN then
      goz := goz - 0.3;
    if Key = VK_LEFT then
      gox := gox - 0.3;
    if Key = VK_RIGHT then
      gox := gox + 0.3;
    if Key = VK_INSERT then
      goy := goy + 0.3;
    if Key = VK_DELETE then
      goy := goy - 0.3;
  end;

  // Проверка границ для tX и tY
  if tx = 361 then
    tx := 0;
  if tx = -1 then
    tx := 360;
  if ty = 361 then
    ty := 0;
  if ty = -1 then
    ty := 360;

  // Обновление окна
  InvalidateRect(Handle, nil, False);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // Проверяем, установлен ли контекст
  if hgc <> 0 then
  begin
    // Устанавливаем текущий контекст в 0 перед удалением
    wglMakeCurrent(0, 0);
    // Удаляем контекст
    wglDeleteContext(hgc);
    hgc := 0; // Обнуляем hgc после удаления
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  PaintGL(Canvas.Handle);
  newCount:=GetTickCount;
  Inc(frameCount);
  if newCount-lastCount>1000 then
  begin
    fpsRate:=frameCount;
    lastCount:=newCount;
    frameCount:=0;
  end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  // Убедитесь, что контекст OpenGL активен перед вызовом функций OpenGL
  glMatrixMode(GL_MODELVIEW);

  // Установите размер области просмотра
  glViewport(0, 0, ClientWidth, ClientHeight);

  // Сброс матрицы модели
  glLoadIdentity;

  // Если нужно, можно задать перспективу
  // glFrustum (-1, 1, -1, 1, 3, 10); // задаем перспективу

  // Перерисовка окна
  InvalidateRect(Handle, nil, False);
end;

procedure TForm1.myInitOpenGL(dc:HDC);
begin
  SetDCPixelFormat(dc);
  hgc:=wglCreateContext(dc);
  wglMakeCurrent(dc,hgc);
end;

procedure TForm1.PaintGL(dc: HDC);
begin

  glMatrixMode(GL_PROJECTION);
  glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, 1);
  glClearColor(0,0,0.7,1);

  glClear(GL_COLOR_BUFFER_BIT+GL_DEPTH_BUFFER_BIT);
  glColor3f(0,1,0);
  glLoadIdentity();

  SetLight;
  glBegin(GL_QUADS);
    glVertex3f(-1,-1,-1);
    glVertex3f(-1,1,-1);
    glVertex3f(1,1,-1);
    glVertex3f(1,-1,-1);
  glEnd();

  glBegin(GL_QUADS);
    glVertex3f(-1,-1,1);
    glVertex3f(-1,1,1);
    glVertex3f(1,1,1);
    glVertex3f(1,-1,1);
  glEnd();

  glBegin(GL_QUADS);
    glVertex3f(-1,1,-1);
    glVertex3f(-1,1,1);
    glVertex3f(-1,-1,1);
    glVertex3f(-1,-1,-1);
  glEnd();

  glColor4d(0.7,0,0,0.8);

  glBegin(GL_QUADS);
    glVertex3f(1,1,-1);
    glVertex3f(1,1,1);
    glVertex3f(1,-1,1);
    glVertex3f(1,-1,-1);
  glEnd();

  glColor4f(0,1,0,1.0);

  glBegin(GL_QUADS) ;
    glVertex3f(1,1,1);
    glVertex3f(1,1,-1);
    glVertex3f(-1,1,-1);
    glVertex3f(-1,1,1);
  glEnd();

  glBegin(GL_QUADS) ;
    glVertex3f(1,-1,1);
    glVertex3f(1,-1,-1);
    glVertex3f(-1,-1,-1);
    glVertex3f(-1,-1,1);
  glEnd();

  glColor3f(0,1,1);

  glBegin(GL_QUADS);
    glVertex3f(10,-1.1,10);
    glVertex3f(10,-1.1,-10);
    glVertex3f(-10,-1.1,-10);
    glVertex3f(-10,-1.1,10);
  glend;

  glColor3f(0,1,1);

  glMatrixMode(GL_MODELVIEW);

  glLoadIdentity();
  glTranslated(0,2,0);

  glLoadIdentity();
  gluPerspective(45, ClientWidth/ClientHeight, 0.1, 100);


  //glFrustum (-2, 2, -2, 2, 3, 100);    // задаем перспективу
  //glOrtho(-2,2,-2,2,3,10);

  glTranslatef(gox, goy, goz);       // перенос объекта по оси Z
  glRotatef(tx,1,0,0);
  glRotatef(ty,0,1,0);
  glRotatef(tz,0,0,1);

  glEnable(GL_FOG);
  glFogi(GL_FOG_MODE, GL_LINEAR);
  glFogiv(GL_FOG_COLOR, @glFog_COLOR);
  glFog(GL_FOG_DENSITY, 0.35);
  glFog(GL_FOG_HINT, GL_DONT_CARE);
  glFog(GL_FOG_START, 5.0);
  glFog(GL_FOG_END, -5.0);

  SwapBuffers(dc);

end;

procedure TForm1.SetDCPixelFormat(DC: HDC);
var
  nPixelFormat: Integer;
  pfd: PIXELFORMATDESCRIPTOR;
begin
  FillChar(pfd, SizeOf(pfd), 0);
  pfd.nSize := SizeOf(PIXELFORMATDESCRIPTOR); // Установка размера структуры
  pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_GDI or PFD_GENERIC_ACCELERATED or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
  pfd.cDepthBits := 32;

  nPixelFormat := ChoosePixelFormat(DC, @pfd);
  if nPixelFormat = 0 then
  begin
    // Обработка ошибки: не удалось выбрать формат пикселей
    Exit;
  end;

  if SetPixelFormat(DC, nPixelFormat, @pfd) = False then
  begin
    // Обработка ошибки: не удалось установить формат пикселей
    Exit;
  end;
end;

procedure TForm1.SetLight;
begin
  glDisable(GL_LIGHTING);
  glDisable(GL_LIGHT0);
  glLightfv(GL_LIGHT0, GL_AMBIENT, @LightAmb);
  glLightfv(GL_LIGHT0, GL_POSITION, @lightPos);
  glLightfv(GL_LIGHT0, GL_DIFFUSE, @lightDif);
  glEnable(GL_LIGHT0);
  glEnable(GL_LIGHTING);
end;

procedure TForm1.tmr1Timer(Sender: TObject);
begin
  Refresh;
  tmr1.Free;
end;

procedure TForm1.tmr2Timer(Sender: TObject);
begin
  Form1.Caption:='x='+FloatToStr(tx)+'  y='+FloatToStr(ty)+' z='+FloatToStr(tz)+' goX='+FloatToStr(gox)+' goY='+FloatToStr(goy)+'  goZ='+FloatToStr(goz)+' FPS='+FloatToStr(fpsRate);
  InvalidateRect(Handle, nil, False);
end;

end.

 

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

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