ArenaZ

Форк
0
/
Unit1.pas 
198 строк · 4.6 Кб
1
unit Unit1;
2

3
{$MODE Delphi}
4

5
interface
6

7
uses
8

9
  SysUtils,
10

11
  Classes,
12
  DateUtils,
13
  Graphics,
14
  Controls,
15
  Forms,
16
  Dialogs,
17
  ExtCtrls,
18

19
  GLLCLViewer,
20
  GLAsyncTimer,
21
  GLCrossPlatform,
22
  GLBaseClasses,
23
  GLScene,
24
  GLObjects,
25
  GLCoordinates,
26
  GLGeomObjects,
27
  GLState,
28
  GLGraph,
29
  GLCadencer;
30

31
type
32

33
  { TForm1 }
34

35
  TForm1 = class(TForm)
36
    Panel1: TPanel;
37
    AsyncTimer1: TGLAsyncTimer;
38
    GLScene1: TGLScene;
39
    cam: TGLCamera;
40
    dc_cam: TGLDummyCube;
41
    GLCube1: TGLCube;
42
    light1: TGLLightSource;
43
    dc_light: TGLDummyCube;
44
    dc_world: TGLDummyCube;
45
    GLCylinder1: TGLCylinder;
46
    dc_views: TGLDummyCube;
47
    cam1: TGLCamera;
48
    cam2: TGLCamera;
49
    cam3: TGLCamera;
50
    GLSphere1: TGLSphere;
51
    Panel2: TPanel;
52
    pos_r: TImage;
53
    pos_t: TImage;
54
    pos_c: TImage;
55
    dc_helpers: TGLDummyCube;
56
    xyz_grid: TGLXYZGrid;
57
    vp: TGLSceneViewer;
58
    Shape1: TShape;
59
    xy_grid: TGLXYZGrid;
60
    vp2: TGLSceneViewer;
61
    vp1: TGLSceneViewer;
62
    vp3: TGLSceneViewer;
63
    yz_grid: TGLXYZGrid;
64
    xz_grid: TGLXYZGrid;
65
    procedure FormResize(Sender: TObject);
66
    procedure AsyncTimer1Timer(Sender: TObject);
67
    procedure vp1BeforeRender(Sender: TObject);
68
    procedure vp1AfterRender(Sender: TObject);
69
    procedure vp2BeforeRender(Sender: TObject);
70
    procedure vp2AfterRender(Sender: TObject);
71
    procedure vp3BeforeRender(Sender: TObject);
72
    procedure vp3AfterRender(Sender: TObject);
73
    procedure vpMouseDown(Sender: TObject; Button: TMouseButton;
74
      Shift: TShiftState; X, Y: Integer);
75
    procedure vpMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
76
  public
77
    procedure showScn(mv, v1, v2, v3: boolean);
78
  private
79
    mx, my : Integer;
80
  end;
81

82
type
83
  TScnMod = (scnTurn, scnMove);
84

85
var
86
  Form1: TForm1;
87
  xAlign: single = 0.5;
88
  yAlign: single = 0.5;
89
  scnMod: set of TScnMod;
90

91
//==================================================================
92
implementation
93
//==================================================================
94

95
{$R *.lfm}
96

97
procedure TForm1.FormResize(Sender: TObject);
98
var
99
  w, w2, h2: integer;
100
begin
101
  w := clientWidth - Panel1.width;
102
  w2 := round((clientWidth - Panel1.width) * xAlign);
103
  h2 := round(clientHeight * yAlign);
104
  vp1.BoundsRect := rect(3, 3, w2 - 4, h2 - 4);
105
  vp2.BoundsRect := rect(w2 + 3, 3, w - 4, h2 - 4);
106
  vp3.BoundsRect := rect(3, h2 + 3, w2 - 4, clientHeight - 4);
107
  vp.BoundsRect := rect(w2 + 3, h2 + 3, w - 4, clientHeight - 4);
108
  Shape1.BoundsRect := rect(w2, h2, w - 1, clientHeight - 1);
109

110
  pos_r.BoundsRect := rect(w2 - 4, 3, w2 + 3, clientHeight - 4);
111
  pos_t.BoundsRect := rect(3, h2 - 4, w - 4, h2 + 3);
112
  pos_c.BoundsRect := rect(w2 - 4, h2 - 4, w2 + 3, h2 + 3);
113
end;
114

115
procedure TForm1.AsyncTimer1Timer(Sender: TObject);
116
begin
117
  if scnMod <> [] then
118
  begin
119
    if scnTurn in scnMod then
120
    begin
121
    end;
122
  end;
123
  GLCube1.Position.Y := sin(GetTickCount / 1000);
124
  GLSphere1.Position.Z := cos(GetTickCount / 600);
125
  vp.Refresh;
126
  vp1.Refresh;
127
  vp2.Refresh;
128
  vp3.Refresh;
129
end;
130

131
procedure TForm1.showScn(mv, v1, v2, v3: boolean);
132
begin
133
  if not mv then
134
  begin
135
    GLCube1.Material.PolygonMode := pmLines;
136
    GLCylinder1.Material.PolygonMode := pmLines;
137
    GLSphere1.Material.PolygonMode := pmLines;
138
    light1.Shining := false;
139
    xyz_grid.visible := false;
140
  end
141
  else
142
  begin
143
    GLCube1.Material.PolygonMode := pmFill;
144
    GLCylinder1.Material.PolygonMode := pmFill;
145
    GLSphere1.Material.PolygonMode := pmFill;
146
    light1.Shining := true;
147
    xyz_grid.visible := true;
148
  end;
149
  xz_grid.visible := v1;
150
  xy_grid.visible := v2;
151
  yz_grid.visible := v3;
152
end;
153

154
procedure TForm1.vp1BeforeRender(Sender: TObject);
155
begin
156
  showScn(false, true, false, false);
157
end;
158

159
procedure TForm1.vp1AfterRender(Sender: TObject);
160
begin
161
  showScn(true, false, false, false);
162
end;
163

164
procedure TForm1.vp2BeforeRender(Sender: TObject);
165
begin
166
  showScn(false, false, true, false);
167
end;
168

169
procedure TForm1.vp2AfterRender(Sender: TObject);
170
begin
171
  showScn(true, false, false, false);
172
end;
173

174
procedure TForm1.vp3BeforeRender(Sender: TObject);
175
begin
176
  showScn(false, false, false, true);
177
end;
178

179
procedure TForm1.vpMouseDown(Sender: TObject; Button: TMouseButton;
180
  Shift: TShiftState; X, Y: Integer);
181
begin
182
   mx:=x; my:=y;
183
end;
184

185
procedure TForm1.vpMouseMove(Sender: TObject; Shift: TShiftState; X,
186
  Y: Integer);
187
begin
188
   if Shift<>[] then
189
      Cam.MoveAroundTarget(my-y, mx-x);
190
   mx:=x; my:=y;
191
end;
192

193
procedure TForm1.vp3AfterRender(Sender: TObject);
194
begin
195
  showScn(true, false, false, false);
196
end;
197

198
end.
199

Использование cookies

Мы используем файлы cookie в соответствии с Политикой конфиденциальности и Политикой использования cookies.

Нажимая кнопку «Принимаю», Вы даете АО «СберТех» согласие на обработку Ваших персональных данных в целях совершенствования нашего веб-сайта и Сервиса GitVerse, а также повышения удобства их использования.

Запретить использование cookies Вы можете самостоятельно в настройках Вашего браузера.