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

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