Luxophia

LUX.GPU.OpenGL.Shaper.Preset.pas
473 строки · 12.7 Кб
Перенос по словам
1
unit LUX.GPU.OpenGL.Shaper.Preset;
2

3
interface //#################################################################### ■
4

5
uses System.UITypes,
6
     Winapi.OpenGL, Winapi.OpenGLext,
7
     LUX, LUX.D2, LUX.D3, LUX.D4x4,
8
     LUX.GPU.OpenGL,
9
     LUX.GPU.OpenGL.Atom.Buffer,
10
     LUX.GPU.OpenGL.Atom.Buffer.VerBuf,
11
     LUX.GPU.OpenGL.Atom.Buffer.EleBuf,
12
     LUX.GPU.OpenGL.Scener,
13
     LUX.GPU.OpenGL.Matery,
14
     LUX.GPU.OpenGL.Matery.Preset,
15
     LUX.GPU.OpenGL.Shaper;
16

17
type //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【型】
18

19
     TGLShaperCopy     = class;
20
     TGLShaperLineCube = class;
21
     TGLDotCube        = class;
22

23
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
24

25
     //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
26

27
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperCopy
28

29
     TGLShaperCopy = class( TGLShaper )
30
     private
31
     protected
32
       _Shaper :TGLShaperPoin;
33
       ///// アクセス
34
       function GetShaper :TGLShaperPoin;
35
       procedure SetShaper( const Shaper_:TGLShaperPoin );
36
     public
37
       constructor Create; override;
38
       destructor Destroy; override;
39
       ///// プロパティ
40
       property Shaper :TGLShaperPoin read GetShaper write SetShaper;
41
       ///// メソッド
42
       procedure BeginDraw; override;
43
       procedure DrawMain; override;
44
       procedure EndDraw; override;
45
       procedure CalcBouBox; override;
46
     end;
47

48
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperLineCube
49

50
     TGLShaperLineCube = class( TGLShaperLine )
51
     private
52
       ///// メソッド
53
       procedure MakeModel;
54
     protected
55
       _SizeX :Single;
56
       _SizeY :Single;
57
       _SizeZ :Single;
58
       ///// アクセス
59
       function GetSizeX :Single;
60
       procedure SetSizeX( const SizeX_:Single );
61
       function GetSizeY :Single;
62
       procedure SetSizeY( const SizeY_:Single );
63
       function GetSizeZ :Single;
64
       procedure SetSizeZ( const SizeZ_:Single );
65
       function GetColor :TAlphaColorF;
66
       procedure SetColor( const Color_:TAlphaColorF );
67
     public
68
       constructor Create; override;
69
       destructor Destroy; override;
70
       ///// プロパティ
71
       property SizeX :Single       read GetSizeX write SetSizeX;
72
       property SizeY :Single       read GetSizeY write SetSizeY;
73
       property SizeZ :Single       read GetSizeZ write SetSizeZ;
74
       property Color :TAlphaColorF read GetColor write SetColor;
75
     end;
76

77
     //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLDotCube
78

79
     TGLDotCube = class( TGLShaperPoin )
80
     private
81
       ///// メソッド
82
       procedure MakeModel;
83
     protected
84
       _SizeX :Single;
85
       _SizeY :Single;
86
       _SizeZ :Single;
87
       _DivNX :Integer;
88
       _DivNY :Integer;
89
       _DivNZ :Integer;
90
       ///// アクセス
91
       function GetSizeX :Single;
92
       procedure SetSizeX( const SizeX_:Single );
93
       function GetSizeY :Single;
94
       procedure SetSizeY( const SizeY_:Single );
95
       function GetSizeZ :Single;
96
       procedure SetSizeZ( const SizeZ_:Single );
97
       function GetDivNX :Integer;
98
       procedure SetDivNX( const DivNX_:Integer );
99
       function GetDivNY :Integer;
100
       procedure SetDivNY( const DivNY_:Integer );
101
       function GetDivNZ :Integer;
102
       procedure SetDivNZ( const DivNZ_:Integer );
103
     public
104
       constructor Create; override;
105
       destructor Destroy; override;
106
       ///// プロパティ
107
       property SizeX :Single  read GetSizeX write SetSizeX;
108
       property SizeY :Single  read GetSizeY write SetSizeY;
109
       property SizeZ :Single  read GetSizeZ write SetSizeZ;
110
       property DivNX :Integer read GetDivNX write SetDivNX;
111
       property DivNY :Integer read GetDivNY write SetDivNY;
112
       property DivNZ :Integer read GetDivNZ write SetDivNZ;
113
     end;
114

115
//const //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【定数】
116

117
//var //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【変数】
118

119
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
120

121
implementation //############################################################### ■
122

123
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【レコード】
124

125
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【クラス】
126

127
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperCopy
128

129
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
130

131
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
132

133
/////////////////////////////////////////////////////////////////////// アクセス
134

135
function TGLShaperCopy.GetShaper :TGLShaperPoin;
136
begin
137
     Result := _Shaper;
138
end;
139

140
procedure TGLShaperCopy.SetShaper( const Shaper_:TGLShaperPoin );
141
begin
142
     _Shaper := Shaper_;
143

144
     CalcBouBox;
145
end;
146

147
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
148

149
constructor TGLShaperCopy.Create;
150
begin
151
     inherited;
152

153
end;
154

155
destructor TGLShaperCopy.Destroy;
156
begin
157

158
     inherited;
159
end;
160

161
/////////////////////////////////////////////////////////////////////// メソッド
162

163
procedure TGLShaperCopy.BeginDraw;
164
begin
165
     inherited;
166

167
     with _Shaper do
168
     begin
169
          if not Assigned( Self._Matery ) then Matery.Use;
170

171
          PosBuf.Use( 0{BinP} );
172
          NorBuf.Use( 1{BinP} );
173
          TexBuf.Use( 2{BinP} );
174
     end;
175
end;
176

177
procedure TGLShaperCopy.DrawMain;
178
begin
179
     _Shaper.DrawMain;
180
end;
181

182
procedure TGLShaperCopy.EndDraw;
183
begin
184
     with _Shaper do
185
     begin
186
          PosBuf.Unuse( 0{BinP} );
187
          NorBuf.Unuse( 1{BinP} );
188
          TexBuf.Unuse( 2{BinP} );
189

190
          if not Assigned( Self._Matery ) then Matery.Use;
191
     end;
192

193
     inherited;
194
end;
195

196
//------------------------------------------------------------------------------
197

198
procedure TGLShaperCopy.CalcBouBox;
199
begin
200
     BouBox := _Shaper.BouBox;
201
end;
202

203
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperLineCube
204

205
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
206

207
/////////////////////////////////////////////////////////////////////// メソッド
208

209
procedure TGLShaperLineCube.MakeModel;
210
var
211
   SX, SY, SZ :Single;
212
begin
213
     SX := _SizeX / 2;
214
     SY := _SizeY / 2;
215
     SZ := _SizeZ / 2;
216

217
     with _PosBuf.Map( GL_WRITE_ONLY ) do
218
     begin
219
          Items[ 0 ] := TSingle3D.Create( -SX, -SY, -SZ );
220
          Items[ 1 ] := TSingle3D.Create( +SX, -SY, -SZ );
221
          Items[ 2 ] := TSingle3D.Create( -SX, +SY, -SZ );
222
          Items[ 3 ] := TSingle3D.Create( +SX, +SY, -SZ );
223
          Items[ 4 ] := TSingle3D.Create( -SX, -SY, +SZ );
224
          Items[ 5 ] := TSingle3D.Create( +SX, -SY, +SZ );
225
          Items[ 6 ] := TSingle3D.Create( -SX, +SY, +SZ );
226
          Items[ 7 ] := TSingle3D.Create( +SX, +SY, +SZ );
227

228
          Free;
229
     end;
230

231
     CalcBouBox;
232
end;
233

234
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
235

236
/////////////////////////////////////////////////////////////////////// アクセス
237

238
function TGLShaperLineCube.GetSizeX :Single;
239
begin
240
     Result := _SizeX;
241
end;
242

243
procedure TGLShaperLineCube.SetSizeX( const SizeX_:Single );
244
begin
245
     _SizeX := SizeX_;  MakeModel;
246
end;
247

248
function TGLShaperLineCube.GetSizeY :Single;
249
begin
250
     Result := _SizeY;
251
end;
252

253
procedure TGLShaperLineCube.SetSizeY( const SizeY_:Single );
254
begin
255
     _SizeY := SizeY_;  MakeModel;
256
end;
257

258
function TGLShaperLineCube.GetSizeZ :Single;
259
begin
260
     Result := _SizeZ;
261
end;
262

263
procedure TGLShaperLineCube.SetSizeZ( const SizeZ_:Single );
264
begin
265
     _SizeZ := SizeZ_;  MakeModel;
266
end;
267

268
//------------------------------------------------------------------------------
269

270
function TGLShaperLineCube.GetColor :TAlphaColorF;
271
begin
272
     Result := TGLMateryColor( _Matery ).Color;
273
end;
274

275
procedure TGLShaperLineCube.SetColor( const Color_:TAlphaColorF );
276
begin
277
     TGLMateryColor( _Matery ).Color := Color_;
278
end;
279

280
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
281

282
constructor TGLShaperLineCube.Create;
283
begin
284
     inherited;
285

286
     _PosBuf.Count :=  8;
287
     _NorBuf.Count :=  8;
288
     _EleBuf.Count := 12;
289

290
     _Matery := TGLMateryColor.Create;
291

292
     with _NorBuf.Map( GL_WRITE_ONLY ) do
293
     begin
294
          Items[ 0 ] := TSingle3D.Create( -1, -1, -1 ).Unitor;
295
          Items[ 1 ] := TSingle3D.Create( +1, -1, -1 ).Unitor;
296
          Items[ 2 ] := TSingle3D.Create( -1, +1, -1 ).Unitor;
297
          Items[ 3 ] := TSingle3D.Create( +1, +1, -1 ).Unitor;
298
          Items[ 4 ] := TSingle3D.Create( -1, -1, +1 ).Unitor;
299
          Items[ 5 ] := TSingle3D.Create( +1, -1, +1 ).Unitor;
300
          Items[ 6 ] := TSingle3D.Create( -1, +1, +1 ).Unitor;
301
          Items[ 7 ] := TSingle3D.Create( +1, +1, +1 ).Unitor;
302

303
          Free;
304
     end;
305

306
     with _EleBuf.Map( GL_WRITE_ONLY ) do
307
     begin
308
          Items[ 00 ] := TCardinal2D.Create( 0, 1 );
309
          Items[ 01 ] := TCardinal2D.Create( 0, 2 );
310
          Items[ 02 ] := TCardinal2D.Create( 0, 4 );
311

312
          Items[ 03 ] := TCardinal2D.Create( 1, 3 );
313
          Items[ 04 ] := TCardinal2D.Create( 2, 6 );
314
          Items[ 05 ] := TCardinal2D.Create( 4, 5 );
315

316
          Items[ 06 ] := TCardinal2D.Create( 7, 6 );
317
          Items[ 07 ] := TCardinal2D.Create( 7, 5 );
318
          Items[ 08 ] := TCardinal2D.Create( 7, 3 );
319

320
          Items[ 09 ] := TCardinal2D.Create( 6, 4 );
321
          Items[ 10 ] := TCardinal2D.Create( 5, 1 );
322
          Items[ 11 ] := TCardinal2D.Create( 3, 2 );
323

324
          Free;
325
     end;
326

327
     _SizeX := 1;
328
     _SizeY := 1;
329
     _SizeZ := 1;
330

331
     MakeModel;
332
end;
333

334
destructor TGLShaperLineCube.Destroy;
335
begin
336

337
     inherited;
338
end;
339

340
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLDotCube
341

342
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
343

344
/////////////////////////////////////////////////////////////////////// メソッド
345

346
procedure TGLDotCube.MakeModel;
347
var
348
   Ps :TGLBufferData<TSingle3D>;
349
   X, Y, Z, I :Integer;
350
   P :TSingle3D;
351
begin
352
     PosBuf.Count := ( _DivNZ + 1 ) * ( _DivNY + 1 ) * ( _DivNX + 1 );
353

354
     Ps := PosBuf.Map( GL_WRITE_ONLY );
355

356
     I := 0;
357
     for Z := 0 to _DivNZ do
358
     begin
359
          P.Z := _SizeZ / _DivNZ * Z - _SizeZ / 2;
360

361
          for Y := 0 to _DivNY do
362
          begin
363
               P.Y := _SizeY / _DivNY * Y - _SizeY / 2;
364

365
               for X := 0 to _DivNX do
366
               begin
367
                    P.X := _SizeX / _DivNX * X - _SizeX / 2;
368

369
                    Ps[ I ] := P;  Inc( I );
370
               end;
371
          end;
372
     end;
373

374
     Ps.Free;
375
end;
376

377
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
378

379
/////////////////////////////////////////////////////////////////////// アクセス
380

381
function TGLDotCube.GetSizeX :Single;
382
begin
383
     Result := _SizeX;
384
end;
385

386
procedure TGLDotCube.SetSizeX( const SizeX_:Single );
387
begin
388
     _SizeX := SizeX_;  MakeModel;
389
end;
390

391
function TGLDotCube.GetSizeY :Single;
392
begin
393
     Result := _SizeY;
394
end;
395

396
procedure TGLDotCube.SetSizeY( const SizeY_:Single );
397
begin
398
     _SizeY := SizeY_;  MakeModel;
399
end;
400

401
function TGLDotCube.GetSizeZ :Single;
402
begin
403
     Result := _SizeZ;
404
end;
405

406
procedure TGLDotCube.SetSizeZ( const SizeZ_:Single );
407
begin
408
     _SizeZ := SizeZ_;  MakeModel;
409
end;
410

411
//------------------------------------------------------------------------------
412

413
function TGLDotCube.GetDivNX :Integer;
414
begin
415
     Result := _DivNX;
416
end;
417

418
procedure TGLDotCube.SetDivNX( const DivNX_:Integer );
419
begin
420
     _DivNX := DivNX_;  MakeModel;
421
end;
422

423
function TGLDotCube.GetDivNY :Integer;
424
begin
425
     Result := _DivNY;
426
end;
427

428
procedure TGLDotCube.SetDivNY( const DivNY_:Integer );
429
begin
430
     _DivNY := DivNY_;  MakeModel;
431
end;
432

433
function TGLDotCube.GetDivNZ :Integer;
434
begin
435
     Result := _DivNZ;
436
end;
437

438
procedure TGLDotCube.SetDivNZ( const DivNZ_:Integer );
439
begin
440
     _DivNZ := DivNZ_;  MakeModel;
441
end;
442

443
//&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
444

445
constructor TGLDotCube.Create;
446
begin
447
     inherited;
448

449
     _Matery := TGLMateryColor.Create;
450

451
     SizeX := 10;
452
     SizeY := 10;
453
     SizeZ := 10;
454
     DivNX := 10;
455
     DivNY := 10;
456
     DivNZ := 10;
457
end;
458

459
destructor TGLDotCube.Destroy;
460
begin
461

462
     inherited;
463
end;
464

465
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
466

467
//############################################################################## □
468

469
initialization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
470

471
finalization //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
472

473
end. //######################################################################### ■
474
Luxophia

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