ArenaZ

1
unit UMainform;
2

3
{$mode objfpc}{$H+}
4

5
interface
6

7
uses
8
  Classes, SysUtils,{$ifdef Windwos} Windows,{$endif} FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
9
  ExtCtrls, ComCtrls, ActnList, Types,
10

11
  GLLCLViewer, GLScene, GLState, GLMaterial, GLCadencer, GLVectorTypes,
12
  GLVectorGeometry, GLGraph, GLHiddenLineShader, GLOutlineShader,
13
  GLTextureSharingShader, GLAsyncTimer, GLObjects, GLVectorFileObjects,
14

15
  uNavCube, GLBaseClasses;
16

17
type
18

19
  { TMainForm }
20

21
  TMainForm = class(TForm)
22
    acSmoothShading: TAction;
23
    acFlatShading: TAction;
24
    acPointShading: TAction;
25
    acTextureShading: TAction;
26
    acSceneLighting: TAction;
27
    acShaderHiddenLines: TAction;
28
    acShaderOutLines: TAction;
29
    acShaderNone: TAction;
30
    actInvertNormals: TAction;
31
    actOpenModel: TAction;
32
    acWireFrameShading: TAction;
33
    DCCamera: TGLDummyCube;
34
    DCTarget: TGLDummyCube;
35
    DCGrids: TGLDummyCube;
36
    DCGridXY: TGLDummyCube;
37
    DCGridXZ: TGLDummyCube;
38
    DCGridYZ: TGLDummyCube;
39
    DCLights: TGLDummyCube;
40
    DCRoot: TGLDummyCube;
41
    DCWorld: TGLDummyCube;
42
    Camera1: TGLCamera;
43
    DCStaticLights: TGLDummyCube;
44
    DCDynamicLights: TGLDummyCube;
45
    DCWorldAxis: TGLDummyCube;
46
    DCWorldGrid: TGLDummyCube;
47
    ffObject: TGLFreeForm;
48
    BBox: TGLCube;
49
    DCAxis: TGLDummyCube;
50
    FrontAmbientLight: TGLLightSource;
51
    backAmbientLight: TGLLightSource;
52
    KeyAmbientLigth: TGLLightSource;
53
    HiddenLineShader: TGLHiddenLineShader;
54
    MenuItem20: TMenuItem;
55
    MenuItem23: TMenuItem;
56
    OutlineShader: TGLOutlineShader;
57
    MenuItem21: TMenuItem;
58
    MenuItem22: TMenuItem;
59
    WorldGrid: TGLXYZGrid;
60
    MainLightSource1: TGLLightSource;
61
    MainStatusBar: TStatusBar;
62
    MenuItem10: TMenuItem;
63
    MenuItem11: TMenuItem;
64
    MenuItem12: TMenuItem;
65
    MenuItem13: TMenuItem;
66
    MenuItem14: TMenuItem;
67
    MenuItem15: TMenuItem;
68
    MenuItem16: TMenuItem;
69
    MenuItem17: TMenuItem;
70
    MenuItem18: TMenuItem;
71
    MenuItem19: TMenuItem;
72
    XZGrid: TGLXYZGrid;
73
    YZGrid: TGLXYZGrid;
74
    XYGrid: TGLXYZGrid;
75
    MainActionList: TActionList;
76
    ASyncTimer: TGLAsyncTimer;
77
    Cadencer: TGLCadencer;
78
    LightMapLib: TGLMaterialLibrary;
79
    OpenDialog: TOpenDialog;
80
    SaveDialog: TSaveDialog;
81
    TextureMatLib: TGLMaterialLibrary;
82
    GLScene: TGLScene;
83
    GLSViewer: TGLSceneViewer;
84
    ImageList: TImageList;
85
    MainMenu: TMainMenu;
86
    MenuItem1: TMenuItem;
87
    MenuItem2: TMenuItem;
88
    MenuItem3: TMenuItem;
89
    MenuItem4: TMenuItem;
90
    MenuItem5: TMenuItem;
91
    MenuItem6: TMenuItem;
92
    MenuItem7: TMenuItem;
93
    MenuItem8: TMenuItem;
94
    MenuItem9: TMenuItem;
95
    Panel1: TPanel;
96
    Panel2: TPanel;
97
    MainTimer: TTimer;
98
    ToolBar1: TToolBar;
99
    procedure acFlatShadingExecute(Sender: TObject);
100
    procedure acPointShadingExecute(Sender: TObject);
101
    procedure acSceneLightingExecute(Sender: TObject);
102
    procedure acShaderHiddenLinesExecute(Sender: TObject);
103
    procedure acShaderNoneExecute(Sender: TObject);
104
    procedure acShaderOutLinesExecute(Sender: TObject);
105
    procedure acSmoothShadingExecute(Sender: TObject);
106
    procedure acTextureShadingExecute(Sender: TObject);
107
    procedure actInvertNormalsExecute(Sender: TObject);
108
    procedure actOpenModelExecute(Sender: TObject);
109
    procedure acWireFrameShadingExecute(Sender: TObject);
110
    procedure CadencerProgress(Sender: TObject; const deltaTime, newTime: Double);
111
    procedure FormCreate(Sender: TObject);
112
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
113
    procedure FormShow(Sender: TObject);
114
    procedure GLSViewerAfterRender(Sender: TObject);
115
    procedure GLSViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
116
    procedure GLSViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
117
    procedure GLSViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
118
    procedure MainTimerTimer(Sender: TObject);
119
  private
120
    { private declarations }
121
    procedure ShowCameraLocation;
122
    procedure ShowFocalLength;
123
    procedure ShowLightLocation;
124
    procedure ShowTargetLocation;
125

126
    procedure DoResetCamera;
127
    procedure SetupFreeFormShading;
128
    procedure ApplyShadeModeToMaterial(aMaterial: TGLMaterial);
129
    procedure ApplyObjectShadeMode;
130
//    procedure ApplyFSAA;
131
//    procedure ApplyObjectFaceCull;
132
    procedure ApplyObjectTexturing;
133
    procedure DoOpen(const FileName: String);
134
  protected
135
    MousePoint: TPoint;
136
    md:Boolean;
137
  public
138
    { public declarations }
139
    lastFileName: String;
140
    lastLoadWithTextures: Boolean;
141
  end;
142

143
const
144
  crLightxz  = 1;
145
  crLightyz  = 2;
146
  crLightxy  = 3;
147
  crSlidexy  = 4;
148
  crSlideyz  = 5;
149
  crSlidexz  = 6;
150
  crRotate   = 7;
151
  crZoom     = 8;
152
  crHandMove = 9;
153
  crSlidezy  = 10;
154

155
var
156
  MainForm: TMainForm;
157
  NavCube: TGLNavCube;
158

159
implementation
160

161
{$R *.lfm}
162
{$R Cursors.res}
163

164
uses
165
  Math,
166
  // GLFileQ3BSP
167
  // GLFileDXF
168
  // GLFileOCT
169
  // GLFileGRD
170
  GLFileOBJ, GLFileSTL, GLFileLWO, GLFileMS3D,
171
  GLFileNMF, GLFileMD3, GLFile3DS, GLFileMD2, GLFileSMD, GLFilePLY, GLFileGTS,
172
  GLFileVRML, GLFileMD5, GLFileTIN ;
173

174
function LoadCursorFromRes(CursorName:String):THandle;
175
var
176
   Cur: TCursorImage;
177
begin
178
   Cur := TCursorImage.Create;
179
   Cur.LoadFromResourceName(HInstance,CursorName);
180
   result := Cur.ReleaseHandle;
181
   Cur.Free;
182
end;
183

184
procedure TMainForm.GLSViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
185
begin
186
  Screen.Cursor := crDefault;
187
  md := False;
188
end;
189

190
procedure TMainForm.MainTimerTimer(Sender: TObject);
191
begin
192
  ShowCameraLocation;
193
  ShowFocalLength;
194
  ShowTargetLocation;
195
  ShowLightLocation;
196
  MainStatusBar.Panels[4].Text := Format('%.1f  FPS', [GLSViewer.FramesPerSecond]);
197
  GLSViewer.ResetPerformanceMonitor;
198
end;
199

200
procedure TMainForm.GLSViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
201
begin
202
  if md and (Shift <> []) then
203
  begin
204
    if ssLeft in Shift then
205
    begin
206
      if ssShift in Shift then
207
      begin
208
        //Showmessage('on the rock');
209
        //NavCube.ActiveMouse:=True;
210
      end
211
      else
212
      begin
213
       // NavCube.ActiveMouse:=False;
214
        Camera1.MoveAroundTarget((MousePoint.y - Y) * 0.1, (MousePoint.x - X) * 0.1)
215
      end;
216
    end
217
    else if ssRight in Shift then
218
    begin
219
      if ssShift in Shift then   { shift key down }
220
      begin
221
        with Camera1 do AdjustDistanceToTarget(Power(1.0125, MousePoint.y - Y));
222
      end
223
      else
224
      begin
225
        with Camera1 do
226
        begin
227
          FocalLength  := FocalLength - (MousePoint.y - Y);
228
          if FocalLength > 3000 then FocalLength := 3000;   { max focal length }
229
          if FocalLength < 10 then FocalLength := 10;       { min focal length }
230
        end;       { display in statusbar palel }
231
      end;
232
    (*  d := Camera.DistanceToTarget * 0.01 * (X - MousePoint.x + Y - MousePoint.y);
233
      if IsKeyDown('x') then ffObject.Translate(d, 0, 0)
234
      else if IsKeyDown('y') then ffObject.Translate(0, d, 0)
235
      else if IsKeyDown('z') then ffObject.Translate(0, 0, d)
236
      else
237
      begin
238
        if ssShift in Shift then
239
          Camera.RotateObject(ffObject, (MousePoint.y - Y) * 0.1, (MousePoint.x - X) * 0.1)
240
        else
241
          Camera.RotateObject(ffObject, MousePoint.y - Y, MousePoint.x - X);
242
      end; *)
243
    end;
244
    MousePoint.X := X;         { update mouse position }
245
    MousePoint.Y := Y;
246
  end;
247

248
end;
249

250
procedure TMainForm.GLSViewerMouseDown(Sender: TObject;
251
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
252
begin
253
  MousePoint.X := X;
254
  MousePoint.Y := Y;
255
  if Shift = [ssLeft] then
256
  begin
257
    Screen.Cursor := crRotate;
258
    NavCube.ActiveMouse := True;
259
  end
260
  else if Shift = [ssRight] then
261
  begin
262
    Screen.Cursor := crZoom;
263
  end;
264
  md:=true;
265
(*  if ssShift in Shift then        { Shift key down}
266
  begin
267
    if ssLeft in Shift then Screen.Cursor := crZoom;
268
  end
269
  else if ssCtrl in Shift then    { Ctrl key down }
270
  begin
271
    //if ssLeft in Shift then Screen.Cursor := crSlidexz
272
    //else
273
    // if ssRight in Shift then Screen.Cursor := crLightxz;
274
  end
275
  else if ssAlt in Shift then     { Alt key down }
276
  begin
277
    //if ssLeft in Shift then Screen.Cursor := crSlidezy
278
    //else
279
    //if ssRight in Shift then Screen.Cursor := crLightxy;
280
  end
281
  else { no shift, ctrl or alt key }
282
  begin
283
    if Shift = [ssLeft] then Screen.Cursor := crRotate
284
    else
285
      if Shift = [ssRight] then Screen.Cursor := crZoom;
286
  end;   *)
287
end;
288

289
procedure TMainForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
290
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
291
begin
292
  if (MousePoint.X >= GLSViewer.Left) and
293
     (MousePoint.X <= GLSViewer.Left + GLSViewer.Width) and
294
     (MousePoint.Y >= GLSViewer.Top) and
295
     (MousePoint.y <= GLSViewer.Top + GLSViewer.Height) then
296
  begin
297
{ a wheel step = WheelDelta/300; each step adjusts target distance by 2.5%
298
  another method to zoom in or out }
299
    //GLSViewer.SetFocus;
300
    if ffObject.MeshObjects.Count > 0 then
301
    begin
302
      Camera1.AdjustDistanceToTarget(Power(1.025, WheelDelta / 300));
303
      Camera1.DepthOfView := 2 * Camera1.DistanceToTarget + 2 * ffObject.BoundingSphereRadius;
304
    end;
305
    Handled := True;
306

307
    //Camera1.AdjustDistanceToTarget(Power(1.025, WheelDelta/300));
308
    //ShowCameraLocation;
309
  end;
310
end;
311

312
procedure TMainForm.FormCreate(Sender: TObject);
313
begin
314
  inherited;
315
  GetCurrentDir;
316
  NavCube := TGLNavCube.CreateAsChild(GLScene.Objects);
317
  NavCube.SceneViewer := GLSViewer;
318
  NavCube.Camera:=Camera1;
319
  NavCube.ActiveMouse:=True;
320
 // NavCube.AutoRotate:=False;
321
  NavCube.FPS := 30;
322

323
 // instantiate our specific hidden-lines shader
324
 // hlShader := THiddenLineShader.Create(Self);
325
  ffObject.IgnoreMissingTextures := True;
326

327
  Screen.Cursors[crLightxy] := LoadCursorFromRes('LIGHTXY'); //LoadCursor(HInstance, 'LIGHTXY');
328
  Screen.Cursors[crLightyz] := LoadCursorFromRes('LIGHTYZ'); //LoadCursor(HInstance, 'LIGHTYZ');
329
  Screen.Cursors[crLightxz] := LoadCursorFromRes('LIGHTXZ'); //LoadCursor(HInstance, 'LIGHTXZ');
330
  Screen.Cursors[crSlidexy] := LoadCursorFromRes('SLIDEXY'); //LoadCursor(HInstance, 'SLIDEXY');
331
  Screen.Cursors[crSlidexz] := LoadCursorFromRes('SLIDEXZ'); //LoadCursor(HInstance, 'SLIDEXZ');
332
  Screen.Cursors[crSlideyz] := LoadCursorFromRes('SLIDEYZ'); //LoadCursor(HInstance, 'SLIDEYZ');
333
  Screen.Cursors[crRotate]  := LoadCursorFromRes('ROTATE'); //LoadCursor(HInstance, 'ROTATE');
334
  Screen.Cursors[crZoom]    := LoadCursorFromRes('ZOOM'); //LoadCursor(HInstance, 'ZOOM');
335
  Screen.Cursors[crSlidezy] := LoadCursorFromRes('SLIDEZY'); //LoadCursor(HInstance, 'SLIDEZY');
336
end;
337

338
procedure TMainForm.CadencerProgress(Sender: TObject; const deltaTime,
339
  newTime: Double);
340
begin
341
  if NavCube.InactiveTime > 5 then
342
  begin
343
    if NavCube.InactiveTime < 8 then
344
      Camera1.TurnAngle := Camera1.TurnAngle + (NavCube.InactiveTime - 5) * deltaTime * 2
345
    else
346
      Camera1.TurnAngle := Camera1.TurnAngle + deltatime * 6;
347
  end;
348
  GLSViewer.Refresh;
349
  if Self.Focused then
350
    GLSViewer.Invalidate;
351
end;
352

353
procedure TMainForm.acPointShadingExecute(Sender: TObject);
354
begin
355
  ApplyObjectShadeMode();
356
end;
357

358
procedure TMainForm.acSceneLightingExecute(Sender: TObject);
359
begin
360
  //acSceneLight.Checked := not(acSceneLight.Checked);
361
  ApplyObjectShadeMode;
362
end;
363

364
procedure TMainForm.acShaderHiddenLinesExecute(Sender: TObject);
365
begin
366
 ApplyObjectShadeMode;
367
end;
368

369
procedure TMainForm.acShaderNoneExecute(Sender: TObject);
370
begin
371
  ApplyObjectShadeMode;
372
end;
373

374
procedure TMainForm.acShaderOutLinesExecute(Sender: TObject);
375
begin
376
 ApplyObjectShadeMode;
377
end;
378

379
procedure TMainForm.acSmoothShadingExecute(Sender: TObject);
380
begin
381
    ApplyObjectShadeMode();
382
end;
383

384
procedure TMainForm.acTextureShadingExecute(Sender: TObject);
385
begin
386
    ApplyObjectTexturing();
387
end;
388

389
procedure TMainForm.actInvertNormalsExecute(Sender: TObject);
390
begin
391
  if actInvertNormals.Checked then
392
     ffObject.NormalsOrientation:=mnoInvert
393
   else
394
     ffObject.NormalsOrientation:=mnoDefault;
395
end;
396

397
procedure TMainForm.actOpenModelExecute(Sender: TObject);
398
begin
399
  NavCube.ActiveMouse := False;
400
  if OpenDialog.Execute then DoOpen(OpenDialog.fileName);
401
end;
402

403
procedure TMainForm.acFlatShadingExecute(Sender: TObject);
404
begin
405
    ApplyObjectShadeMode();
406
end;
407

408
procedure TMainForm.acWireFrameShadingExecute(Sender: TObject);
409
begin
410
    ApplyObjectShadeMode();
411
end;
412

413
procedure TMainForm.FormShow(Sender: TObject);
414
begin
415
  ShowCameraLocation;
416
  ShowFocalLength;
417
  ShowTargetLocation;
418
  ShowLightLocation;
419

420
  OpenDialog.Filter := VectorFileFormatsFilter;
421
  SaveDialog.Filter := VectorFileFormatsSaveFilter;
422

423
  ASyncTimer.Enabled:=true;
424
  //ApplyFSAA;
425
  //ApplyFaceCull;
426
  //ApplyFPS;
427
end;
428

429
procedure TMainForm.GLSViewerAfterRender(Sender: TObject);
430
begin
431
  //ApplyFSAA;
432
  //Screen.Cursor := crDefault;
433
end;
434

435
procedure TMainForm.ShowCameraLocation;
436
begin
437
  with Camera1.Position do
438
  MainStatusBar.Panels[0].Text := 'Camera: '+FloatToStrF(X, ffNumber, 5, 2)+', '+
439
  FloatToStrF(Y, ffNumber, 5, 2)+', '+FloatToStrF(Z, ffNumber, 5, 2);
440
end;
441

442
procedure TMainForm.ShowTargetLocation;
443
begin
444
  with DCTarget.Position do
445
  MainStatusBar.Panels[2].Text := 'Target: '+
446
  FloatToStrF(-X, ffNumber, 5, 2)+', '+FloatToStrF(-Y, ffNumber, 5, 2)+', '+
447
  FloatToStrF(-Z, ffNumber, 5, 2);
448
end;
449

450
procedure TMainForm.ShowFocalLength;
451
begin
452
  with Camera1 do
453
  MainStatusBar.Panels[1].Text := 'Focal: '+FloatToStrF(FocalLength, ffnumber, 5, 2);
454
end;
455

456
procedure TMainForm.ShowLightLocation;
457
begin
458
  with MainLightSource1.Position do
459
  MainStatusBar.Panels[3].Text := 'Light: '+
460
  FloatToStrF(X, ffNumber, 5, 2)+', '+FloatToStrF(Y, ffNumber, 5, 2)+', '+
461
  FloatToStrF(Z, ffNumber, 5, 2);
462
end;
463

464
procedure TMainForm.ApplyObjectTexturing;
465
var
466
  i: Integer;
467
begin
468
  with TextureMatLib.Materials do
469
    for i := 0 to Count - 1 do
470
    begin
471
      with Items[i].Material.Texture do
472
      begin
473
        if Enabled then
474
          Items[i].Tag := Integer(True);
475
        Enabled := Boolean(Items[i].Tag) and acTextureShading.Checked;
476
      end;
477
    end;
478
  ffObject.StructureChanged;
479
end;
480

481
procedure TMainForm.ApplyShadeModeToMaterial(aMaterial: TGLMaterial);
482
begin
483
  if acPointShading.Checked then
484
  begin
485
    GLSViewer.Buffer.Lighting := True;
486
    GLSViewer.Buffer.ShadeModel := smSmooth;
487
    aMaterial.PolygonMode := pmPoints;
488
  end
489
  else
490
  if acSmoothShading.Checked then
491
  begin
492
    GLSViewer.Buffer.Lighting := True;
493
    GLSViewer.Buffer.ShadeModel := smSmooth;
494
    aMaterial.PolygonMode := pmFill;
495
  end
496
  else if acFlatShading.Checked then
497
  begin
498
    GLSViewer.Buffer.Lighting := True;
499
    GLSViewer.Buffer.ShadeModel := smFlat;
500
    aMaterial.PolygonMode := pmFill;
501
  end
502
  else if acWireframeShading.Checked then
503
  begin
504
    GLSViewer.Buffer.Lighting := False;
505
    GLSViewer.Buffer.ShadeModel := smSmooth;
506
    aMaterial.PolygonMode := pmLines;
507
  end;
508
end;
509

510
procedure TMainForm.ApplyObjectShadeMode;
511
var
512
  i: Integer;
513
begin
514
  with TextureMatLib.Materials do
515
    for i := 0 to Count - 1 do
516
    begin
517
      ApplyShadeModeToMaterial(Items[i].Material);
518
      if (acShaderHiddenLines.Checked) then
519
        Items[i].Shader := HiddenLineShader
520
      else if (acShaderOutLines.Checked) then
521
        Items[i].Shader := OutLineShader
522
      else if (acShaderNone.Checked) then
523
        Items[i].Shader := nil;
524
    end;
525
  GLSViewer.Buffer.Lighting := acSceneLighting.Checked;
526
  ffObject.StructureChanged;
527
end;
528

529
procedure TMainForm.SetupFreeFormShading;
530
var
531
  i: Integer;
532
  LibMat: TGLLibMaterial;
533
begin
534
  if TextureMatLib.Materials.Count = 0 then
535
  begin
536
    ffObject.Material.MaterialLibrary := TextureMatLib;
537
    LibMat := TextureMatLib.Materials.Add;
538
    ffObject.Material.LibMaterialName := LibMat.Name;
539
    libMat.Material.FrontProperties.Diffuse.Red := 0;
540
  end;
541
  for i := 0 to TextureMatLib.Materials.Count - 1 do
542
    with TextureMatLib.Materials[i].Material do
543
      BackProperties.Assign(FrontProperties);
544
  ApplyObjectShadeMode;
545
  ApplyObjectTexturing;
546
end;
547

548
procedure TMainForm.DoResetCamera;
549
var
550
  objSize: Single;
551
begin
552
  dcTarget.Position.AsVector := NullHmgPoint;
553
  Camera1.Position.SetPoint(50, 40, 50);
554
  ffObject.Position.AsVector := NullHmgPoint;
555
  ffObject.Up.Assign(DCWorldAxis.Up);
556
  ffObject.Direction.Assign(DCWorldAxis.Direction);
557

558
  objSize := ffObject.BoundingSphereRadius;
559
  if objSize > 0 then
560
  begin
561
    if objSize < 1 then
562
    begin
563
      Camera1.SceneScale := 1 / objSize;
564
      objSize := 1;
565
    end
566
    else
567
      Camera1.SceneScale := 1;
568
      Camera1.AdjustDistanceToTarget(objSize * 0.27);
569
      Camera1.DepthOfView := 1.5 * Camera1.DistanceToTarget + 2 * objSize;
570
  end;
571
end;
572

573
procedure TMainForm.DoOpen(const FileName: String);
574
var
575
  min, max: TAffineVector;
576
  GridStep, ObjSize : Single;
577
begin
578
  if not FileExists(fileName) then Exit;
579
  Screen.Cursor := crHourGlass;
580
  Caption := 'Scene Master - ' + FileName;
581
  TextureMatLib.Materials.Clear;
582
  ffObject.MeshObjects.Clear;
583
  ffObject.LoadFromFile(FileName);
584
  SetupFreeFormShading;
585
 // acFileSaveTextures.Enabled := (MaterialLib.Materials.Count > 0);
586
//  acFileOpenTexLib.Enabled := (MaterialLib.Materials.Count > 0);
587
  lastFileName := FileName;
588
  lastLoadWithTextures := acTextureShading.Enabled;
589
  ffObject.GetExtents(min, max);
590
  BBox.CubeWidth := (max.X - min.X)/2;
591
  BBox.CubeHeight := (max.Y - min.Y)/2;
592
  BBox.CubeDepth := (max.Z - min.Z/2);
593
//  ffObject.Position.AsAffineVector := VectorLerp(min/2, max/2, 0.5);
594
  //BBox.Position.AsAffineVector := VectorLerp(min, max, 0.5);
595
 // ffObject.Translate(0,(BBox.Position.Y*2),0);
596

597
  // GridStep := 1.0;
598

599

600
  With WorldGrid do
601
  begin
602
    With XSamplingScale do
603
    begin
604
      min:=-BBox.CubeWidth+1;
605
      max:=BBox.CubeWidth+1;
606
      GridStep :=1.0+ (10*BBox.CubeWidth)/BBox.CubeWidth;
607
      step:=GridStep;
608
    end;
609
    With ZSamplingScale do
610
    begin
611
      min:=-BBox.CubeDepth+1;
612
      max:=BBox.CubeDepth+1;
613
      GridStep :=1.0+ (10*BBox.CubeDepth)/BBox.CubeDepth;
614
      step:=GridStep;
615
    end;
616
  end;
617

618
  With XZGrid do
619
  begin
620
    With XSamplingScale do
621
    begin
622
      min:=-BBox.CubeWidth+1;
623
      max:=BBox.CubeWidth+1;
624
      GridStep :=1.0+ (10*BBox.CubeWidth)/BBox.CubeWidth;
625
      step:=GridStep;
626
      step:=GridStep;
627
    end;
628
    With ZSamplingScale do
629
    begin
630
      min:=-BBox.CubeDepth+1;
631
      max:=BBox.CubeDepth+1;
632
      GridStep :=1.0+ (10*BBox.CubeDepth)/BBox.CubeDepth;
633
      step:=GridStep;
634
    end;
635
  end;
636

637

638
  With YZGrid do
639
  begin
640
    With YSamplingScale do
641
    begin
642
      min:=-BBox.CubeHeight+1;
643
      max:=BBox.CubeHeight+1;
644
      GridStep :=1.0+ (10*BBox.CubeHeight)/BBox.CubeHeight;
645
      step:=GridStep;
646
    end;
647
    With ZSamplingScale do
648
    begin
649
      min:=-BBox.CubeDepth+1;
650
      max:=BBox.CubeDepth+1;
651
      GridStep :=1.0+ (10*BBox.CubeDepth)/BBox.CubeDepth;
652
      step:=GridStep;
653
    end;
654
  end;
655

656

657
  With XYGrid do
658
  begin
659
    With YSamplingScale do
660
    begin
661
      min:=-BBox.CubeHeight+1;
662
      max:=BBox.CubeHeight+1;
663
      step:=GridStep;
664
    end;
665
    With XSamplingScale do
666
    begin
667
      min:=-BBox.CubeWidth+1;
668
      max:=BBox.CubeWidth+1;
669
      step:=GridStep;
670
    end;
671
  end;
672

673
  With DCGridYZ do
674
  begin
675
    position.X:=-(BBox.CubeWidth);
676
    position.Y:=-1;
677
    position.Z:=0;
678
  end;
679
    With DCGridXZ do
680
  begin
681
    position.X:=0;
682
    position.Y:=-(BBox.CubeHeight);
683
    position.Z:=0;
684
  end;
685

686
  With DCGridXY do
687
  begin
688
    position.X:=0;
689
    position.Y:=-1;
690
    position.Z:=-(BBox.CubeDepth);
691
  end;
692

693
(*  StatusBar.Panels[0].Text := 'X: ' + ' ';
694
  StatusBar.Panels[1].Text := 'Y: ' + ' ';
695
  StatusBar.Panels[2].Text := 'Z: ' + ' '; *)
696

697

698
  DoResetCamera;
699
  Screen.Cursor := crDefault;
700
end;
701

702
end.
703

704