Нашёл на форуме по программированию (Ссылка) частично не рабочий код, довёл его до работоспособности. Пример показывает вращение камеры и управление камерой с клавиатуры.
Рисунок 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.
Комментариев нет:
Отправить комментарий