Форум программистов, компьютерный форум, киберфорум
Massaraksh7
Войти
Регистрация
Восстановить пароль
Библиотека матвычислений на Delphi.
Здесь будут публиковаться рабочие процедуры, выполняющие различные математические вычисления.

Перемещение камеры по сцене для Opengl на Lazarus.

Запись от Massaraksh7 размещена 31.12.2024 в 03:05
Показов 1238 Комментарии 0
Метки lazarus, opengl

Потребовалось отображать трёхмерные графики. Для этого выбрал OpenGl, благо, в Lazarus он есть. С Opengl раньше немного работал (простейшие вещи), но, аналогичную задачу в Delphi решал с помощью GlScene. В Lazarus GlScene до ума, видимо, пока не доведена, какие-то ошибки при компиляции, поэтому не стал заморачиваться, и решил полностью сделать на Opengl.
Первостепенная задача, естественно, управление камерой, чем, для начала и занялся. Приведён код, который позволяет:
1. Приближать/отдалять камеру к цели.
2. Осуществлять поворот камеры вокруг цели в плоскости, параллельной XY.
3. Осуществлять поворот камеры вокруг прямой Ax+Bx+C=0 (подъём/опускание)
4. Проводить смещение камеры (и цели) влево или вправо вдоль прямой, перпендикулярной "линии взгляда" камеры на цель.
Код и демо-видео прилагаются.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
unit main;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, 
  OpenGLContext, gl, glu, LCLType, ComCtrls, Types, Math;
 
type
 
  { TOGLForm }
 
  TOGLForm = class(TForm)
    GLBox: TOpenGLControl;
    procedure FormCreate(Sender: TObject);
    procedure GLBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure GLBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure GLBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure GLBoxMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure GLBoxPaint(Sender: TObject);
  private
  procedure CreateBase;
  procedure CreateNet;
  procedure Draw;
  public
  down,XS,YS,dx,dy,dz:integer;
  end;
 
var
  OGLForm: TOGLForm;
 
implementation
 
{$R *.lfm}
 
{ TOGLForm }
var xf,yf,zf,x0,y0,z0:double;
 
 
procedure TOGLForm.FormCreate(Sender: TObject);
begin
  zf:=200;xf:=-200;yf:=0;  //--Камера
  x0:=0;y0:=0;z0:=0;       //--Цель
end;
 
//--Нахождение угла (+-180° по x,y)
function Angle(x,y:double):double;
begin
if (Abs(x)<0.00000001) and (y>0) then begin Result:=90;exit;end;
if (Abs(x)<0.00000001) and (y<0) then begin Result:=-90;exit;end;
if (Abs(y)<0.00000001) and (x>0) then begin Result:=0;exit;end;
if (Abs(y)<0.00000001) and (x<0) then begin Result:=180;exit;end;
if (x>0) and (y>0) then begin Result:=arctan(y/x)*180/PI;exit;end;
if (x>0) and (y<0) then begin Result:=arctan(y/x)*180/PI;exit;end;
if (x<0) and (y>0) then begin Result:=180+arctan(y/x)*180/PI;exit;end;
if (x<0) and (y<0) then begin Result:=-180+arctan(y/x)*180/PI;exit;end;
end;
 
//--Нажатие кнопки мыши
procedure TOGLForm.GLBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
XS:=X;YS:=Y;
if Button = mbLeft  then down:=1;
if Button = mbRight then down:=2;
if (Button = mbRight) and (ssCtrl in Shift) then down:=3;
end;
 
//--Колесо мыши - приближение/удаление
procedure TOGLForm.GLBoxMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var r,r2,rp,rp2,xa,ya,za:double;
begin
r:=Sqrt((xf-x0)*(xf-x0)+(yf-y0)*(yf-y0)+zf*zf);
if WheelDelta<0 then rp:=r+5 else rp:=r-5;
r2:=r*r;
rp2:=rp*rp;
xa:=Sqrt((xf-x0)*(xf-x0)*rp2/r2);
ya:=Sqrt((yf-y0)*(yf-y0)*rp2/r2);
za:=Sqrt(zf*zf*rp2/r2);
xf:=xa*sign(xf-x0)+x0;
yf:=ya*sign(yf-y0)+y0;
zf:=za*sign(zf);
Draw;
end;
 
//--Движение мыши
procedure TOGLForm.GLBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var teta,dt,dtx,dty,x1,y1,r,fi,fiz:Extended;
//label 1;
begin
//---Поворот вокруг прямой Ax+By+C=0 (подъём, фи,тэта)
if down=1 then
   begin
   dt:=YS-Y;
   fiz:=Angle(xf-x0,yf-y0);
   r:=Sqrt((xf-x0)*(xf-x0)+(yf-y0)*(yf-y0)+zf*zf);
   teta:=arccos(zf/r)*180/PI;
   teta:=teta+dt/2;
   if (teta<0) or (teta>90) then exit;
   xf:=r*cos(fiz*PI/180)*sin(teta*PI/180)+x0;
   yf:=r*sin(fiz*PI/180)*sin(teta*PI/180)+y0;
   zf:=r*cos(teta*PI/180);
   YS:=Y;
   Draw;exit;
   end;
//---Поворот вокруг оси Z (фи)
if down=2 then
   begin
   dt:=XS-X;dt:=dt/5;
   fiz:=dt*PI/180;
   x1:=(xf-x0)*cos(fiz)-(yf-y0)*sin(fiz);
   y1:=(xf-x0)*sin(fiz)+(yf-y0)*cos(fiz);
   xf:=x1+x0;
   yf:=y1+y0;
   Draw;
   XS:=X;
   exit;
   end;
//---Смещение
if down=3 then
   begin
   dt:=XS-X;dt:=dt/5;
   fi:=Angle(xf-x0,yf-y0);
   dtx:=-cos((fi-90)*PI/180)*dt;dty:=-sin((fi-90)*PI/180)*dt;
   xf:=xf+dtx;
   yf:=yf+dty;
   x0:=x0+dtx;
   y0:=y0+dty;
   Draw;
   XS:=X;
   exit;
   end;
end;
 
//--Отжатие мыши
procedure TOGLForm.GLBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
down:=0;
end;
 
//--Рисовать
procedure TOGLForm.GLBoxPaint(Sender: TObject);
begin
Draw;
end;
 
//--Задать параметры рисования, нарисовать "пол"
procedure TOGLForm.CreateBase;
begin
glClearColor(0.8,0.9,1.0,1);
 
glCullFace(GL_FRONT_AND_BACK);
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glShadeModel(GL_SMOOTH);
glHint(GL_POLYGON_SMOOTH_HINT, GL_FASTEST);
glEnable(GL_POLYGON_SMOOTH);
glHint(GL_POINT_SMOOTH_HINT, GL_FASTEST);
glEnable(GL_POINT_SMOOTH);
glHint(GL_LINE_SMOOTH_HINT, GL_FASTEST);
glEnable(GL_LINE_SMOOTH);
glDisable( GL_DEPTH_TEST );
glEnable( GL_ALPHA_TEST );
glClear(GL_COLOR_BUFFER_BIT);
 
glMatrixMode(gl_Projection);
glLoadIdentity;
 
gluPerspective(45,Width/Height, 0.1, 1000);
glViewport(0,0,Width,Height);
gluLookAt(xf,yf,zf,x0,y0,z0,0,0,1);
 
glBegin(gl_Quads);
glColor3f(0.3,0.5,0);
glVertex3f(200,200,0);
glVertex3f(200,-200,0);
glVertex3f(-200,-200,0);
glVertex3f(-200,200,0);
glEnd;
end;
 
//--Рисовать сетку
procedure TOGLForm.CreateNet;
var i,j:integer;
begin
glColor3f(1,1,0);
glLineWidth(1.0);
glBegin(gl_Lines);
for i:=0 to 10 do
   begin
   glVertex3f(-50,i*10-50,0);glVertex3f(50,i*10-50,0);
   glVertex3f(i*10-50,-50,0);glVertex3f(i*10-50,50,0);
   end;
glEnd;
end;
 
//--Рисовать
procedure TOGLForm.Draw;
begin
CreateBase;
CreateNet;
 
GLBox.SwapBuffers;
end;
 
end.
Миниатюры
Нажмите на изображение для увеличения
Название: 1108.gif
Просмотров: 301
Размер:	2.11 Мб
ID:	9140  
Метки lazarus, opengl
Размещено в Без категории
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Всего комментариев 0
Комментарии
 
Новые блоги и статьи
Программа опроса у.з. расходомера SLS-720F
Argus19 02.09.2026
Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .
Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0.
Maks 31.08.2026
При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .
Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм
anaschu 30.08.2026
Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .
Оттачиваю умение писать js программы.
russiannick 30.08.2026
Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .
мат медиц модель 30. презентация проекта
anaschu 27.08.2026
хоп хоп хоп хидахоп, а я кладую))
Как у меня протекала болезнь
zorxor 27.08.2026
Здравствуйте, друзья! Эта запись блога предназначена именно для вас - для моих дорогих друзей, которые знали меня лично. Чтобы ответить на вопрос - а что же со мной произошло на самом деле? Я учился. . .
Нашел вот забавное видео о измерениях. Лучшее что я видел на эту тему
kumehtar 26.08.2026
ILETXiw9bMQ Основная суть и тезисы по измерениям: 0D (Нулевое измерение): точка, не имеющая длины, ширины, высоты или объема. Объект не может перемещаться в 0D. 1D (Первое измерение):. . .
[EasyBuilder Pro] Памятка по разработке для панелей Weintek
ФедосеевПавел 26.08.2026
Памятка по разработке для панелей Weintek ВВЕДЕНИЕ Ранее, при реализации проектов основное внимание уделял разработке управляющей программы для контроллера, а панели оператора доставалось время. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru