LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
  Invisible component for helping to Move, Rotate and Scale an Object
6
  under GLScene (usefull for an Editor).
7

8
   History :  
9
   10/11/12 - PW - Added CPP compatibility by changing arrays to records for vectors;
10
                 replaced uppercase characters in prefixes for enum types to lower case
11
   22/04/10 - Yar - Fixes after GLState revision
12
   14/07/09 - DaStr - Bugfixed object selection from code (thanks Predator)
13
   20/01/08 - DaStr - Cleaned up uses section for proper FPC support
14
                (thanks Lukasz Sokol)
15
   18/09/07 - DaStr - Initial version (based on GLGizmo.pas by Adirex,
16
                 J.Delauney, Degiovani, Marcus Oblak and a bit myself)
17
   
18
}
19
//
20
// Original Header:
21
//
22
// ------------------------------------------------------------------------------
23
// Unit : GLGizmo  RC 1.0
24
// ------------------------------------------------------------------------------
25
// Original Author : ???????  (glGizmo In an ODEEditor)
26
// ------------------------------------------------------------------------------
27
// Modified by     : J.Delauney
28
// Web Site        : http://KheopsInteractive.cjb.net
29
// EMail           : wmkheops@free.fr
30
// Date            : 08/05/2005
31
//
32
// Modified by     : Marcus Oblak (8/3/2007)
33
// - Corrected moving/rotating for children objects
34
// - Better quantization for mouse operations (MoveCoef,RotationCoef)
35
// - Added ScaleCoef
36
// - Added GizmoThickness
37
//
38
// If you make some changes, please send your new version. Thanks
39
// ------------------------------------------------------------------------------
40
// Description :
41
// Invisible component for helping to Move, Rotate and Scale an Object
42
// under GLScene (usefull for an Editor)
43
// ------------------------------------------------------------------------------
44
// Features :
45
// - Interaction When All Gizmo parts are Invisible
46
// - Add "gpMoveGizmo and  gpRotateGizmo" operations and use Like a "Pivot"
47
// or use RootGizmo As "Pivot"
48
// - Add Interactive Camera Movements
49
// - Adding Extended Controls with Keys
50
// - Maybe An Undo Function
51
// - Others Ideas ???
52
// ------------------------------------------------------------------------------
53
// Bugs Known :
54
// - When you change the BoundingBoxColor and LabelInfosColor
55
// The New Color is not Updated immediately, only after a new Click
56
// (see in UpdateGizmo, SetBoundingBoxColor
57
// and SetLabelInfosColor Procedures)
58
// -  DaStr: Bounding Box is not alway drawn correctly because it does not
59
// use objects' BarryCenter. For Example, if you select Space Text.
60
// ------------------------------------------------------------------------------
61

62
unit GLGizmo;
63

64
interface
65

66
{$I GLScene.inc}
67

68
uses
69
  // Standard
70
  Classes, SysUtils,
71

72
  GLScene, GLColor, GLObjects, GLVectorGeometry, GLMaterial, GLStrings,
73
  GLGeomObjects, GLBitmapFont, GLViewer, GLVectorFileObjects, GLCrossPlatform,
74
  GLCoordinates, GLRenderContextInfo, GLState, GLSelection
75
, GLVectorTypes;
76

77
type
78
  TGLGizmoUndoCollection = class;
79
  TGLGizmo = class;
80

81
  TGLGizmoUndoItem = class(TCollectionItem)
82
  private
83
    FOldLibMaterialName: string;
84
    FOldAutoScaling: TGLCoordinates;
85
    FEffectedObject: TGLCustomSceneObject;
86
    FOldMatr: TMatrix;
87
    FOldMatrix: TMatrix;
88
    procedure SetEffectedObject(const Value: TGLCustomSceneObject);
89
    procedure SetOldAutoScaling(const Value: TGLCoordinates);
90
    procedure SetOldMatrix(const Value: TMatrix);
91
  protected
92
    procedure DoUndo; virtual;
93
    function GetParent: TGLGizmoUndoCollection;
94
    function GetGizmo: TGLGizmo;
95
  public
96
    constructor Create(AOwner: TCollection); override;
97
    destructor Destroy; override;
98
    procedure Notification(AComponent: TComponent;
99
      Operation: TOperation); virtual;
100
    procedure AssignFromObject(const AObject: TGLCustomSceneObject);
101

102
    // TODO: create a special type for Matrix.
103
    property OldMatrix: TMatrix read FOldMatrix write SetOldMatrix;
104
  published
105
    property EffectedObject: TGLCustomSceneObject read FEffectedObject
106
      write SetEffectedObject;
107
    property OldAutoScaling: TGLCoordinates read FOldAutoScaling
108
      write SetOldAutoScaling;
109
    property OldLibMaterialName: string read FOldLibMaterialName
110
      write FOldLibMaterialName;
111
  end;
112

113
  TGLGizmoUndoCollection = class(TOwnedCollection)
114
  private
115
    function GetItems(const Index: Integer): TGLGizmoUndoItem;
116
    procedure SetItems(const Index: Integer; const Value: TGLGizmoUndoItem);
117
  protected
118
    function GetParent: TGLGizmo;
119
  public
120
    procedure Notification(AComponent: TComponent; Operation: TOperation);
121
    procedure RemoveByObject(const AObject: TGLCustomSceneObject);
122
    function Add: TGLGizmoUndoItem;
123
    property Items[const Index: Integer]: TGLGizmoUndoItem read GetItems
124
      write SetItems; default;
125
  end;
126

127
  TGLGizmoElement = (geMove, geRotate, geScale, geAxisLabel, geObjectInfos,
128
    geBoundingBox);
129
  TGLGizmoElements = set of TGLGizmoElement;
130

131
  TGLGizmoVisibleInfoLabel = (vliName, vliOperation, vliCoords);
132
  TGLGizmoVisibleInfoLabels = set of TGLGizmoVisibleInfoLabel;
133

134
  TGLGizmoAxis = (gaNone, gaX, gaY, gaZ, gaXY, gaXZ, gaYZ);
135

136
  TGLGizmoOperation = (gopMove, gopRotate, gopScale, gopNone, gpMoveGizmo,
137
    gpRotateGizmo);
138

139
  TGLGizmoAcceptEvent = procedure(Sender: TObject; var Obj: TGLBaseSceneObject;
140
    var Accept: Boolean; var Dimensions: TVector) of object;
141
  TGLGizmoUpdateEvent = procedure(Sender: TObject; Obj: TGLBaseSceneObject;
142
    Axis: TGLGizmoAxis; Operation: TGLGizmoOperation; var Vector: TVector)
143
    of object;
144

145
  TGLGizmoPickMode = (pmGetPickedObjects, pmRayCast);
146

147
  TGLGizmoRayCastHitData = class(TPersistent)
148
  public
149
    Obj: TGLBaseSceneObject;
150
    Point: TVector;
151
  end;
152

153
  TGLGizmoPickCube = class(TGLCube)
154
  end;
155

156
  TGLGizmoPickTorus = class(TGLTorus)
157
  end;
158

159
  TGLGizmo = class(TComponent)
160
  private
161
    _GZObaseGizmo: TGLBaseSceneObject;
162

163
    _GZOBoundingcube: TGLCube;
164

165
    _GZOrootHelpers: TGLBaseSceneObject;
166
    _GZOrootLines: TGLBaseSceneObject;
167
    _GZOrootTorus: TGLBaseSceneObject;
168
    _GZOrootCubes: TGLBaseSceneObject;
169
    _GZORootAxisLabel: TGLBaseSceneObject;
170
    _GZORootVisibleInfoLabels: TGLBaseSceneObject;
171

172
    _GZOlineX, _GZOlineY, _GZOlineZ, _GZOplaneXY, _GZOplaneXZ,
173
      _GZOplaneYZ: TGLLines; // For Move
174
    _GZOTorusX, _GZOTorusY, _GZOTorusZ: TGLGizmoPickTorus; // For Rotate
175
    _GZOCubeX, _GZOCubeY, _GZOCubeZ: TGLGizmoPickCube; // For Scale
176

177
    _GZOAxisLabelX, _GZOAxisLabelY, _GZOAxisLabelZ: TGLFlatText;
178
    _GZOVisibleInfoLabels: TGLFlatText;
179

180
    FRootGizmo: TGLBaseSceneObject;
181
    FSelectedObj: TGLBaseSceneObject;
182
    // FLastOperation,
183
    FOperation: TGLGizmoOperation;
184
    FSelAxis: TGLGizmoAxis;
185

186
    FBoundingBoxColor: TGLColor;
187
    FSelectedColor: TGLColor;
188
    FVisibleInfoLabelsColor: TGLColor;
189

190
    FBoundingBoxColorChanged: Boolean;
191
    FVisibleInfoLabelsColorChanged: Boolean;
192

193
    FForceOperation: Boolean;
194
    FForceAxis: Boolean;
195
    FForceUniformScale: Boolean;
196
    FAutoZoom: Boolean;
197
    FExcludeObjects: Boolean;
198
    FNoZWrite: Boolean;
199
    FEnabled: Boolean;
200

201
    FAutoZoomFactor: Single;
202
    FZoomFactor: Single;
203
    FMoveCoef: Single;
204
    FRotationCoef: Single;
205

206
    FViewer: TGLSceneViewer;
207

208
    FGizmoElements: TGLGizmoElements;
209
    FVisibleVisibleInfoLabels: TGLGizmoVisibleInfoLabels;
210

211
    FExcludeObjectsList: TStrings;
212

213
    Moving: Boolean;
214
    Mx, My: Integer;
215
    Rx, Ry: Integer;
216

217
    dglEnable, dglDisable, dgtEnable, dgtDisable, dgcEnable, dgcDisable,
218
      dglaEnable, dglaDisable, dgliEnable, dgliDisable: TGLDirectOpenGL;
219

220
    LastMousePos: TVector;
221
    ObjDimensions: TVector;
222

223
    FOnBeforeSelect: TGLGizmoAcceptEvent;
224
    FOnBeforeUpdate: TGLGizmoUpdateEvent;
225
    FOnSelectionLost: TNotifyEvent;
226
    FScaleCoef: Single;
227
    FGizmoThickness: Single;
228
    FPickMode: TGLGizmoPickMode;
229
    FInternalRaycastHitData: TList;
230

231
    FUndoHistory: TGLGizmoUndoCollection;
232
    FLabelFont: TGLCustomBitmapFont;
233

234
    procedure SetRootGizmo(const AValue: TGLBaseSceneObject);
235

236
    procedure SetGizmoElements(const AValue: TGLGizmoElements);
237
    procedure SeTGLGizmoVisibleInfoLabels(const AValue
238
      : TGLGizmoVisibleInfoLabels);
239
    procedure SetBoundingBoxColor(const AValue: TGLColor);
240
    procedure SetSelectedColor(const AValue: TGLColor);
241
    procedure SetVisibleInfoLabelsColor(const AValue: TGLColor);
242

243
    procedure SetExcludeObjectsList(const AValue: TStrings);
244

245
    procedure DirectGlDisable(Sender: TObject; var Rci: TGLRenderContextInfo);
246
    procedure DirectGlEnable(Sender: TObject; var Rci: TGLRenderContextInfo);
247

248
    function MouseWorldPos(const X, Y: Integer): TVector;
249
    function CheckObjectInExcludeList(const Obj: TGLBaseSceneObject): Boolean;
250
    procedure UpdateVisibleInfoLabels;
251
    procedure SetGLGizmoThickness(const Value: Single);
252

253
    function InternalGetPickedObjects(const X1, Y1, X2, Y2: Integer;
254
      const GuessCount: Integer = 8): TGLPickList;
255
    procedure ClearInternalRaycastHitData;
256
    procedure SetViewer(const Value: TGLSceneViewer);
257
    procedure SetLabelFont(const Value: TGLCustomBitmapFont);
258
    procedure SetSelectedObj(const Value: TGLBaseSceneObject);
259
  public
260
    PickableObjectsWithRayCast: TList;
261
    constructor Create(AOwner: TComponent); override;
262
    destructor Destroy; override;
263
    procedure Loaded; override;
264
    procedure Notification(AComponent: TComponent;
265
      Operation: TOperation); override;
266

267
    procedure ViewerMouseMove(const X, Y: Integer);
268
    procedure ViewerMouseDown(const X, Y: Integer);
269
    procedure ViewerMouseUp(const X, Y: Integer);
270

271
    procedure UpdateGizmo; overload;
272
    procedure UpdateGizmo(const NewDimensions: TVector); overload;
273
    procedure SetVisible(const AValue: Boolean);
274
    function GetPickedObjectPoint(const Obj: TGLBaseSceneObject): TVector;
275

276
    procedure LooseSelection; virtual;
277

278
    procedure UndoAdd(const AObject: TGLCustomSceneObject);
279
    property RootGizmo: TGLBaseSceneObject read FRootGizmo write SetRootGizmo;
280

281
    // --------------------------------------------------------------------
282
  published
283

284
    property Viewer: TGLSceneViewer read FViewer write SetViewer;
285

286
    property GizmoElements: TGLGizmoElements read FGizmoElements
287
      write SetGizmoElements;
288

289
    property BoundingBoxColor: TGLColor read FBoundingBoxColor
290
      write SetBoundingBoxColor;
291
    property SelectedColor: TGLColor read FSelectedColor write SetSelectedColor;
292

293
    property SelAxis: TGLGizmoAxis read FSelAxis write FSelAxis;
294
    property ForceAxis: Boolean read FForceAxis write FForceAxis;
295

296
    property SelectedObj: TGLBaseSceneObject read FSelectedObj
297
      write SetSelectedObj;
298

299
    property Operation: TGLGizmoOperation read FOperation write FOperation;
300
    property ForceOperation: Boolean read FForceOperation write FForceoperation;
301
    property ForceUniformScale: Boolean read FForceUniformScale
302
      write FForceUniformScale;
303

304
    property ExcludeObjects: Boolean read FExcludeObjects write FExcludeObjects;
305
    property ExcludeObjectsList: TStrings read FExcludeObjectsList
306
      write SetExcludeObjectsList;
307

308
    property VisibleInfoLabels: TGLGizmoVisibleInfoLabels
309
      read FVisibleVisibleInfoLabels write SeTGLGizmoVisibleInfoLabels;
310
    property VisibleInfoLabelsColor: TGLColor read FVisibleInfoLabelsColor
311
      write SetVisibleInfoLabelsColor;
312

313
    property AutoZoom: Boolean read FAutoZoom write FAutoZoom;
314
    property AutoZoomFactor: Single read FAutoZoomFactor write FAutoZoomFactor;
315
    property ZoomFactor: Single read FZoomFactor write FZoomFactor;
316

317
    property MoveCoef: Single read FMoveCoef write FMoveCoef;
318
    property RotationCoef: Single read FRotationCoef write FRotationCoef;
319
    property ScaleCoef: Single read FScaleCoef write FScaleCoef;
320
    property NoZWrite: Boolean read FNoZWrite write FNoZWrite;
321

322
    property GizmoThickness: Single read FGizmoThickness
323
      write SeTGLGizmoThickness;
324

325
    { : Indicates whether the gizmo is enabled or not.
326
      WARNING: When loading/editing (possibly whenever a structureChanged
327
      call is made) a model, sometimes the gizmo will trigger a
328
      bug if the mouse is inside the glscene Viewer. To prevent that,
329
      remember to disable the gizmo before loading, then process windows
330
      messages (i.e. application.processMessage) and then enable the gizmo
331
      again. }
332

333
    { : Warning Enable is ReadOnly property if you set to False, Gizmo is not Hidden
334
      use Visible instead if you want to Hide, if you want to Hide but keep enabled
335
      see the VisibleGizmo property }
336
    property Enabled: Boolean read FEnabled write FEnabled default False;
337

338
    property LabelFont: TGLCustomBitmapFont read FLabelFont write SetLabelFont
339
      default nil;
340

341
    property OnBeforeSelect: TGLGizmoAcceptEvent read FOnBeforeSelect
342
      write FOnBeforeSelect;
343
    property OnSelectionLost: TNotifyEvent read FOnSelectionLost
344
      write FOnSelectionLost;
345

346
    { : Called before an Update is applied. The "vector" parameter is the difference
347
      that will be applied to the object, according to the axis and
348
      operation selected. }
349
    property OnBeforeUpdate: TGLGizmoUpdateEvent read FOnBeforeUpdate
350
      write FOnBeforeUpdate;
351
    property PickMode: TGLGizmoPickMode read FPickMode write FPickMode
352
      default PmGetPickedObjects;
353
  end;
354

355
implementation
356

357
procedure RotateAroundArbitraryAxis(const AnObject: TGLBaseSceneObject;
358
  const Axis, Origin: TAffineVector; const Angle: Single);
359
var
360
  M, M1, M2, M3: TMatrix;
361
begin
362
  M1 := CreateTranslationMatrix(VectorNegate(Origin));
363
  M2 := CreateRotationMatrix(Axis, Angle * PI / 180);
364
  M3 := CreateTranslationMatrix(Origin);
365
  M := MatrixMultiply(M1, M2);
366
  M := MatrixMultiply(M, M3);
367
  AnObject.Matrix := MatrixMultiply(AnObject.Matrix, M);
368

369
  // Just a workarround to Update angles...
370
  AnObject.Roll(0);
371
  AnObject.Pitch(0);
372
  AnObject.Turn(0);
373
end;
374

375
// ------------------------------------------------------------------------------
376

377
procedure TGLGizmo.ClearInternalRaycastHitData;
378
var
379
  T: Integer;
380
begin
381
  for T := FInternalRaycastHitData.Count - 1 downto 0 do
382
  begin
383
    TGLGizmoRayCastHitData(FInternalRaycastHitData[T]).Free;
384
  end;
385
  FInternalRaycastHitData.Clear;
386
end;
387

388
constructor TGLGizmo.Create(AOwner: TComponent);
389
var
390
  Cub: TGLCube;
391
begin
392
  inherited Create(AOwner);
393
  FUndoHistory := TGLGizmoUndoCollection.Create(Self, TGLGizmoUndoItem);
394
  FPickMode := PmGetPickedObjects;
395
  PickableObjectsWithRayCast := TList.Create;
396
  FRotationCoef := 1;
397
  FMoveCoef := 0.1;
398
  FScaleCoef := 0.1;
399
  FGizmoThickness := 1;
400

401
  FInternalRaycastHitData := TList.Create;
402
  FBoundingBoxColor := TGLColor.Create(Self);
403
  FBoundingBoxColor.Color := ClrWhite;
404
  FBoundingBoxColorChanged := False;
405
  FSelectedColor := TGLColor.Create(Self);
406
  FSelectedColor.Color := ClrYellow;
407
  FVisibleInfoLabelsColor := TGLColor.Create(Self);
408
  FVisibleInfoLabelsColor.Color := ClrYellow;
409
  FVisibleInfoLabelsColorChanged := False;
410

411
  _GZObaseGizmo := TGLDummyCube.Create(Self);
412
  _GZORootHelpers := TGLDummyCube(_GZObaseGizmo.AddNewChild(TGLDummyCube));
413
  _GZOBoundingcube := TGLCube(_GZORootHelpers.AddNewChild(TGLCube));
414

415
  _GZORootLines := _GZORootHelpers.AddNewChild(TGLDummyCube);
416
  _GZORootTorus := _GZORootHelpers.AddNewChild(TGLDummyCube);
417
  _GZORootCubes := _GZORootHelpers.AddNewChild(TGLDummyCube);
418
  _GZORootAxisLabel := _GZORootHelpers.AddNewChild(TGLDummyCube);
419
  _GZORootVisibleInfoLabels := _GZORootHelpers.AddNewChild(TGLDummyCube);
420

421
  DglDisable := TGLDirectOpenGL(_GZORootLines.AddNewChild(TGLDirectOpenGL));
422
  DglDisable.OnRender := DirectGlDisable;
423
  DgtDisable := TGLDirectOpenGL(_GZORootTorus.AddNewChild(TGLDirectOpenGL));
424
  DgtDisable.OnRender := DirectGlDisable;
425
  DgcDisable := TGLDirectOpenGL(_GZORootCubes.AddNewChild(TGLDirectOpenGL));
426
  DgcDisable.OnRender := DirectGlDisable;
427
  DglaDisable := TGLDirectOpenGL
428
    (_GZORootAxisLabel.AddNewChild(TGLDirectOpenGL));
429
  DglaDisable.OnRender := DirectGlDisable;
430
  DgliDisable := TGLDirectOpenGL(_GZORootVisibleInfoLabels.AddNewChild
431
    (TGLDirectOpenGL));
432
  DgliDisable.OnRender := DirectGlDisable;
433

434
  with _GZOBoundingcube.Material do
435
  begin
436
    FaceCulling := FcNoCull;
437
    PolygonMode := PmLines;
438
    with FrontProperties do
439
    begin
440
      Diffuse.Color := FBoundingBoxColor.Color;
441
      Ambient.Color := FBoundingBoxColor.Color;
442
      Emission.Color := FBoundingBoxColor.Color;
443
    end;
444
    with BackProperties do
445
    begin
446
      Diffuse.Color := FBoundingBoxColor.Color;
447
      Ambient.Color := FBoundingBoxColor.Color;
448
      Emission.Color := FBoundingBoxColor.Color;
449
    end;
450
  end;
451

452
  _GZOlinex := TGLLines(_GZORootLines.AddnewChild(TGLLines));
453
  with _GZOlinex do
454
  begin
455
    LineColor.Color := clrRed;
456
    LineWidth := 3;
457
    NodesAspect := LnaInvisible;
458
    AddNode(0, 0, 0);
459
    AddNode(1, 0, 0);
460
    AddNode(0.9, 0, -0.1);
461
    AddNode(1, 0, 0);
462
    AddNode(0.9, 0, 0.1);
463
    // Raycast pickable object
464
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
465
    Cub.Up.SetVector(1, 0, 0);
466
    Cub.CubeWidth := 0.1;
467
    Cub.CubeHeight := 1;
468
    Cub.CubeDepth := 0.1;
469
    Cub.Position.SetPoint(0.5, 0, 0);
470
    Cub.Visible := False;
471
  end;
472

473
  _GZOliney := TGLLines(_GZORootLines.AddnewChild(TGLLines));
474
  with _GZOliney do
475
  begin
476
    LineColor.Color := clrLime;
477
    LineWidth := 3;
478
    NodesAspect := LnaInvisible;
479
    AddNode(0, 0, 0);
480
    AddNode(0, 1, 0);
481
    AddNode(0.1, 0.9, 0);
482
    AddNode(0, 1, 0);
483
    AddNode(-0.1, 0.9, 0);
484
    // Raycast pickable object
485
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
486
    Cub.Up.SetVector(0, 1, 0);
487
    Cub.CubeWidth := 0.1;
488
    Cub.CubeHeight := 1;
489
    Cub.CubeDepth := 0.1;
490
    Cub.Position.SetPoint(0, 0.5, 0);
491
    Cub.Visible := False;
492
  end;
493

494
  _GZOlinez := TGLLines(_GZORootLines.AddnewChild(TGLLines));
495
  with _GZOlinez do
496
  begin
497
    LineColor.Color := clrBlue;
498
    LineWidth := 3;
499
    NodesAspect := LnaInvisible;
500
    AddNode(0, 0, 0);
501
    AddNode(0, 0, 1);
502
    AddNode(0.1, 0, 0.9);
503
    AddNode(0, 0, 1);
504
    AddNode(-0.1, 0, 0.9);
505
    // Raycast pickable object
506
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
507
    Cub.Up.SetVector(0, 0, 1);
508
    Cub.CubeWidth := 0.1;
509
    Cub.CubeHeight := 1;
510
    Cub.CubeDepth := 0.1;
511
    Cub.Position.SetPoint(0, 0, 0.5);
512
    Cub.Visible := False;
513
  end;
514

515
  _GZOplaneXY := TGLLines(_GZORootLines.AddnewChild(TGLLines));
516
  with _GZOplaneXY do
517
  begin
518
    LineWidth := 3;
519
    Options := [LoUseNodeColorForLines];
520
    NodesAspect := LnaInvisible;
521
    SplineMode := LsmSegments;
522
    AddNode(0.8, 1, 0);
523
    TGLLinesNode(Nodes[0]).Color.Color := clrRed;
524
    AddNode(1, 1, 0);
525
    TGLLinesNode(Nodes[1]).Color.Color := clrRed;
526
    AddNode(1, 1, 0);
527
    TGLLinesNode(Nodes[2]).Color.Color := clrLime;
528
    AddNode(1, 0.8, 0);
529
    TGLLinesNode(Nodes[3]).Color.Color := clrLime;
530
    // Raycast pickable object
531
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
532
    Cub.Up.SetVector(1, 0, 0);
533
    Cub.CubeWidth := 0.2;
534
    Cub.CubeHeight := 0.2;
535
    Cub.CubeDepth := 0.1;
536
    Cub.Position.SetPoint(0.9, 0.9, 0);
537
    Cub.Visible := False;
538
  end;
539

540
  _GZOplaneXZ := TGLLines(_GZORootLines.AddnewChild(TGLLines));
541
  with _GZOplaneXZ do
542
  begin
543
    LineWidth := 3;
544
    Options := [LoUseNodeColorForLines];
545
    NodesAspect := LnaInvisible;
546
    SplineMode := LsmSegments;
547
    AddNode(1, 0, 0.8);
548
    TGLLinesNode(Nodes[0]).Color.Color := clrBlue;
549
    AddNode(1, 0, 1);
550
    TGLLinesNode(Nodes[1]).Color.Color := clrBlue;
551
    AddNode(1, 0, 1);
552
    TGLLinesNode(Nodes[2]).Color.Color := clrRed;
553
    AddNode(0.8, 0, 1);
554
    TGLLinesNode(Nodes[3]).Color.Color := clrRed;
555
    // Raycast pickable object
556
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
557
    Cub.Up.SetVector(1, 0, 0);
558
    Cub.CubeWidth := 0.1;
559
    Cub.CubeHeight := 0.2;
560
    Cub.CubeDepth := 0.2;
561
    Cub.Position.SetPoint(0.9, 0, 0.9);
562
    Cub.Visible := False;
563
  end;
564

565
  _GZOplaneYZ := TGLLines(_GZORootLines.AddnewChild(TGLLines));
566
  with _GZOplaneYZ do
567
  begin
568
    LineWidth := 3;
569
    Options := [LoUseNodeColorForLines];
570
    NodesAspect := LnaInvisible;
571
    SplineMode := LsmSegments;
572
    AddNode(0, 0.8, 1);
573
    TGLLinesNode(Nodes[0]).Color.Color := clrLime;
574
    AddNode(0, 1, 1);
575
    TGLLinesNode(Nodes[1]).Color.Color := clrLime;
576
    AddNode(0, 1, 1);
577
    TGLLinesNode(Nodes[2]).Color.Color := clrBlue;
578
    AddNode(0, 1, 0.8);
579
    TGLLinesNode(Nodes[3]).Color.Color := clrBlue;
580
    // Raycast pickable object
581
    Cub := TGLGizmoPickCube(AddNewChild(TGLGizmoPickCube));
582
    Cub.Up.SetVector(0, 0, 1);
583
    Cub.CubeWidth := 0.2;
584
    Cub.CubeHeight := 0.2;
585
    Cub.CubeDepth := 0.1;
586
    Cub.Position.SetPoint(0, 0.9, 0.9);
587
    Cub.Visible := False;
588
  end;
589

590
  _GZOTorusX := TGLGizmoPickTorus(_GZORootTorus.AddnewChild(TGLGizmoPickTorus));
591
  with _GZOTorusX do
592
  begin
593
    Rings := 16;
594
    Sides := 4;
595
    MajorRadius := 0.6;
596
    MinorRadius := 0.03;
597
    PitchAngle := 90;
598
    TurnAngle := 90;
599
    with Material do
600
    begin
601
      // FaceCulling:= fcNoCull;
602
      PolygonMode := PmFill;
603
      // BackProperties.PolygonMode:= pmFill;
604
      FrontProperties.Emission.Color := clrBlue;
605
    end;
606
  end;
607

608
  _GZOTorusY := TGLGizmoPickTorus(_GZORootTorus.AddnewChild(TGLGizmoPickTorus));
609
  with _GZOTorusY do
610
  begin
611
    Rings := 16;
612
    Sides := 4;
613
    MajorRadius := 0.6;
614
    MinorRadius := 0.03;
615
    PitchAngle := 90;
616
    with Material do
617
    begin
618
      // FaceCulling:= fcNoCull;
619
      PolygonMode := PmFill;
620
      // BackProperties.PolygonMode:= pmFill;
621
      FrontProperties.Emission.Color := clrRed;
622
    end;
623
  end;
624

625
  _GZOTorusZ := TGLGizmoPickTorus(_GZORootTorus.AddnewChild(TGLGizmoPickTorus));
626
  with _GZOTorusZ do
627
  begin
628
    Rings := 16;
629
    Sides := 4;
630
    MajorRadius := 0.6;
631
    MinorRadius := 0.03;
632
    with Material do
633
    begin
634
      // FaceCulling:= fcNoCull;
635
      PolygonMode := PmFill;
636
      // BackProperties.PolygonMode:= pmFill;
637
      FrontProperties.Emission.Color := clrLime;
638
    end;
639
  end;
640

641
  _GZOCubeX := TGLGizmoPickCube(_GZORootCubes.AddnewChild(TGLGizmoPickCube));
642
  with _GZOCubeX do
643
  begin
644
    CubeDepth := 0.1;
645
    CubeHeight := 0.1;
646
    CubeWidth := 0.1;
647
    Position.X := 1.15;
648
    with Material do
649
    begin
650
      FaceCulling := FcNoCull;
651
      PolygonMode := PmFill;
652
      FrontProperties.Emission.Color := clrRed;
653
    end;
654
  end;
655

656
  _GZOCubeY := TGLGizmoPickCube(_GZORootCubes.AddnewChild(TGLGizmoPickCube));
657
  with _GZOCubeY do
658
  begin
659
    CubeDepth := 0.1;
660
    CubeHeight := 0.1;
661
    CubeWidth := 0.1;
662
    Position.Y := 1.15;
663
    with Material do
664
    begin
665
      FaceCulling := FcNoCull;
666
      PolygonMode := PmFill;
667
      FrontProperties.Emission.Color := clrLime;
668
    end;
669
  end;
670

671
  _GZOCubeZ := TGLGizmoPickCube(_GZORootCubes.AddnewChild(TGLGizmoPickCube));
672
  with _GZOCubeZ do
673
  begin
674
    CubeDepth := 0.1;
675
    CubeHeight := 0.1;
676
    CubeWidth := 0.1;
677
    Position.Z := 1.15;
678
    with Material do
679
    begin
680
      FaceCulling := FcNoCull;
681
      PolygonMode := PmFill;
682
      FrontProperties.Emission.Color := clrBlue;
683
    end;
684
  end;
685

686
  _GZOAxisLabelX := TGLFlatText(_GZORootAxisLabel.AddNewChild(TGLFlatText));
687
  with _GZOAxisLabelX do
688
  begin
689
    ModulateColor.Color := ClrRed;
690
    Alignment := TaCenter;
691
    Layout := TlCenter;
692
    Options := Options + [FtoTwoSided];
693
    Position.X := 1.5;
694
    Scale.X := 0.02;
695
    Scale.Y := 0.02;
696
    Text := 'X';
697
  end;
698

699
  _GZOAxisLabelY := TGLFlatText(_GZORootAxisLabel.AddNewChild(TGLFlatText));
700
  with _GZOAxisLabelY do
701
  begin
702
    ModulateColor.Color := clrLime;
703
    Alignment := TaCenter;
704
    Layout := TlCenter;
705
    Options := Options + [FtoTwoSided];
706
    Position.Y := 1.5;
707
    Scale.X := 0.02;
708
    Scale.Y := 0.02;
709
    Text := 'Y';
710
  end;
711

712
  _GZOAxisLabelZ := TGLFlatText(_GZORootAxisLabel.AddNewChild(TGLFlatText));
713
  with _GZOAxisLabelZ do
714
  begin
715
    ModulateColor.Color := ClrBlue;
716
    Alignment := TaCenter;
717
    Layout := TlCenter;
718
    Options := Options + [FtoTwoSided];
719
    Position.Z := 1.5;
720
    Scale.X := 0.02;
721
    Scale.Y := 0.02;
722
    Text := 'Z';
723
  end;
724

725
  _GZOVisibleInfoLabels :=
726
    TGLFlatText(_GZORootVisibleInfoLabels.AddNewChild(TGLFlatText));
727
  with _GZOVisibleInfoLabels do
728
  begin
729
    ModulateColor.Color := clrYellow;
730
    Alignment := TaCenter;
731
    Layout := TlCenter;
732
    Options := Options + [FtoTwoSided];
733
    Position.Y := 1.8;
734
    Position.X := 0;
735
    Scale.X := 0.01;
736
    Scale.Y := 0.01;
737
    Text := '';
738
  end;
739

740
  DglEnable := TGLDirectOpenGL(_GZORootLines.AddNewChild(TGLDirectOpenGL));
741
  DglEnable.OnRender := DirectGlEnable;
742
  DgtEnable := TGLDirectOpenGL(_GZORootTorus.AddNewChild(TGLDirectOpenGL));
743
  DgtEnable.OnRender := DirectGlEnable;
744
  DgcEnable := TGLDirectOpenGL(_GZORootCubes.AddNewChild(TGLDirectOpenGL));
745
  DgcEnable.OnRender := DirectGlEnable;
746
  DglaEnable := TGLDirectOpenGL(_GZORootAxisLabel.AddNewChild(TGLDirectOpenGL));
747
  DglaEnable.OnRender := DirectGlEnable;
748
  DgliEnable := TGLDirectOpenGL(_GZORootVisibleInfoLabels.AddNewChild
749
    (TGLDirectOpenGL));
750
  DgliEnable.OnRender := DirectGlEnable;
751

752
  _GZObaseGizmo.Visible := False;
753
  FGizmoElements := FGizmoElements + [GeMove, GeRotate, GeScale, GeAxisLabel,
754
    GeObjectInfos, GeBoundingBox];
755
  FVisibleVisibleInfoLabels := FVisibleVisibleInfoLabels +
756
    [VliName, VliOperation, VliCoords];
757
  AutoZoom := True;
758
  AutoZoomFactor := 5.0;
759
  ZoomFactor := 0.35;
760
  ForceOperation := False;
761
  ForceAxis := False;
762
  ForceUniformScale := False;
763
  Enabled := True;
764
  FNoZWrite := True;
765
  FExcludeObjectsList := TStringList.Create;
766
end;
767

768
destructor TGLGizmo.Destroy;
769
begin
770
  if Assigned(FRootGizmo) then
771
    FRootGizmo.DeleteChildren
772
  else
773
  begin
774
    _GZOBaseGizmo.DeleteChildren;
775
    _GZOBaseGizmo.Free;
776
  end;
777

778
  FBoundingBoxColor.Free;
779
  FSelectedColor.Free;
780
  FVisibleInfoLabelsColor.Free;
781
  PickableObjectsWithRayCast.Free;
782
  FExcludeObjectsList.Free;
783
  ClearInternalRaycastHitData;
784
  FInternalRaycastHitData.Free;
785

786
  // FUndoHistory has to be nil before Notification() is called.
787
  FreeAndNil(FUndoHistory);
788
  inherited Destroy;
789
end;
790

791
procedure TGLGizmo.SetVisible(const AValue: Boolean);
792
begin
793
  _GZObaseGizmo.Visible := AValue;
794
end;
795

796
procedure TGLGizmo.SetGizmoElements(const AValue: TGLGizmoElements);
797
begin
798
  if AValue <> FGizmoElements then
799
  begin
800
    FGizmoElements := AValue;
801
    _GZORootLines.Visible := GeMove in FGizmoElements;
802
    _GZORootTorus.Visible := GeRotate in FGizmoElements;
803
    _GZORootCubes.Visible := GeScale in FGizmoElements;
804
    _GZORootAxisLabel.Visible := GeAxisLabel in FGizmoElements;
805
    _GZORootVisibleInfoLabels.Visible := GeObjectInfos in FGizmoElements;
806
    _GZOBoundingcube.Visible := GeBoundingBox in FGizmoElements;
807
  end;
808
end;
809

810
procedure TGLGizmo.SetBoundingBoxColor(const AValue: TGLColor);
811
begin
812
  // Bug Here New Color is not Updated
813
  if AValue <> FBoundingBoxColor then
814
  begin
815
    FBoundingBoxColor.Color := AValue.Color;
816
    with _GZOBoundingcube.Material do
817
    begin
818
      with FrontProperties do
819
      begin
820
        Diffuse.Color := FBoundingBoxColor.Color;
821
        Ambient.Color := FBoundingBoxColor.Color;
822
        Emission.Color := FBoundingBoxColor.Color;
823
      end;
824
      with BackProperties do
825
      begin
826
        Diffuse.Color := FBoundingBoxColor.Color;
827
        Ambient.Color := FBoundingBoxColor.Color;
828
        Emission.Color := FBoundingBoxColor.Color;
829
      end;
830
    end;
831
    FBoundingBoxColorChanged := True;
832
  end;
833
end;
834

835
procedure TGLGizmo.SetSelectedColor(const AValue: TGLColor);
836
begin
837
  if AValue <> FSelectedColor then
838
  begin
839
    FSelectedColor.Color := AValue.Color;
840
  end;
841
end;
842

843
procedure TGLGizmo.SetVisibleInfoLabelsColor(const AValue: TGLColor);
844
begin
845
  // Bug Here New Color is not Updated
846
  if AValue <> FSelectedColor then
847
  begin
848
    FVisibleInfoLabelsColor.Color := AValue.Color;
849
    _GZOVisibleInfoLabels.ModulateColor.Color := AValue.Color;
850
    FVisibleInfoLabelsColorChanged := True;
851
  end;
852
end;
853

854
procedure TGLGizmo.SeTGLGizmoVisibleInfoLabels(const AValue
855
  : TGLGizmoVisibleInfoLabels);
856
begin
857
  if AValue <> FVisibleVisibleInfoLabels then
858
  begin
859
    FVisibleVisibleInfoLabels := AValue;
860
    if not(CsDesigning in ComponentState) then
861
      UpdateGizmo;
862
  end;
863
end;
864

865
procedure TGLGizmo.UndoAdd(const AObject: TGLCustomSceneObject);
866
begin
867
  if AObject <> nil then
868
  begin
869
    FUndoHistory.Add.AssignFromObject(AObject)
870
  end;
871
end;
872

873
procedure TGLGizmo.SetRootGizmo(const AValue: TGLBaseSceneObject);
874
begin
875
  if FRootGizmo <> AValue then
876
  begin
877
    if FRootGizmo <> nil then
878
      FRootGizmo.RemoveFreeNotification(Self);
879
    FRootGizmo := AValue;
880
    if FRootGizmo <> nil then
881
      FRootGizmo.FreeNotification(Self);
882
    _GZObaseGizmo.MoveTo(AValue);
883
  end;
884
end;
885

886
procedure TGLGizmo.SetExcludeObjectsList(const AValue: TStrings);
887
begin
888
  FExcludeObjectsList.Clear;
889
  FExcludeObjectsList.AddStrings(AValue);
890
end;
891

892
procedure TGLGizmo.SetGLGizmoThickness(const Value: Single);
893
var
894
  Thk: Single;
895
begin
896
  if FGizmoThickness <> Value then
897
  begin
898
    Thk := MaxInteger(1, Round(3 * Value));
899
    _GZOlinex.LineWidth := Thk;
900
    _GZOliney.LineWidth := Thk;
901
    _GZOlinez.LineWidth := Thk;
902
    _GZOplaneXY.LineWidth := Thk;
903
    _GZOplaneXZ.LineWidth := Thk;
904
    _GZOplaneYZ.LineWidth := Thk;
905

906
    _GZOTorusX.MinorRadius := 0.03 * Value;
907
    _GZOTorusY.MinorRadius := 0.03 * Value;
908
    _GZOTorusZ.MinorRadius := 0.03 * Value;
909

910
    with _GZOCubeX do
911
    begin
912
      CubeDepth := 0.1 * Value;
913
      CubeHeight := 0.1 * Value;
914
      CubeWidth := 0.1 * Value;
915
    end;
916
    with _GZOCubeY do
917
    begin
918
      CubeDepth := 0.1 * Value;
919
      CubeHeight := 0.1 * Value;
920
      CubeWidth := 0.1 * Value;
921
    end;
922
    with _GZOCubeZ do
923
    begin
924
      CubeDepth := 0.1 * Value;
925
      CubeHeight := 0.1 * Value;
926
      CubeWidth := 0.1 * Value;
927
    end;
928

929
    FGizmoThickness := Value;
930
  end;
931
end;
932

933
// ------------------------------------------------------------------------------
934

935
procedure TGLGizmo.DirectGlDisable(Sender: TObject;
936
  var Rci: TGLRenderContextInfo);
937
begin
938
  if FNoZWrite then
939
    Rci.GLStates.Disable(StDepthTest);
940
end;
941

942
procedure TGLGizmo.SetLabelFont(const Value: TGLCustomBitmapFont);
943
begin
944
  if FLabelFont <> Value then
945
  begin
946
    if FLabelFont <> nil then
947
      FLabelFont.RemoveFreeNotification(Self);
948
    FLabelFont := Value;
949
    if FLabelFont <> nil then
950
      FLabelFont.FreeNotification(Self);
951

952
    _GZOAxisLabelX.BitmapFont := Value;
953
    _GZOAxisLabelY.BitmapFont := Value;
954
    _GZOAxisLabelZ.BitmapFont := Value;
955
    _GZOVisibleInfoLabels.BitmapFont := Value;
956
  end;
957
end;
958

959
procedure TGLGizmo.DirectGlEnable(Sender: TObject; var Rci: TGLRenderContextInfo);
960
begin
961
  if FNoZWrite then
962
    Rci.GLStates.Enable(StDepthTest);
963
end;
964

965
function TGLGizmo.GetPickedObjectPoint(const Obj: TGLBaseSceneObject): TVector;
966
var
967
  T: Integer;
968
  R: TGLGizmoRayCastHitData;
969
begin
970
  for T := 0 to FInternalRaycastHitData.Count - 1 do
971
  begin
972
    R := TGLGizmoRayCastHitData(FInternalRaycastHitData[T]);
973
    if R.Obj = Obj then
974
    begin
975
      Result := R.Point;
976
      Break;
977
    end;
978
  end;
979
end;
980

981
function TGLGizmo.InternalGetPickedObjects(const X1, Y1, X2, Y2: Integer;
982
  const GuessCount: Integer): TGLPickList;
983
var
984
  T: Integer;
985
  RayStart, RayVector, IPoint, INormal: TVector;
986
  O: TGLBaseSceneObject;
987
  Dist: Single;
988
  HitData: TGLGizmoRayCastHitData;
989

990
  procedure AddGizmosToPicklListRecurse(const Root: TGLBaseSceneObject);
991
  var
992
    U: Integer;
993
  begin
994
    for U := 0 to Root.Count - 1 do
995
    begin
996
      if ((Root[U] is TGLGizmoPickTorus) or (Root[U] is TGLGizmoPickCube)) then
997
        PickableObjectsWithRayCast.Add(Root[U]);
998
      AddGizmosToPicklListRecurse(Root[U]);
999
    end;
1000
  end;
1001

1002
begin
1003
  case FPickMode of
1004
    PmGetPickedObjects:
1005
      begin
1006
        Result := Viewer.Buffer.GetPickedObjects(Rect(X1, Y1, X2, Y2),
1007
          GuessCount);
1008
      end;
1009

1010
    PmRayCast:
1011
      begin
1012
        Result := TGLPickList.Create(PsMinDepth);
1013
        ClearInternalRaycastHitData;
1014
        SetVector(RayStart, Viewer.Camera.AbsolutePosition);
1015
        SetVector(RayVector, Viewer.Buffer.ScreenToVector
1016
          (AffineVectorMake((X1 + X2) * 0.5,
1017
          Viewer.Height - ((Y1 + Y2) * 0.5), 0)));
1018
        NormalizeVector(RayVector);
1019
        // Add gizmos
1020
        if (RootGizmo <> nil) and (SelectedObj <> nil) then
1021
          AddGizmosToPicklListRecurse(RootGizmo);
1022
        // pick
1023
        for T := 0 to PickableObjectsWithRayCast.Count - 1 do
1024
        begin
1025
          O := TGLBaseSceneObject(PickableObjectsWithRayCast[T]);
1026
          if (O.RayCastIntersect(RayStart, RayVector, @IPoint, @INormal)) and
1027
            (VectorDotProduct(RayVector, INormal) < 0) then
1028
          begin
1029
            try
1030
              Dist := VectorLength(VectorSubtract(IPoint, RayStart));
1031
              Result.AddHit(O, nil, Dist, 0);
1032
              HitData := TGLGizmoRayCastHitData.Create;
1033
              HitData.Obj := O;
1034
              MakeVector(HitData.Point, IPoint);
1035
              FInternalRaycastHitData.Add(HitData);
1036
            except
1037
              //
1038
            end;
1039
          end;
1040
        end;
1041
      end;
1042

1043
  else
1044
    begin
1045
      Result := nil;
1046
      Assert(False, GlsErrorEx + GlsUnknownType);
1047
    end;
1048

1049
  end;
1050
end;
1051

1052
procedure TGLGizmo.Loaded;
1053
begin
1054
  inherited;
1055
  SeTGLGizmoThickness(GizmoThickness);
1056
end;
1057

1058
// ------------------------------------------------------------------------------
1059
procedure TGLGizmo.UpdateVisibleInfoLabels;
1060
var
1061
  T: string;
1062
  X, Y, Z: Single;
1063
begin
1064
  T := '';
1065
  if not(Assigned(SelectedObj)) then
1066
    Exit;
1067
  if VliName in FVisibleVisibleInfoLabels then
1068
    T := SelectedObj.Name;
1069

1070
  if VliOperation in FVisibleVisibleInfoLabels then
1071
  begin
1072
    if (Operation <> GopNone) then
1073
    begin
1074
      if Length(T) > 0 then
1075
        T := T + ' - ';
1076
      case Operation of
1077
        GopMove:
1078
          T := T + 'Move';
1079
        GopRotate:
1080
          T := T + 'Rotate';
1081
        GopScale:
1082
          T := T + 'Scale';
1083
      end;
1084
    end;
1085
  end;
1086

1087
  if VliCoords in FVisibleVisibleInfoLabels then
1088
  begin
1089
    if (Operation <> GopNone) then
1090
    begin
1091
      if Length(T) > 0 then
1092
        T := T + ' - ';
1093
      case Operation of
1094
        GopMove:
1095
          begin
1096
            X := SelectedObj.Position.X;
1097
            Y := SelectedObj.Position.Y;
1098
            Z := SelectedObj.Position.Z;
1099
            T := T + 'X : ' + Format('%2.3f', [X]);
1100
            T := T + ' Y : ' + Format('%2.3f', [Y]);
1101
            T := T + ' Z : ' + Format('%2.3f', [Z]);
1102
          end;
1103
        GopRotate:
1104
          begin
1105
            X := SelectedObj.Rotation.X;
1106
            Y := SelectedObj.Rotation.Y;
1107
            Z := SelectedObj.Rotation.Z;
1108
            T := T + 'X : ' + Format('%2.3f', [X]);
1109
            T := T + ' Y : ' + Format('%2.3f', [Y]);
1110
            T := T + ' Z : ' + Format('%2.3f', [Z]);
1111
          end;
1112
        GopScale:
1113
          begin
1114
            X := SelectedObj.Scale.X;
1115
            Y := SelectedObj.Scale.Y;
1116
            Z := SelectedObj.Scale.Z;
1117
            T := T + 'X : ' + Format('%2.3f', [X]);
1118
            T := T + ' Y : ' + Format('%2.3f', [Y]);
1119
            T := T + ' Z : ' + Format('%2.3f', [Z]);
1120
          end;
1121
      end;
1122
    end;
1123
  end;
1124

1125
  _GZOVisibleInfoLabels.Text := T;
1126
  _GZOVisibleInfoLabels.StructureChanged;
1127
end;
1128

1129
// ------------------------------------------------------------------------------
1130

1131
function TGLGizmo.CheckObjectInExcludeList
1132
  (const Obj: TGLBaseSceneObject): Boolean;
1133
var
1134
  I: Integer;
1135
begin
1136
  Result := False;
1137
  if FExcludeObjects then
1138
  begin
1139
    for I := 0 to FExcludeObjectsList.Count - 1 do
1140
    begin
1141
      if UpperCase(Obj.Name) = UpperCase(FExcludeObjectsList[I]) then
1142
      begin
1143
        Result := True;
1144
        Exit;
1145
      end;
1146
    end;
1147
  end;
1148
end;
1149

1150
function TGLGizmo.MouseWorldPos(const X, Y: Integer): TVector;
1151
var
1152
  V: TVector;
1153
  InvertedY: Integer;
1154
begin
1155
  InvertedY := Viewer.Height - Y;
1156
  if Assigned(SelectedObj) then
1157
  begin
1158
    SetVector(V, X, InvertedY, 0);
1159

1160
    case SelAxis of
1161
      GaX:
1162
        if not Viewer.Buffer.ScreenVectorIntersectWithPlaneXZ(V,
1163
          SelectedObj.AbsolutePosition.V[1], Result) then
1164
          MakeVector(Result, X / 5, 0, 0);
1165

1166
      GaY:
1167
        if not Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(V,
1168
          SelectedObj.AbsolutePosition.V[0], Result) then
1169
          MakeVector(Result, 0, InvertedY / 5, 0);
1170

1171
      GaZ:
1172
        if not Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(V,
1173
          SelectedObj.AbsolutePosition.V[0], Result) then
1174
          MakeVector(Result, 0, 0, -InvertedY / 5);
1175

1176
      GaXY:
1177
        begin
1178
          Viewer.Buffer.ScreenVectorIntersectWithPlaneXY(V,
1179
            SelectedObj.AbsolutePosition.V[2], Result);
1180
        end;
1181
      GaXZ:
1182
        begin
1183
          Viewer.Buffer.ScreenVectorIntersectWithPlaneXZ(V,
1184
            SelectedObj.AbsolutePosition.V[1], Result);
1185
        end;
1186
      GaYZ:
1187
        begin
1188
          Viewer.Buffer.ScreenVectorIntersectWithPlaneYZ(V,
1189
            SelectedObj.AbsolutePosition.V[0], Result);
1190
        end;
1191
    end;
1192

1193
  end
1194
  else
1195
    SetVector(Result, NullVector);
1196
end;
1197

1198
procedure TGLGizmo.ViewerMouseMove(const X, Y: Integer);
1199
var
1200
  PickList: TGLPickList;
1201
  MousePos: TVector;
1202

1203
  function IndexOf(Obj: TGLBaseSceneObject): Integer;
1204
  var
1205
    I: Integer;
1206
  begin
1207
    Result := -1;
1208
    for I := 0 to PickList.Count - 1 do
1209
      if PickList.Hit[I] = Obj then
1210
      begin
1211
        Result := I;
1212
        Break;
1213
      end;
1214
  end;
1215

1216
  function LightLine(const Line: TGLLines; const Dark: TVector;
1217
    const Axis: TGLGizmoAxis; AlterStyle: Boolean = False): Boolean;
1218
  var
1219
    PickObj: TGLBaseSceneObject;
1220
  begin
1221
    case FPickMode of
1222
      PmGetPickedObjects:
1223
        PickObj := Line;
1224
      PmRayCast:
1225
        PickObj := Line;
1226
    else
1227
      begin
1228
        PickObj := nil;
1229
        Assert(False, GlsErrorEx + GlsUnknownType);
1230
      end;
1231
    end;
1232

1233
    if IndexOf(PickObj) > -1 then
1234
    begin
1235
      Line.LineColor.Color := FSelectedColor.Color;
1236
      if not(FForceOperation) then
1237
        if Operation <> GopMove then
1238
          Operation := GopMove;
1239
      Line.Options := [];
1240
      if not(FForceAxis) then
1241
        SelAxis := Axis;
1242
      Result := True;
1243
    end
1244
    else
1245
    begin
1246
      Line.LineColor.Color := Dark;
1247
      if not(FForceOperation) then
1248
        Operation := GopNone;
1249
      if AlterStyle then
1250
        Line.Options := [LoUseNodeColorForLines];
1251
      if not(FForceAxis) then
1252
        if SelAxis = Axis then
1253
          SelAxis := GaNone;
1254
      Result := False;
1255
    end;
1256
  end;
1257

1258
  function LightTorus(const Torus: TGLGizmoPickTorus; const Dark: TVector;
1259
    const Axis: TGLGizmoAxis; AlterStyle: Boolean = False): Boolean;
1260
  begin
1261
    if IndexOf(Torus) > -1 then
1262
    begin
1263
      Torus.Material.FrontProperties.Emission.Color := FSelectedColor.Color;
1264
      if not(FForceOperation) then
1265
        if Operation <> GopRotate then
1266
          Operation := GopRotate;
1267
      if not(FForceAxis) then
1268
        SelAxis := Axis;
1269
      Result := True;
1270
    end
1271
    else
1272
    begin
1273
      Torus.Material.FrontProperties.Emission.Color := Dark;
1274
      if not(FForceOperation) then
1275
        Operation := GopNone;
1276
      if not(FForceAxis) then
1277
        if SelAxis = Axis then
1278
          SelAxis := GaNone;
1279
      Result := False;
1280
    end;
1281
  end;
1282

1283
  function LightCube(const Cube: TGLCube; const Dark: TVector;
1284
    const Axis: TGLGizmoAxis; AlterStyle: Boolean = False): Boolean;
1285
  begin
1286
    if IndexOf(Cube) > -1 then
1287
    begin
1288
      Cube.Material.FrontProperties.Emission.Color := FSelectedColor.Color;
1289
      if not(FForceOperation) then
1290
        if Operation <> GopScale then
1291
          Operation := GopScale;
1292
      if not(FForceAxis) then
1293
        SelAxis := Axis;
1294
      Result := True;
1295
    end
1296
    else
1297
    begin
1298
      Cube.Material.FrontProperties.Emission.Color := Dark;
1299
      if not(FForceOperation) then
1300
        Operation := GopNone;
1301
      if not(FForceAxis) then
1302
        if SelAxis = Axis then
1303
          SelAxis := GaNone;
1304
      Result := False;
1305
    end;
1306
  end;
1307

1308
  procedure OpeMove(MousePos: TVector);
1309
  var
1310
    Vec1, Vec2: TVector;
1311
    QuantizedMousePos, QuantizedMousePos2: TVector;
1312
    T: Integer;
1313
  begin
1314
    for T := 0 to 3 do
1315
    begin
1316
      QuantizedMousePos.V[T] := (Round(MousePos.V[T] / MoveCoef)) * MoveCoef;
1317
      QuantizedMousePos2.V[T] := (Round(LastMousePos.V[T] / MoveCoef)) * MoveCoef;
1318
    end;
1319
    case SelAxis of
1320
      GaX:
1321
        begin
1322
          MakeVector(Vec1, QuantizedMousePos.V[0], 0, 0);
1323
          MakeVector(Vec2, QuantizedMousePos2.V[0], 0, 0);
1324
        end;
1325
      GaY:
1326
        begin
1327
          MakeVector(Vec1, 0, QuantizedMousePos.V[1], 0);
1328
          MakeVector(Vec2, 0, QuantizedMousePos2.V[1], 0);
1329
        end;
1330
      GaZ:
1331
        begin
1332
          MakeVector(Vec1, 0, 0, QuantizedMousePos.V[2]);
1333
          MakeVector(Vec2, 0, 0, QuantizedMousePos2.V[2]);
1334
        end;
1335
    else
1336
      begin
1337
        Vec1 := QuantizedMousePos;
1338
        Vec2 := QuantizedMousePos2;
1339
      end;
1340
    end;
1341
    SubtractVector(Vec1, Vec2);
1342
    if Assigned(OnBeforeUpdate) then
1343
      OnBeforeUpdate(Self, SelectedObj, SelAxis, Operation, Vec1);
1344
    Vec1 := SelectedObj.Parent.AbsoluteToLocal(Vec1);
1345
    if (VectorLength(Vec1) > 0) then // prevents NAN problems
1346
    begin
1347
      SelectedObj.Position.Translate(Vec1);
1348
    end;
1349
  end;
1350

1351
  procedure OpeRotate(const X, Y: Integer);
1352
  var
1353
    Vec1: TVector;
1354
    RotV: TAffineVector;
1355
    Pmat: TMatrix;
1356

1357
  begin
1358
    Vec1.V[0] := 0;
1359
    Vec1.V[1] := 0;
1360
    if Abs(X - Rx) >= RotationCoef then
1361
    begin
1362
      if RotationCoef > 1 then
1363
        Vec1.V[0] := RotationCoef * (Round((X - Rx) / (RotationCoef)))
1364
      else
1365
        Vec1.V[0] := RotationCoef * (X - Rx);
1366
      Rx := X;
1367
    end;
1368
    if Abs(Y - Ry) >= RotationCoef then
1369
    begin
1370
      if RotationCoef > 1 then
1371
        Vec1.V[1] := RotationCoef * (Round((Y - Ry) / (RotationCoef)))
1372
      else
1373
        Vec1.V[1] := RotationCoef * (Y - Ry);
1374
      Ry := Y;
1375
    end;
1376

1377
    Vec1.V[2] := 0;
1378
    Vec1.V[3] := 0;
1379
    if Assigned(OnBeforeUpdate) then
1380
      OnBeforeUpdate(Self, SelectedObj, SelAxis, Operation, Vec1);
1381

1382
    Pmat := SelectedObj.Parent.InvAbsoluteMatrix;
1383
    SetVector(Pmat.V[3], NullHmgPoint);
1384
    case SelAxis of
1385
      GaX:
1386
        begin
1387
          RotV := VectorTransform(XVector, Pmat);
1388
          RotateAroundArbitraryAxis(SelectedObj, RotV,
1389
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.V[1]);
1390
        end;
1391
      GaY:
1392
        begin
1393
          RotV := VectorTransform(YVector, Pmat);
1394
          RotateAroundArbitraryAxis(SelectedObj, RotV,
1395
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.V[0]);
1396
        end;
1397
      GaZ:
1398
        begin
1399
          RotV := VectorTransform(ZVector, Pmat);
1400
          RotateAroundArbitraryAxis(SelectedObj, RotV,
1401
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.V[1]);
1402
        end;
1403
      GaXY:
1404
        begin
1405
          RotV := VectorTransform(XVector, Pmat);
1406
          RotateAroundArbitraryAxis(SelectedObj, RotV,
1407
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.V[1]);
1408
          RotV := VectorTransform(YVector, Pmat);
1409
          RotateAroundArbitraryAxis(SelectedObj, RotV,
1410
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.V[0]);
1411
        end;
1412
      GaXZ:
1413
        begin
1414
          RotV := VectorTransform(XVector, Pmat);
1415
          RotateAroundArbitraryAxis(SelectedObj, RotV,
1416
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.V[1]);
1417
          RotV := VectorTransform(ZVector, Pmat);
1418
          RotateAroundArbitraryAxis(SelectedObj, RotV,
1419
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.V[0]);
1420
        end;
1421
      GaYZ:
1422
        begin
1423
          RotV := VectorTransform(YVector, Pmat);
1424
          RotateAroundArbitraryAxis(SelectedObj, RotV,
1425
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.V[1]);
1426
          RotV := VectorTransform(ZVector, Pmat);
1427
          RotateAroundArbitraryAxis(SelectedObj, RotV,
1428
            AffineVectorMake(SelectedObj.Position.AsVector), Vec1.V[0]);
1429
        end;
1430
    end;
1431
  end;
1432

1433
  procedure OpeScale(const MousePos: TVector);
1434
  var
1435
    Vec1, Vec2: TVector;
1436
    QuantizedMousePos, QuantizedMousePos2: TVector;
1437
    T: Integer;
1438
  begin
1439
    for T := 0 to 3 do
1440
    begin
1441
      QuantizedMousePos.V[T] := (Round(MousePos.V[T] / ScaleCoef)) * FScaleCoef;
1442
      QuantizedMousePos2.V[T] := (Round(LastMousePos.V[T] / FScaleCoef)) *
1443
        FScaleCoef;
1444
    end;
1445
    case SelAxis of
1446
      GaX:
1447
        begin
1448
          if FForceUniformScale then
1449
          begin
1450
            MakeVector(Vec1, QuantizedMousePos.V[0], QuantizedMousePos.V[0],
1451
              QuantizedMousePos.V[0]);
1452
            MakeVector(Vec2, QuantizedMousePos2.V[0], QuantizedMousePos2.V[0],
1453
              QuantizedMousePos2.V[0]);
1454
          end
1455
          else
1456
          begin
1457
            MakeVector(Vec1, QuantizedMousePos.V[0], 0, 0);
1458
            MakeVector(Vec2, QuantizedMousePos2.V[0], 0, 0);
1459
          end;
1460

1461
        end;
1462

1463
      GaY:
1464
        begin
1465
          if FForceUniformScale then
1466
          begin
1467
            MakeVector(Vec1, QuantizedMousePos.V[1], QuantizedMousePos.V[1],
1468
              QuantizedMousePos.V[1]);
1469
            MakeVector(Vec2, QuantizedMousePos2.V[1], QuantizedMousePos2.V[1],
1470
              QuantizedMousePos2.V[1]);
1471
          end
1472
          else
1473
          begin
1474
            MakeVector(Vec1, 0, QuantizedMousePos.V[1], 0);
1475
            MakeVector(Vec2, 0, QuantizedMousePos2.V[1], 0);
1476
          end;
1477
        end;
1478

1479
      GaZ:
1480
        begin
1481
          if FForceUniformScale then
1482
          begin
1483
            MakeVector(Vec1, QuantizedMousePos.V[2], QuantizedMousePos.V[2],
1484
              QuantizedMousePos.V[2]);
1485
            MakeVector(Vec2, QuantizedMousePos2.V[2], QuantizedMousePos2.V[2],
1486
              QuantizedMousePos2.V[2]);
1487
          end
1488
          else
1489
          begin
1490
            MakeVector(Vec1, 0, 0, QuantizedMousePos.V[2]);
1491
            MakeVector(Vec2, 0, 0, QuantizedMousePos2.V[2]);
1492
          end;
1493
        end;
1494
    else
1495
      begin
1496
        Vec1 := QuantizedMousePos;
1497
        Vec2 := QuantizedMousePos2;
1498
      end;
1499
    end;
1500
    SubtractVector(Vec1, Vec2);
1501
    if Assigned(OnBeforeUpdate) then
1502
      OnBeforeUpdate(Self, SelectedObj, SelAxis, Operation, Vec1);
1503
    SelectedObj.Scale.Translate(Vec1);
1504
    UpdateGizmo;
1505
  end;
1506

1507
begin
1508
  if not Enabled then
1509
    Exit;
1510

1511
  if Assigned(SelectedObj) and (SelAxis <> GaNone) and Moving then
1512
  begin
1513
    MousePos := MouseWorldPos(X, Y);
1514

1515
    // moving object...
1516
    if Operation = GopMove then
1517
    begin
1518
      // FLastOperation = gopMove;
1519
      OpeMove(MousePos);
1520
    end
1521
    else if Operation = GopRotate then
1522
    begin
1523
      // FLastOperation = gopRotate;
1524
      OpeRotate(X, Y);
1525
    end
1526
    else if Operation = GopScale then
1527
    begin
1528
      // FLastOperation = gopScale;
1529
      OpeScale(MousePos);
1530
    end;
1531

1532
    UpdateGizmo;
1533
    Mx := X;
1534
    My := Y;
1535
    LastMousePos := MousePos;
1536
    Exit;
1537
  end;
1538

1539
  Assert(FViewer <> nil, 'Viewer not Assigned to gizmo');
1540
  Picklist := InternalGetPickedObjects(X - 1, Y - 1, X + 1, Y + 1, 8);
1541
  // Viewer.buffer.GetPickedObjects(rect(x-1, y-1, x+1, y+1), 8);
1542

1543
  if not LightLine(_GZOlinex, ClrRed, GaX) and not LightLine(_GZOliney, ClrLime,
1544
    GaY) and not LightLine(_GZOlinez, ClrBlue, GaZ) and
1545
    not LightTorus(_GZOTorusX, ClrRed, GaX) and
1546
    not LightTorus(_GZOTorusY, ClrLime, GaY) and
1547
    not LightTorus(_GZOTorusz, ClrBlue, GaZ) and
1548
    not LightCube(_GZOCubeX, ClrRed, GaX) and not LightCube(_GZOCubeY, ClrLime,
1549
    GaY) and not LightCube(_GZOCubeZ, ClrBlue, GaZ) and
1550
    not LightLine(_GZOplaneXY, ClrWhite, GaXY, True) and
1551
    not LightLine(_GZOplaneXZ, ClrWhite, GaXZ, True) and
1552
    not LightLine(_GZOplaneYZ, ClrWhite, GaYZ, True) then
1553
  begin
1554
    if not(FForceAxis) then
1555
      SelAxis := GaNone;
1556
    if not(FForceOperation) then
1557
      Operation := GopNone;
1558
  end;
1559

1560
  Picklist.Free;
1561

1562
  Mx := X;
1563
  My := Y;
1564
end;
1565

1566
procedure TGLGizmo.ViewerMouseDown(const X, Y: Integer);
1567
var
1568
  Pick: TGLPickList;
1569
  I: Integer;
1570
  Accept: Boolean;
1571
  Dimensions: TVector;
1572
  GotPick: Boolean;
1573
  PickedObj: TGLBaseSceneObject;
1574
begin
1575
  Mx := X;
1576
  My := Y;
1577
  Rx := X;
1578
  Ry := Y;
1579

1580
  if not Enabled then
1581
    Exit;
1582

1583
  Pick := InternalGetPickedObjects(X - 1, Y - 1, X + 1, Y + 1);
1584
  // Viewer.Buffer.GetPickedObjects(rect(x-1, y-1, x+1, y+1));
1585
  GotPick := False;
1586
  Accept := False;
1587

1588
  case FPickMode of
1589
    PmGetPickedObjects:
1590
      begin
1591
        // primeiro, ver se � uma das linhas/planos
1592
        for I := 0 to Pick.Count - 1 do
1593
          if (_GZOrootLines.IndexOfChild(TGLBaseSceneObject(Pick.Hit[I])) > -1)
1594
            or (_GZOrootTorus.IndexOfChild(TGLBaseSceneObject(Pick.Hit[I])) >
1595
            -1) or (_GZOrootCubes.IndexOfChild(TGLBaseSceneObject(Pick.Hit[I]))
1596
            > -1) then
1597
            GotPick := True;
1598
      end;
1599

1600
    PmRayCast:
1601
      begin
1602
        for I := 0 to Pick.Count - 1 do
1603
        begin
1604
          if (Pick.Hit[I] is TGLGizmoPickCube) or
1605
            (Pick.Hit[I] is TGLGizmoPickTorus) then
1606
            GotPick := True;
1607
        end;
1608
      end;
1609
  else
1610
    begin
1611
      Assert(False, GlsErrorEx + GlsUnknownType);
1612
    end;
1613

1614
  end;
1615

1616
  if not GotPick then
1617
  begin
1618
    for I := 0 to Pick.Count - 1 do
1619

1620
      if (Pick.Hit[I] <> _GZOBoundingcube) and (Pick.Hit[I] <> _GZOAxisLabelX)
1621
        and (Pick.Hit[I] <> _GZOAxisLabelY) and (Pick.Hit[I] <> _GZOAxisLabelZ)
1622
        and (Pick.Hit[I] <> _GZOVisibleInfoLabels) and
1623
        not(CheckObjectInExcludeList(TGLBaseSceneObject(Pick.Hit[I]))) then
1624
      begin
1625
        Accept := True;
1626
        PickedObj := TGLBaseSceneObject(Pick.Hit[I]);
1627
        Dimensions := PickedObj.AxisAlignedDimensions;
1628
        if Assigned(OnBeforeSelect) then
1629
          OnBeforeSelect(Self, PickedObj, Accept, Dimensions);
1630

1631
        Break;
1632
      end;
1633

1634
    if Accept then
1635
      SetSelectedObj(PickedObj)
1636
    else
1637
      SetSelectedObj(nil);
1638
  end
1639
  else
1640
    UpdateVisibleInfoLabels();
1641

1642
  Pick.Free;
1643

1644
  Moving := True;
1645
  LastMousePos := MouseWorldPos(X, Y);
1646
end;
1647

1648
procedure TGLGizmo.ViewerMouseUp(const X, Y: Integer);
1649
begin
1650
  Moving := False;
1651
end;
1652

1653
// ------------------------------------------------------------------------------
1654

1655
procedure TGLGizmo.UpdateGizmo;
1656
var
1657
  D: Single;
1658
begin
1659
  if SelectedObj = nil then
1660
  begin
1661
    _GZObaseGizmo.Visible := False;
1662
    Exit;
1663
  end;
1664

1665
  _GZObaseGizmo.Position.AsVector := SelectedObj.AbsolutePosition;
1666
  if GeObjectInfos in FGizmoElements then
1667
    UpdateVisibleInfoLabels;
1668

1669
  _GZOBoundingcube.Matrix := SelectedObj.AbsoluteMatrix;
1670
  _GZOBoundingcube.Position.SetPoint(0, 0, 0);
1671

1672
  // We must Update Color Of the BoundingBox And VisibleInfoLabels Here
1673
  // If not Color is not Updated;
1674

1675
  // if FBoundingBoxColorChanged then
1676
  // Begin
1677
  with _GZOBoundingcube.Material do
1678
  begin
1679
    with FrontProperties do
1680
    begin
1681
      Diffuse.Color := FBoundingBoxColor.Color;
1682
      Ambient.Color := FBoundingBoxColor.Color;
1683
      Emission.Color := FBoundingBoxColor.Color;
1684
    end;
1685
    with BackProperties do
1686
    begin
1687
      Diffuse.Color := FBoundingBoxColor.Color;
1688
      Ambient.Color := FBoundingBoxColor.Color;
1689
      Emission.Color := FBoundingBoxColor.Color;
1690
    end;
1691
  end;
1692
  // FBoundingBoxColorChanged:=False;
1693
  // End;
1694
  // If FVisibleInfoLabelsColorChanged then
1695
  // Begin
1696
  _GZOVisibleInfoLabels.ModulateColor.Color := FVisibleInfoLabelsColor.Color;
1697
  // FVisibleInfoLabelsColorChanged:=False;
1698
  // End;
1699

1700
  ObjDimensions := SelectedObj.AxisAlignedDimensions;
1701
  _GZOBoundingcube.Scale.AsVector := VectorScale(ObjDimensions, 2);
1702

1703
  Assert(Viewer <> nil, 'Viewer not Assigned to gizmo');
1704

1705
  _GZOAxisLabelX.PointTo(Viewer.Camera.Position.AsVector,
1706
    Viewer.Camera.Up.AsVector);
1707
  _GZOAxisLabelX.StructureChanged;
1708
  _GZOAxisLabelY.PointTo(Viewer.Camera.Position.AsVector,
1709
    Viewer.Camera.Up.AsVector);
1710
  _GZOAxisLabelY.StructureChanged;
1711
  _GZOAxisLabelZ.PointTo(Viewer.Camera.Position.AsVector,
1712
    Viewer.Camera.Up.AsVector);
1713
  _GZOAxisLabelZ.StructureChanged;
1714
  _GZOVisibleInfoLabels.PointTo(Viewer.Camera.Position.AsVector,
1715
    Viewer.Camera.Up.AsVector);
1716
  _GZOVisibleInfoLabels.StructureChanged;
1717
  if FAutoZoom then
1718
    D := Viewer.Camera.DistanceTo(SelectedObj) / FAutoZoomFactor
1719
  else
1720
    D := FZoomFactor;
1721
  _GZOrootLines.Scale.AsVector := VectorMake(D, D, D);
1722
  _GZOrootTorus.Scale.AsVector := VectorMake(D, D, D);
1723
  _GZOrootCubes.Scale.AsVector := VectorMake(D, D, D);
1724
  _GZOrootAxisLabel.Scale.AsVector := VectorMake(D, D, D);
1725
  _GZOrootVisibleInfoLabels.Scale.AsVector := VectorMake(D, D, D);
1726
end;
1727

1728
procedure TGLGizmo.UpdateGizmo(const NewDimensions: TVector);
1729
begin
1730
  ObjDimensions := NewDimensions;
1731
  UpdateGizmo;
1732
end;
1733

1734
procedure TGLGizmo.LooseSelection;
1735
begin
1736
  SelectedObj := nil;
1737
  UpdateGizmo;
1738
  if Assigned(OnSelectionLost) then
1739
    OnSelectionLost(Self);
1740
end;
1741

1742
procedure TGLGizmo.SetViewer(const Value: TGLSceneViewer);
1743
begin
1744
  if FViewer <> Value then
1745
  begin
1746
    if FViewer <> nil then
1747
      FViewer.RemoveFreeNotification(Self);
1748
    FViewer := Value;
1749
    if FViewer <> nil then
1750
      FViewer.FreeNotification(Self);
1751
  end;
1752
end;
1753

1754
procedure TGLGizmo.Notification(AComponent: TComponent; Operation: TOperation);
1755
begin
1756
  inherited;
1757
  if Operation = OpRemove then
1758
  begin
1759
    if AComponent = FViewer then
1760
      FViewer := nil;
1761
    if AComponent = FRootGizmo then
1762
      FRootGizmo := nil;
1763
  end;
1764

1765
  if FUndoHistory <> nil then
1766
    FUndoHistory.Notification(AComponent, Operation);
1767
end;
1768

1769
procedure TGLGizmoUndoItem.AssignFromObject(const AObject
1770
  : TGLCustomSceneObject);
1771
begin
1772
  SetEffectedObject(AObject);
1773
  SetOldMatrix(AObject.Matrix);
1774
  if AObject is TGLFreeForm then
1775
  begin
1776
    FOldAutoScaling.Assign(TGLFreeForm(AObject).AutoScaling);
1777
  end;
1778
  FOldLibMaterialName := AObject.Material.LibMaterialName;
1779
end;
1780

1781
constructor TGLGizmoUndoItem.Create(AOwner: TCollection);
1782
begin
1783
  inherited;
1784
  FOldAutoScaling := TGLCoordinates.CreateInitialized(Self,
1785
    NullHmgVector, CsPoint);
1786
end;
1787

1788
destructor TGLGizmoUndoItem.Destroy;
1789
begin
1790
  FOldAutoScaling.Free;
1791
  inherited;
1792
end;
1793

1794
procedure TGLGizmoUndoItem.DoUndo;
1795
begin
1796
  FEffectedObject.Matrix := FOldMatr;
1797
  if FEffectedObject is TGLFreeForm then
1798
    TGLFreeForm(FEffectedObject).AutoScaling.Assign(FOldAutoScaling);
1799
  FEffectedObject.Material.LibMaterialName := FOldLibMaterialName;
1800
end;
1801

1802
function TGLGizmoUndoItem.GetGizmo: TGLGizmo;
1803
begin
1804
  if GetParent <> nil then
1805
    Result := GetPArent.GetParent
1806
  else
1807
    Result := nil;
1808
end;
1809

1810
function TGLGizmoUndoItem.GetParent: TGLGizmoUndoCollection;
1811
begin
1812
  Result := TGLGizmoUndoCollection(GetOwner);
1813
end;
1814

1815
procedure TGLGizmoUndoItem.Notification(AComponent: TComponent;
1816
  Operation: TOperation);
1817
begin
1818
  inherited;
1819
  if Operation = OpRemove then
1820
  begin
1821
    if AComponent = FEffectedObject then
1822
      FEffectedObject := nil;
1823
  end;
1824
end;
1825

1826
procedure TGLGizmoUndoItem.SetEffectedObject(const Value: TGLCustomSceneObject);
1827
begin
1828
  if FEffectedObject <> nil then
1829
    FEffectedObject.RemoveFreeNotification(GetGizmo);
1830
  FEffectedObject := Value;
1831
  if FEffectedObject <> nil then
1832
    FEffectedObject.FreeNotification(GetGizmo);
1833
end;
1834

1835
procedure TGLGizmoUndoItem.SetOldAutoScaling(const Value: TGLCoordinates);
1836
begin
1837
  FOldAutoScaling.Assign(Value);
1838
end;
1839

1840
procedure TGLGizmoUndoItem.SetOldMatrix(const Value: TMatrix);
1841
begin
1842
  FOldMatrix := Value;
1843
end;
1844

1845
{ TGLGizmoUndoCollection }
1846

1847
function TGLGizmoUndoCollection.Add: TGLGizmoUndoItem;
1848
begin
1849
  Result := TGLGizmoUndoItem(inherited Add);
1850
end;
1851

1852
function TGLGizmoUndoCollection.GetItems(const Index: Integer)
1853
  : TGLGizmoUndoItem;
1854
begin
1855
  Result := TGLGizmoUndoItem(inherited GetItem(Index));
1856
end;
1857

1858
function TGLGizmoUndoCollection.GetParent: TGLGizmo;
1859
begin
1860
  Result := TGLGizmo(GetOwner);
1861
end;
1862

1863
procedure TGLGizmoUndoCollection.Notification(AComponent: TComponent;
1864
  Operation: TOperation);
1865
var
1866
  I: Integer;
1867
begin
1868
  if Count <> 0 then
1869
    for I := 0 to Count - 1 do
1870
      GetItems(I).Notification(AComponent, Operation);
1871
end;
1872

1873
procedure TGLGizmoUndoCollection.RemoveByObject(const AObject
1874
  : TGLCustomSceneObject);
1875
var
1876
  I: Integer;
1877
begin
1878
  for I := Count - 1 downto 0 do
1879
    if GetItems(I).FEffectedObject = AObject then
1880
      GetItems(I).Free;
1881
end;
1882

1883
procedure TGLGizmoUndoCollection.SetItems(const Index: Integer;
1884
  const Value: TGLGizmoUndoItem);
1885
begin
1886
  GetItems(Index).Assign(Value);
1887
end;
1888

1889
procedure TGLGizmo.SetSelectedObj(const Value: TGLBaseSceneObject);
1890
begin
1891
  if FSelectedObj <> Value then
1892
  begin
1893
    FSelectedObj := Value;
1894

1895
    if Value <> nil then
1896
    begin
1897
      SetVisible(True);
1898
      UpdateVisibleInfoLabels();
1899
      UpdateGizmo();
1900
    end
1901
    else
1902
    begin
1903
      LooseSelection();
1904
      SetVisible(False);
1905
    end;
1906
  end;
1907
end;
1908

1909
end.
1910