Форум программистов, компьютерный форум, киберфорум
Delphi: Графика, звук, видео
Форум программистов и сисадминов Киберфорум > Форум программистов > Delphi > Delphi: Графика, звук, видео
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.91/11: Рейтинг темы: голосов - 11, средняя оценка - 4.91
0 / 0 / 4
Регистрация: 21.08.2017
Сообщений: 205
1

Зумирование камеры при вращении колеса мыши в GLScene на Delphi

13.09.2019, 07:51. Показов 2309. Ответов 13
Метки glscene 1.8, onmousewheel, rad studio 10.3, масштаб объектов (Все метки)
Author24 — интернет-сервис помощи студентам
Доброе утро! Из-за ошибок с библиотеками базовой и расширенной геометрии, описанных в этой теме,
Обработка событий для кнопок в RAD Studio 10.3
я перешёл с C++ на Delphi. В методичке из лабораторки и в блоге Артёма Калашника (https://vk.com/notes40524438) было задание - зумировать камеру при вращении колеса мыши с кодом на C++:

C++
1
2
3
4
5
6
7

void __fastcall TForm1::FormMouseWheel(TObject *Sender, TShiftState Shift,
      int WheelDelta, TPoint &MousePos, bool &Handled)
{
     if(GLSceneViewer1->MouseInControl==true){
       GLCamera1->AdjustDistanceToTarget(Power(1.1,-WheelDelta/120));
     }
}
Я перевёл код на Delphi, но компилятор не знает функцию Power.

Фрагмент кода:
Delphi
1
2
3
4
5
6

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
if(GLSceneViewer1.MouseInControl=true) then GLCamera1.AdjustDistanceToTarget(Power(1.1,-WheelDelta/120))
 
end;
Ошибки:
SQL
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

Checking project dependencies...
Compiling Project1.dproj (Debug, Win32)
dcc32 command line FOR "Project1.dpr"
  c:\program files (x86)\embarcadero\studio\20.0\bin\dcc32.exe -$O- -$W+ --no-config -M -Q -TX.exe -AGenerics.Collections=System.Generics.Collections;
  Generics.Defaults=System.Generics.Defaults;WinTypes=Winapi.Windows;WinProcs=Winapi.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE -DDEBUG 
  -E.\Win32\Debug -I"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\debug";"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";
  "C:\Users\Владимир\Documents\Embarcadero\Studio\20.0\Imports";"c:\program files (x86)\embarcadero\studio\20.0\Imports";
  C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";D:\GLScene\SOURCE;
  D:\GLScene\SOURCE\Basis;D:\GLScene\SOURCE\DesignTime;D:\GLScene\SOURCE\FileFormats;D:\GLScene\SOURCE\GameAPIs;D:\GLScene\SOURCE\ParallelAPIs;
  D:\GLScene\SOURCE\PhysicsAPIs;D:\GLScene\SOURCE\ScriptingAPIs;D:\GLScene\SOURCE\Shaders;D:\GLScene\SOURCE\SoundVideoAPIs 
  -LEC:\Users\Public\Documents\Embarcadero\Studio\20.0\Bpl -LNC:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp -NU.\Win32\Debug -NSWinapi;
  System.Win;DATA.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;System;Xml;DATA;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell; 
  -O"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";"C:\Users\Владимир\Documents\Embarcadero\Studio\20.0\Imports";"c:\program files 
  (x86)\embarcadero\studio\20.0\Imports";C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";
  D:\GLScene\SOURCE;D:\GLScene\SOURCE\Basis;D:\GLScene\SOURCE\DesignTime;D:\GLScene\SOURCE\FileFormats;D:\GLScene\SOURCE\GameAPIs;
  D:\GLScene\SOURCE\ParallelAPIs;D:\GLScene\SOURCE\PhysicsAPIs;D:\GLScene\SOURCE\ScriptingAPIs;D:\GLScene\SOURCE\Shaders;
  D:\GLScene\SOURCE\SoundVideoAPIs -R"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";
  "C:\Users\Владимир\Documents\Embarcadero\Studio\20.0\Imports";"c:\program files (x86)\embarcadero\studio\20.0\Imports";
  C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";D:\GLScene\SOURCE;
  D:\GLScene\SOURCE\Basis;D:\GLScene\SOURCE\DesignTime;D:\GLScene\SOURCE\FileFormats;D:\GLScene\SOURCE\GameAPIs;D:\GLScene\SOURCE\ParallelAPIs;
  D:\GLScene\SOURCE\PhysicsAPIs;D:\GLScene\SOURCE\ScriptingAPIs;D:\GLScene\SOURCE\Shaders;D:\GLScene\SOURCE\SoundVideoAPIs -U"c:\program files 
  (x86)\embarcadero\studio\20.0\lib\Win32\debug";"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";
  "C:\Users\Владимир\Documents\Embarcadero\Studio\20.0\Imports";"c:\program files (x86)\embarcadero\studio\20.0\Imports";
  C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";D:\GLScene\SOURCE;
  D:\GLScene\SOURCE\Basis;D:\GLScene\SOURCE\DesignTime;D:\GLScene\SOURCE\FileFormats;D:\GLScene\SOURCE\GameAPIs;D:\GLScene\SOURCE\ParallelAPIs;
  D:\GLScene\SOURCE\PhysicsAPIs;D:\GLScene\SOURCE\ScriptingAPIs;D:\GLScene\SOURCE\Shaders;D:\GLScene\SOURCE\SoundVideoAPIs -V -VN 
  -NBC:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp -NHC:\Users\Public\Documents\Embarcadero\Studio\20.0\hpp\Win32 -NO.\Win32\Debug  
  Project1.dpr   
[dcc32 Error] Lab1.pas(68): E2003 Undeclared identifier: 'Power'
[dcc32 Fatal Error] Project1.dpr(5): F2063 Could NOT compile used unit 'Lab1.pas'
Failed
Elapsed TIME: 00:00:00.8
Прогуглив, я увидел решение с помощью ScrollBox и TImage, но не понял, что это за объект Image1. А у куба (TGLCube1) и камеры (TGLCamera1) нет свойств Height и Width.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Image1.Width:=Round(Image1.Width/K);
  Image1.Height:=Round(Image1.Height/K);
end;
 
procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Image1.Width:=Round(Image1.Width*K);
  Image1.Height:=Round(Image1.Height*K);
end;
А в теме на Вашем форуме про автоскрол (AutoScroll и колесо мыши) я не понял объект Self:

Delphi
1
2
3
4
5
6

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  Self.VertScrollBar.Position := Self.VertScrollBar.Position - WheelDelta;
  Handled := true;
end;
Извините за нубство! Я перешёл на Delphi вынужденно и не хочу возвращаться на C++, т.к. не знаю, где искать библиотеки для базовой и расширенной геометрии на C++, как они называются, какой у них формат файла и куда их "закидывать". Как сделать зумирование камеры при вращении колеса мыши другим путём, в обход функции Power?

Исходный код проекта:
Delphi
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

unit Lab1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GLScene, GLCoordinates, GLObjects, GLKeyboard,
  GLWin32Viewer, GLCrossPlatform, GLBaseClasses, GLGeomObjects, Vcl.StdCtrls,
  GLCadencer, GLNavigator;
 
type
  TForm1 = class(TForm)
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCube1: TGLCube;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLCamera2: TGLCamera;
    GLTorus1: TGLTorus;
    GLLightSource2: TGLLightSource;
    Button1: TButton;
    Button2: TButton;
    GLCadencer1: TGLCadencer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure GLCadencer1Progress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    mx,my: Integer;
  end;
  Coordinates = record
     X,Y,Z: double;
  end;
var
  Form1: TForm1;
  CubeObject: TGLCube;
  SphereObject: TGLSphere;
  dx,dy,dz: Integer;
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
   GLSceneViewer1.Camera:=GLCamera1;
   Button1.Enabled:=False;
   Button2.Enabled:=True;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
   GLSceneViewer1.Camera:=GLCamera2;
   Button2.Enabled:=False;
   Button1.Enabled:=True;
end;
 
procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime,
  newTime: Double);
begin
GLCube1.Turn(deltaTime*10);
GLTorus1.Turn(deltaTime*10);
//Движение вперед по клавишам ‘ц’ и’ w’
if (IsKeyDown('ц') OR IsKeyDown('w')) then GLCamera1.Move(2* deltaTime);
//Движение назад по клавишам ‘ы’ и ‘s’
if (IsKeyDown('ы') OR IsKeyDown('s')) then GLCamera1.Move(-2* deltaTime);
//Поворот влево по клавишам ‘ф’ и’ a’
if (IsKeyDown('ф') OR IsKeyDown('a')) then GLCamera1.slide(-2* deltaTime);
//Поворот вправо по клавишам ‘в’ и ‘d’
if (IsKeyDown('в') OR IsKeyDown('d')) then GLCamera1.slide(2* deltaTime);
//Движение вверх по клавишам ‘u’ и ‘г’
if (IsKeyDown('u')) OR IsKeyDown('г') then GLCamera1.Lift(0.01);
//Движение вниз по клавишам ‘n’ и ‘т’
if (IsKeyDown('n')) OR IsKeyDown('т') then GLCamera1.Lift(-0.01)
end;
 
procedure TForm1.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mx:=x; my:=y; //Запомнить координаты мыши
end;
 
procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Shift<>[] then begin //Если нажата клавиша
  GLCamera1.MoveAroundTarget(my-y, mx-x); //Перемещаем камеру вокруг целевого объекта
  GLLightSource1.Position:=GLCamera1.Position; //Пусть источник освещения будет рядом с камерой
  mx:=x; my:=y;
  end;
end;
 
end.
Миниатюры
Зумирование камеры при вращении колеса мыши в GLScene на Delphi   Зумирование камеры при вращении колеса мыши в GLScene на Delphi  
Вложения
Тип файла: zip lab1-delphi.zip (5.03 Мб, 2 просмотров)
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 13.09.2019, 07:51
Ответы с готовыми решениями:

При вращении колеса мыши окно изменяет размер
Пустое окно. При вращении колеса мыши окно изменяет размер. public void mousePressed(MouseEvent...

Делаю выбор мышкой как в Warcraft3. Но координаты меняются при вращении камеры
Делаю выбор 3д объектов мышкой. Тоесть тяну мышкой и рисуется прямоугольник. Все что поподет в...

Перемещение камеры при нажатой левой клавише мыши; проблемы с обзором мыши и видимостью указателя
Добрый день! У меня есть проект с кубом, кольцом и двумя кнопками из прошлой темы...

Масштабирование фигуры при прокрутке колеса мыши
Всем привет. Кто поможет разобраться с масштабированием? Например, есть фигура (круг) в канаве,...

13
Модератор
9256 / 6034 / 2379
Регистрация: 21.01.2014
Сообщений: 25,795
Записей в блоге: 3
13.09.2019, 08:03 2
Цитата Сообщение от БузинВладимир Посмотреть сообщение
компилятор не знает функцию Power
подключите в секции uses модуль Math.
Цитата Сообщение от БузинВладимир Посмотреть сообщение
что это за объект Image1
Компонент для отображения картинок на форме. Находится на закладке Additional палитры компонентов
Цитата Сообщение от БузинВладимир Посмотреть сообщение
я не понял объект Self
Раз Вы перешли с C++, то должны знать, что такое указатель this. Так вот, Self - это его аналог в Delphi
0
0 / 0 / 4
Регистрация: 21.08.2017
Сообщений: 205
13.09.2019, 08:44  [ТС] 3
Библиотеку подключил, но при запуске проект на колесо мыши по-прежнему не реагирует. Заглянул в инспектор объектов для GLSceneViewer1, а там свойства MouseInControl нет. Убрал условие - на колёсико опять ноль реакции. Прописал насильно в обработчике OnCreate для формы - проект не запустился и компилятор выдал ошибки:

SQL
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

Checking project dependencies...
Compiling Project1.dproj (Debug, Win32)
dcc32 command line FOR "Project1.dpr"
  c:\program files (x86)\embarcadero\studio\20.0\bin\dcc32.exe -$O- -$W+ --no-config -M -Q -TX.exe -AGenerics.Collections=System.Generics.Collections;
  Generics.Defaults=System.Generics.Defaults;WinTypes=Winapi.Windows;WinProcs=Winapi.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE -DDEBUG 
  -E.\Win32\Debug -I"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\debug";"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";
  "C:\Users\Владимир\Documents\Embarcadero\Studio\20.0\Imports";"c:\program files (x86)\embarcadero\studio\20.0\Imports";
  C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";D:\GLScene\SOURCE;
  D:\GLScene\SOURCE\Basis;D:\GLScene\SOURCE\DesignTime;D:\GLScene\SOURCE\FileFormats;D:\GLScene\SOURCE\GameAPIs;D:\GLScene\SOURCE\ParallelAPIs;
  D:\GLScene\SOURCE\PhysicsAPIs;D:\GLScene\SOURCE\ScriptingAPIs;D:\GLScene\SOURCE\Shaders;D:\GLScene\SOURCE\SoundVideoAPIs 
  -LEC:\Users\Public\Documents\Embarcadero\Studio\20.0\Bpl -LNC:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp -NU.\Win32\Debug -NSWinapi;
  System.Win;DATA.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;System;Xml;DATA;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell; 
  -O"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";"C:\Users\Владимир\Documents\Embarcadero\Studio\20.0\Imports";"c:\program files 
  (x86)\embarcadero\studio\20.0\Imports";C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";
  D:\GLScene\SOURCE;D:\GLScene\SOURCE\Basis;D:\GLScene\SOURCE\DesignTime;D:\GLScene\SOURCE\FileFormats;D:\GLScene\SOURCE\GameAPIs;
  D:\GLScene\SOURCE\ParallelAPIs;D:\GLScene\SOURCE\PhysicsAPIs;D:\GLScene\SOURCE\ScriptingAPIs;D:\GLScene\SOURCE\Shaders;
  D:\GLScene\SOURCE\SoundVideoAPIs -R"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";
  "C:\Users\Владимир\Documents\Embarcadero\Studio\20.0\Imports";"c:\program files (x86)\embarcadero\studio\20.0\Imports";
  C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";D:\GLScene\SOURCE;
  D:\GLScene\SOURCE\Basis;D:\GLScene\SOURCE\DesignTime;D:\GLScene\SOURCE\FileFormats;D:\GLScene\SOURCE\GameAPIs;D:\GLScene\SOURCE\ParallelAPIs;
  D:\GLScene\SOURCE\PhysicsAPIs;D:\GLScene\SOURCE\ScriptingAPIs;D:\GLScene\SOURCE\Shaders;D:\GLScene\SOURCE\SoundVideoAPIs -U"c:\program files 
  (x86)\embarcadero\studio\20.0\lib\Win32\debug";"c:\program files (x86)\embarcadero\studio\20.0\lib\Win32\release";
  "C:\Users\Владимир\Documents\Embarcadero\Studio\20.0\Imports";"c:\program files (x86)\embarcadero\studio\20.0\Imports";
  C:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp;"c:\program files (x86)\embarcadero\studio\20.0\include";D:\GLScene\SOURCE;
  D:\GLScene\SOURCE\Basis;D:\GLScene\SOURCE\DesignTime;D:\GLScene\SOURCE\FileFormats;D:\GLScene\SOURCE\GameAPIs;D:\GLScene\SOURCE\ParallelAPIs;
  D:\GLScene\SOURCE\PhysicsAPIs;D:\GLScene\SOURCE\ScriptingAPIs;D:\GLScene\SOURCE\Shaders;D:\GLScene\SOURCE\SoundVideoAPIs -V -VN 
  -NBC:\Users\Public\Documents\Embarcadero\Studio\20.0\Dcp -NHC:\Users\Public\Documents\Embarcadero\Studio\20.0\hpp\Win32 -NO.\Win32\Debug  
  Project1.dpr   
[dcc32 Error] Lab1.pas(68): E2129 Cannot assign TO a read-ONLY property
[dcc32 Fatal Error] Project1.dpr(5): F2063 Could NOT compile used unit 'Lab1.pas'
Failed
Elapsed TIME: 00:00:01.0
Я даже сам не знаю, в чём дело - или функция не из математической библиотеки нужна, или свойство MouseInControl "кастрировано".
0
0 / 0 / 4
Регистрация: 21.08.2017
Сообщений: 205
14.09.2019, 08:22  [ТС] 4
Я попробовал сделать через ScrollBox, но увидел, что вложить в него прямо из панели инструментов можно только новый объект, а уже существующие надо сделать дочерними. Я читал, что есть функция AddNewChild, которая прописывается в OnCreate при создании формы, но это сработает только при запуске программы, а при разработке ScrollBox всё равно ляжет поверх GLSceneViewer, даже если последний меньше. Какое свойство отвечает за удочерение объектов по отношению к ScrollBox, где его искать, и что мне нужно - Owner или Parent?
0
691 / 5405 / 265
Регистрация: 11.08.2016
Сообщений: 3,355
14.09.2019, 13:40 5
Объяви функцию как обработчик сообщения Windows, например:
procedure WMWheelEventHandler(var Msg : TWMMouse); message WM_MOUSEWHEEL;
0
0 / 0 / 4
Регистрация: 21.08.2017
Сообщений: 205
14.09.2019, 14:41  [ТС] 6
Что это за событие в инспекторе объектов, и для какого компонента? Ведь первым идёт не Form или Cadencer. Прогуглив, я увидел, что проблему наследования люди решают строкой,

Delphi
1

Daughter.Parent:=Mother;
прописанной для OnCreate. Но это справедливо только для исполнения проекта, а не для разработки. К тому же у GLSceneViewer нет в инспекторе свойства Parent, хотя Height и Width есть.

Добавлено через 7 минут
Есть только ParentHint, который берёттолько True или False.
0
691 / 5405 / 265
Регистрация: 11.08.2016
Сообщений: 3,355
14.09.2019, 19:18 7
Это не событие в инспекторе объектов.
Заголовок надо прописать руками в объявлении класса формы, а тело - дальше, вручную же.
0
0 / 0 / 4
Регистрация: 21.08.2017
Сообщений: 205
14.09.2019, 20:33  [ТС] 8
Я к тому, что, если событие для формы не выбрано в инспекторе объектов, оно и не запустится, ведь графа для этого события всё ещё пуста.

Добавлено через 1 минуту
Прописывай- не прописывай-, если графа у инспектора на вкладке Events пуста, компилятор его и не увидит.

Добавлено через 2 минуты
Вы имеете ввиду, что лучше создать новый проект и первым делом вставить в него ScrollBox, а потом - в этот ScrollBox прямо из панели вставить всё остальное, чем возиться с уже существующим?

Добавлено через 54 минуты
Компилятор опять умудрился выдать ошибку:

Delphi
1
2
3
4
5
6

[dcc32 Error] Lab1.pas(109): E2003 Undeclared identifier: 'message'
[dcc32 Error] Lab1.pas(109): E2014 Statement expected, but expression of type 'Integer' found
[dcc32 Error] Lab1.pas(34): E2065 Unsatisfied forward or external declaration: 'TForm1.WMWheelEventHandler'
[dcc32 Fatal Error] Project1.dpr(5): F2063 Could not compile used unit 'Lab1.pas'
Failed
Elapsed time: 00:00:01.0
Во весь исходник:
Delphi
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

unit Lab1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GLScene, GLCoordinates, GLObjects, GLKeyboard, Math,
  GLWin32Viewer, GLCrossPlatform, GLBaseClasses, GLGeomObjects, Vcl.StdCtrls,
  GLCadencer, GLNavigator;
 
type
  TForm1 = class(TForm)
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCube1: TGLCube;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLCamera2: TGLCamera;
    GLTorus1: TGLTorus;
    GLLightSource2: TGLLightSource;
    Button1: TButton;
    Button2: TButton;
    GLCadencer1: TGLCadencer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure GLCadencer1Progress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure WMWheelEventHandler(var Msg : TWMMouse);
  private
    { Private declarations }
  public
    mx,my: Integer;
  end;
  Coordinates = record
     X,Y,Z: double;
  end;
var
  Form1: TForm1;
  CubeObject: TGLCube;
  SphereObject: TGLSphere;
  dx,dy,dz: Integer;
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
   GLSceneViewer1.Camera:=GLCamera1;
   Button1.Enabled:=False;
   Button2.Enabled:=True;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
   GLSceneViewer1.Camera:=GLCamera2;
   Button2.Enabled:=False;
   Button1.Enabled:=True;
end;
 
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if(GLSceneViewer1.MouseInControl=true) then GLCamera1.AdjustDistanceToTarget(Power(1.1,-WheelDelta/120))
end;
 
procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime,
  newTime: Double);
begin
//GLCube1.Turn(deltaTime*10);
//GLTorus1.Turn(deltaTime*10);
//Движение вперед по клавишам ‘ц’ и’ w’
if (IsKeyDown('ц') OR IsKeyDown('w')) then GLCamera1.Move(2* deltaTime);
//Движение назад по клавишам ‘ы’ и ‘s’
if (IsKeyDown('ы') OR IsKeyDown('s')) then GLCamera1.Move(-2* deltaTime);
//Поворот влево по клавишам ‘ф’ и’ a’
if (IsKeyDown('ф') OR IsKeyDown('a')) then GLCamera1.slide(-2* deltaTime);
//Поворот вправо по клавишам ‘в’ и ‘d’
if (IsKeyDown('в') OR IsKeyDown('d')) then GLCamera1.slide(2* deltaTime);
//Движение вверх по клавишам ‘u’ и ‘г’
if (IsKeyDown('u')) OR IsKeyDown('г') then GLCamera1.Lift(0.01);
//Движение вниз по клавишам ‘n’ и ‘т’
if (IsKeyDown('n')) OR IsKeyDown('т') then GLCamera1.Lift(-0.01)
end;
 
procedure TForm1.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mx:=x; my:=y; //Запомнить координаты мыши
end;
 
procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Shift<>[] then begin //Если нажата клавиша
  GLCamera1.MoveAroundTarget(my-y, mx-x); //Перемещаем камеру вокруг целевого объекта
  GLLightSource1.Position:=GLCamera1.Position; //Пусть источник освещения будет рядом с камерой
  mx:=x; my:=y;
  end;
end;
 
procedure WMWheelEventHandler(var Msg : TWMMouse);
begin
message WM_MOUSEWHEEL;
end;
 
end.
Вывод только один - надо было думать перед созданием проекта и ещё на чистом окне формы поместить ScrollBox, а в него - всё остальное.
0
691 / 5405 / 265
Регистрация: 11.08.2016
Сообщений: 3,355
15.09.2019, 09:42 9
https://www.helloworld.ru/text... /les19.htm

В конце
0
0 / 0 / 4
Регистрация: 21.08.2017
Сообщений: 205
15.09.2019, 12:22  [ТС] 10
Сообщение на колесо мыши выводится, тут либо свойство MouseInControl для GLSceneViewer "кастрировано", либо функция Power нужна не из библиотеки Math. На всякий случай, я пошёл вторым путём - пересоздал проект и кинул всё в ScrollBox. Потом скажу, где будут ошибки.

Исходный код программы:
Delphi
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

unit Lab1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GLScene, GLCoordinates, GLObjects, GLKeyboard, Math,
  GLWin32Viewer, GLCrossPlatform, GLBaseClasses, GLGeomObjects, Vcl.StdCtrls,
  GLCadencer, GLNavigator;
 
type
  TForm1 = class(TForm)
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCube1: TGLCube;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLCamera2: TGLCamera;
    GLTorus1: TGLTorus;
    GLLightSource2: TGLLightSource;
    Button1: TButton;
    Button2: TButton;
    GLCadencer1: TGLCadencer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure GLCadencer1Progress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
     procedure WMWheelEventHandler(var Msg : TWMMouse); message WM_MOUSEWHEEL;
  private
    { Private declarations }
  public
    mx,my: Integer;
  end;
  Coordinates = record
     X,Y,Z: double;
  end;
var
  Form1: TForm1;
  CubeObject: TGLCube;
  SphereObject: TGLSphere;
  dx,dy,dz: Integer;
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
   GLSceneViewer1.Camera:=GLCamera1;
   Button1.Enabled:=False;
   Button2.Enabled:=True;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
   GLSceneViewer1.Camera:=GLCamera2;
   Button2.Enabled:=False;
   Button1.Enabled:=True;
end;
 
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
if(GLSceneViewer1.MouseInControl=true) then GLCamera1.AdjustDistanceToTarget(Power(1.1,-WheelDelta/120))
end;
 
procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime,
  newTime: Double);
begin
//GLCube1.Turn(deltaTime*10);
//GLTorus1.Turn(deltaTime*10);
//Движение вперед по клавишам ‘ц’ и’ w’
if (IsKeyDown('ц') OR IsKeyDown('w')) then GLCamera1.Move(2* deltaTime);
//Движение назад по клавишам ‘ы’ и ‘s’
if (IsKeyDown('ы') OR IsKeyDown('s')) then GLCamera1.Move(-2* deltaTime);
//Поворот влево по клавишам ‘ф’ и’ a’
if (IsKeyDown('ф') OR IsKeyDown('a')) then GLCamera1.slide(-2* deltaTime);
//Поворот вправо по клавишам ‘в’ и ‘d’
if (IsKeyDown('в') OR IsKeyDown('d')) then GLCamera1.slide(2* deltaTime);
//Движение вверх по клавишам ‘u’ и ‘г’
if (IsKeyDown('u')) OR IsKeyDown('г') then GLCamera1.Lift(0.01);
//Движение вниз по клавишам ‘n’ и ‘т’
if (IsKeyDown('n')) OR IsKeyDown('т') then GLCamera1.Lift(-0.01)
end;
 
procedure TForm1.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mx:=x; my:=y; //Запомнить координаты мыши
end;
 
procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Shift<>[] then begin //Если нажата клавиша
  GLCamera1.MoveAroundTarget(my-y, mx-x); //Перемещаем камеру вокруг целевого объекта
  GLLightSource1.Position:=GLCamera1.Position; //Пусть источник освещения будет рядом с камерой
  mx:=x; my:=y;
  end;
end;
 
procedure TForm1.WMWheelEventHandler(var Msg : TWMMouse);
begin
MessageDlg('Mouse wheel', mtInformation,
 
[mbOK], 0);
end;
 
end.
Миниатюры
Зумирование камеры при вращении колеса мыши в GLScene на Delphi  
0
0 / 0 / 4
Регистрация: 21.08.2017
Сообщений: 205
15.09.2019, 12:45  [ТС] 11
Вот то, о чём я говорил раньше. При попытке насильно прописать MouseInControl в True в создателе формы OnCreate

Delphi
1
2
3
4

procedure TForm1.FormCreate(Sender: TObject);
begin
  GLSceneViewer1.MouseInControl:=True;
end;
компилятор выводит ошибки.

SQL
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

[dcc32 Error] Lab1.pas(69): E2129 Cannot assign TO a read-ONLY property
[dcc32 Fatal Error] Project1.dpr(5): F2063 Could NOT compile used unit 'Lab1.pas'
Failed
Elapsed TIME: 00:00:00.8
 
Исходник целиком:
 
[DELPHI]
unit Lab1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GLScene, GLCoordinates, GLObjects, GLKeyboard, Math,
  GLWin32Viewer, GLCrossPlatform, GLBaseClasses, GLGeomObjects, Vcl.StdCtrls,
  GLCadencer, GLNavigator;
 
TYPE
  TForm1 = class(TForm)
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCube1: TGLCube;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLCamera2: TGLCamera;
    GLTorus1: TGLTorus;
    GLLightSource2: TGLLightSource;
    Button1: TButton;
    Button2: TButton;
    GLCadencer1: TGLCadencer;
    PROCEDURE Button1Click(Sender: TObject);
    PROCEDURE Button2Click(Sender: TObject);
    PROCEDURE GLCadencer1Progress(Sender: TObject; const deltaTime,
      newTime: DOUBLE);
    PROCEDURE GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: INTEGER);
    PROCEDURE GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: INTEGER);
    PROCEDURE FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: INTEGER; MousePos: TPoint; var Handled: BOOLEAN);
    PROCEDURE FormCreate(Sender: TObject);
    //PROCEDURE WMWheelEventHandler(var Msg : TWMMouse); message WM_MOUSEWHEEL;
  private
    { Private declarations }
  public
    mx,my: INTEGER;
  END;
  Coordinates = record
     X,Y,Z: DOUBLE;
  END;
var
  Form1: TForm1;
  CubeObject: TGLCube;
  SphereObject: TGLSphere;
  dx,dy,dz: INTEGER;
implementation
 
{$R *.dfm}
 
PROCEDURE TForm1.Button1Click(Sender: TObject);
BEGIN
   GLSceneViewer1.Camera:=GLCamera1;
   Button1.Enabled:=FALSE;
   Button2.Enabled:=TRUE;
END;
 
PROCEDURE TForm1.Button2Click(Sender: TObject);
BEGIN
   GLSceneViewer1.Camera:=GLCamera2;
   Button2.Enabled:=FALSE;
   Button1.Enabled:=TRUE;
END;
 
PROCEDURE TForm1.FormCreate(Sender: TObject);
BEGIN
  GLSceneViewer1.MouseInControl:=TRUE;
END;
 
PROCEDURE TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: INTEGER; MousePos: TPoint; var Handled: BOOLEAN);
BEGIN
IF(GLSceneViewer1.MouseInControl=TRUE) THEN GLCamera1.AdjustDistanceToTarget(POWER(1.1,-WheelDelta/120))
END;
 
PROCEDURE TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime,
  newTime: DOUBLE);
BEGIN
//GLCube1.Turn(deltaTime*10);
//GLTorus1.Turn(deltaTime*10);
//Движение вперед по клавишам ‘ц’ и’ w’
IF (IsKeyDown('ц') OR IsKeyDown('w')) THEN GLCamera1.Move(2* deltaTime);
//Движение назад по клавишам ‘ы’ и ‘s’
IF (IsKeyDown('ы') OR IsKeyDown('s')) THEN GLCamera1.Move(-2* deltaTime);
//Поворот влево по клавишам ‘ф’ и’ a’
IF (IsKeyDown('ф') OR IsKeyDown('a')) THEN GLCamera1.slide(-2* deltaTime);
//Поворот вправо по клавишам ‘в’ и ‘d’
IF (IsKeyDown('в') OR IsKeyDown('d')) THEN GLCamera1.slide(2* deltaTime);
//Движение вверх по клавишам ‘u’ и ‘г’
IF (IsKeyDown('u')) OR IsKeyDown('г') THEN GLCamera1.Lift(0.01);
//Движение вниз по клавишам ‘n’ и ‘т’
IF (IsKeyDown('n')) OR IsKeyDown('т') THEN GLCamera1.Lift(-0.01)
END;
 
PROCEDURE TForm1.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: INTEGER);
BEGIN
  mx:=x; my:=y; //Запомнить координаты мыши
END;
 
PROCEDURE TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: INTEGER);
BEGIN
  IF Shift<>[] THEN BEGIN //Если нажата клавиша
  GLCamera1.MoveAroundTarget(my-y, mx-x); //Перемещаем камеру вокруг целевого объекта
  GLLightSource1.Position:=GLCamera1.Position; //Пусть источник освещения будет рядом с камерой
  mx:=x; my:=y;
  END;
END;
 
{PROCEDURE TForm1.WMWheelEventHandler(var Msg : TWMMouse);
BEGIN
MessageDlg('Mouse wheel', mtInformation,
 
[mbOK], 0);
END;}
 
END.
[/DELPHI]
Добавлено через 1 минуту
Ошибки:

Delphi
1
2
3
4

[dcc32 Error] Lab1.pas(69): E2129 Cannot assign TO a read-ONLY property
[dcc32 Fatal Error] Project1.dpr(5): F2063 Could NOT compile used unit 'Lab1.pas'
Failed
Elapsed TIME: 00:00:00.8
Код проекта:
Delphi
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

unit Lab1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GLScene, GLCoordinates, GLObjects, GLKeyboard, Math,
  GLWin32Viewer, GLCrossPlatform, GLBaseClasses, GLGeomObjects, Vcl.StdCtrls,
  GLCadencer, GLNavigator;
 
type
  TForm1 = class(TForm)
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCube1: TGLCube;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLCamera2: TGLCamera;
    GLTorus1: TGLTorus;
    GLLightSource2: TGLLightSource;
    Button1: TButton;
    Button2: TButton;
    GLCadencer1: TGLCadencer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure GLCadencer1Progress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
    //procedure WMWheelEventHandler(var Msg : TWMMouse); message WM_MOUSEWHEEL;
  private
    { Private declarations }
  public
    mx,my: Integer;
  end;
  Coordinates = record
     X,Y,Z: double;
  end;
var
  Form1: TForm1;
  CubeObject: TGLCube;
  SphereObject: TGLSphere;
  dx,dy,dz: Integer;
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
   GLSceneViewer1.Camera:=GLCamera1;
   Button1.Enabled:=False;
   Button2.Enabled:=True;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
   GLSceneViewer1.Camera:=GLCamera2;
   Button2.Enabled:=False;
   Button1.Enabled:=True;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  GLSceneViewer1.MouseInControl:=True;
end;
 
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
if(GLSceneViewer1.MouseInControl=true) then GLCamera1.AdjustDistanceToTarget(Power(1.1,-WheelDelta/120))
end;
 
procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime,
  newTime: Double);
begin
//GLCube1.Turn(deltaTime*10);
//GLTorus1.Turn(deltaTime*10);
//Движение вперед по клавишам ‘ц’ и’ w’
if (IsKeyDown('ц') OR IsKeyDown('w')) then GLCamera1.Move(2* deltaTime);
//Движение назад по клавишам ‘ы’ и ‘s’
if (IsKeyDown('ы') OR IsKeyDown('s')) then GLCamera1.Move(-2* deltaTime);
//Поворот влево по клавишам ‘ф’ и’ a’
if (IsKeyDown('ф') OR IsKeyDown('a')) then GLCamera1.slide(-2* deltaTime);
//Поворот вправо по клавишам ‘в’ и ‘d’
if (IsKeyDown('в') OR IsKeyDown('d')) then GLCamera1.slide(2* deltaTime);
//Движение вверх по клавишам ‘u’ и ‘г’
if (IsKeyDown('u')) OR IsKeyDown('г') then GLCamera1.Lift(0.01);
//Движение вниз по клавишам ‘n’ и ‘т’
if (IsKeyDown('n')) OR IsKeyDown('т') then GLCamera1.Lift(-0.01)
end;
 
procedure TForm1.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mx:=x; my:=y; //Запомнить координаты мыши
end;
 
procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Shift<>[] then begin //Если нажата клавиша
  GLCamera1.MoveAroundTarget(my-y, mx-x); //Перемещаем камеру вокруг целевого объекта
  GLLightSource1.Position:=GLCamera1.Position; //Пусть источник освещения будет рядом с камерой
  mx:=x; my:=y;
  end;
end;
 
{procedure TForm1.WMWheelEventHandler(var Msg : TWMMouse);
begin
MessageDlg('Mouse wheel', mtInformation,
 
[mbOK], 0);
end;}
 
end.
Добавлено через 12 минут
Также хочу заметить, что у GLSceneViewer в инспекторе нет свойства Stretch, которое есть у Image.
0
0 / 0 / 4
Регистрация: 21.08.2017
Сообщений: 205
16.09.2019, 08:03  [ТС] 12
Попробовал сделать через ScrollBox, но не помогло - куб и сфера на несколько минут останавливаются, а потом снова вращаются, и масштаб остаётся прежним.

Delphi
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

unit Lab1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GLScene, GLCoordinates, GLObjects, GLKeyboard,
  GLWin32Viewer, GLCrossPlatform, GLBaseClasses, GLGeomObjects, Vcl.StdCtrls,
  GLCadencer;
 
type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCube1: TGLCube;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLCamera2: TGLCamera;
    GLTorus1: TGLTorus;
    GLLightSource2: TGLLightSource;
    Button1: TButton;
    Button2: TButton;
    GLCadencer1: TGLCadencer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure GLCadencer1Progress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
  private
    { Private declarations }
  public
      mx, my: Integer;
  end;
  Coordinates = record
    X,Y,Z: double;
  end;
var
  Form1: TForm1;
  dx,dy,dz: Integer;
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
   GLSceneViewer1.Camera:=GLCamera1;
   Button1.Enabled:=False;
   Button2.Enabled:=True;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
   GLSceneViewer1.Camera:=GLCamera2;
   Button2.Enabled:=False;
   Button1.Enabled:=True;
end;
 
procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  GLSceneViewer1.Width:=Round(GLSceneViewer1.Width*1.2);
  GLSceneViewer1.Height:=Round(GLSceneViewer1.Height*1.2);
end;
 
procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  GLSceneViewer1.Width:=Round(GLSceneViewer1.Width/1.2);
  GLSceneViewer1.Height:=Round(GLSceneViewer1.Height/1.2);
end;
 
procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime,
  newTime: Double);
begin
GLCube1.Turn(deltaTime*10);
GLTorus1.Turn(deltaTime*10);
//Движение вперед по клавишам ‘ц’ и’ w’
if (IsKeyDown('ц') OR IsKeyDown('w')) then GLCamera1.Move(2* deltaTime);
//Движение назад по клавишам ‘ы’ и ‘s’
if (IsKeyDown('ы') OR IsKeyDown('s')) then GLCamera1.Move(-2* deltaTime);
//Поворот влево по клавишам ‘ф’ и’ a’
if (IsKeyDown('ф') OR IsKeyDown('a')) then GLCamera1.slide(-2* deltaTime);
//Поворот вправо по клавишам ‘в’ и ‘d’
if (IsKeyDown('в') OR IsKeyDown('d')) then GLCamera1.slide(2* deltaTime);
//Движение вверх по клавишам ‘u’ и ‘г’
if (IsKeyDown('u')) OR IsKeyDown('г') then GLCamera1.Lift(0.01);
//Движение вниз по клавишам ‘n’ и ‘т’
if (IsKeyDown('n')) OR IsKeyDown('т') then GLCamera1.Lift(-0.01)
end;
 
procedure TForm1.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mx:=x; my:=y; //Запомнить координаты мыши
end;
 
procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Shift<>[] then begin //Если нажата клавиша
  GLCamera1.MoveAroundTarget(my-y, mx-x); //Перемещаем камеру вокруг целевого объекта
  GLLightSource1.Position:=GLCamera1.Position; //Пусть источник освещения будет рядом с камерой
  mx:=x; my:=y;
  end;
end;
 
end.
Добавлено через 9 минут
Прописал в OnCreate свойство Stretch для GLSceneViewer, но для этого компонента такого свойства нет.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

procedure TForm1.FormCreate(Sender: TObject);
begin
  GLSceneViewer1.Stretch:=True;
end;
 
procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  GLSceneViewer1.Width:=Round(GLSceneViewer1.Width*1.2);
  GLSceneViewer1.Height:=Round(GLSceneViewer1.Height*1.2);
end;
 
procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  GLSceneViewer1.Width:=Round(GLSceneViewer1.Width/1.2);
  GLSceneViewer1.Height:=Round(GLSceneViewer1.Height/1.2);
end;
И вдобавок, камера не вращается по щелчку мыши, хотя должна вращаться:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

procedure TForm1.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mx:=x; my:=y; //Запомнить координаты мыши
end;
 
procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Shift<>[] then begin //Если нажата клавиша
  GLCamera1.MoveAroundTarget(my-y, mx-x); //Перемещаем камеру вокруг целевого объекта
  GLLightSource1.Position:=GLCamera1.Position; //Пусть источник освещения будет рядом с камерой
  mx:=x; my:=y;
  end;
end;
Какую библиотеку я должен подключить или что неправильно прописал?
0
0 / 0 / 4
Регистрация: 21.08.2017
Сообщений: 205
16.09.2019, 08:16  [ТС] 13
Вот архив с проектом.
Вложения
Тип файла: zip lab1-delphi.zip (5.02 Мб, 4 просмотров)
0
0 / 0 / 4
Регистрация: 21.08.2017
Сообщений: 205
16.09.2019, 17:07  [ТС] 14
А разгадка так близко - камера должна быть привязана к объекту, а я тупил. Надо было брать не прямое название камеры, а то, что в свойстве Camera компонента GLSceneViewer1, если метод будет универсальным. И не нужны никакие скроллбоксы.
0
16.09.2019, 17:07
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 16.09.2019, 17:07
Помогаю со студенческими работами здесь

Масштабирование изображения при прокрутке колеса мыши
Здравствуйте! Необходимо реализовать масштабирование изображения в PictureBox. Как по мне...

Подсчет количества делений при прокрутке колеса мыши
Событие MouseWheel происходит при прокрутке на очередное деление (зубец) колесика мыши, хотя Студия...

Тормоза в играх при вращении камеры/перемещении. Что это означает и что проапгрейдить?
Мой комп: проц: AMD FX 6300 Six-core processor 3.5 GHz память: 4 GB DDR3 1600 МГц или 1625 МГц...

[GLScene]Движение и вращение камеры
Кто знает как лучше всего сделать вращение камеры и движение, а то у меня очень это все глючит....


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
14
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru