Browse Source

fixed TList type warning with new Delphi versions and added new ShowAxes way to permits more options

silverio.di 1 month ago
parent
commit
c9d92b97b7
1 changed files with 141 additions and 6 deletions
  1. 141 6
      Source/GLS.Scene.pas

+ 141 - 6
Source/GLS.Scene.pas

@@ -53,6 +53,12 @@ uses
   GLS.ImageUtils;
   GLS.ImageUtils;
 
 
 type
 type
+{$IF (CompilerVersion >= 36)}
+  TListSize = NativeInt;
+{$ELSE}
+  TListSize = Integer;
+{$ENDIF}
+
   // Defines which features are taken from the master object.
   // Defines which features are taken from the master object.
   TGLProxyObjectOption = (pooEffects, pooObjects, pooTransformation);
   TGLProxyObjectOption = (pooEffects, pooObjects, pooTransformation);
   TGLProxyObjectOptions = set of TGLProxyObjectOption;
   TGLProxyObjectOptions = set of TGLProxyObjectOption;
@@ -138,11 +144,24 @@ type
   // Just a list of objects that support IGLInitializable.
   // Just a list of objects that support IGLInitializable.
   TGLInitializableObjectList = class(TList)
   TGLInitializableObjectList = class(TList)
   private
   private
-    function GetItems(const Index: Integer): IGLInitializable;
-    procedure PutItems(const Index: Integer; const Value: IGLInitializable);
+    function GetItems(const Index: TListSize): IGLInitializable;
+    procedure PutItems(const Index: TListSize; const Value: IGLInitializable);
   public
   public
     function Add(const Item: IGLInitializable): Integer;
     function Add(const Item: IGLInitializable): Integer;
-    property Items[const Index: Integer]: IGLInitializable read GetItems write PutItems; default;
+    property Items[const Index: TListSize]: IGLInitializable read GetItems write PutItems; default;
+  end;
+
+  PGLAxisInfo = ^TGLAxisInfo;
+  TGLAxisInfo = record
+    Visible: Boolean;
+    Pattern: Word;
+    ColorMax: TColor;
+    ColorMin: TColor;
+    BoundMax: Single;
+    BoundMin: Single;
+    LineWidth: Single;
+    procedure Assign(Source: PGLAxisInfo);
+    procedure Init(AVisible: Boolean; APattern: Word; AColorMax, AColorMin: TColor; ABoundMax, ABoundMin, ALineWidth: Single);
   end;
   end;
 
 
   (* Base class for all scene objects.
   (* Base class for all scene objects.
@@ -158,6 +177,15 @@ type
      other children manipulations methods and properties are provided (to browse,
      other children manipulations methods and properties are provided (to browse,
      move and delete them). Using the regular TComponent methods is not encouraged *)
      move and delete them). Using the regular TComponent methods is not encouraged *)
   TGLBaseSceneObject = class(TGLCoordinatesUpdateAbleComponent)
   TGLBaseSceneObject = class(TGLCoordinatesUpdateAbleComponent)
+  private
+    FXAxisInfo: TGLAxisInfo;
+    FYAxisInfo: TGLAxisInfo;
+    FZAxisInfo: TGLAxisInfo;
+    function GetAxisInfo(AxisID: Integer): PGLAxisInfo;
+  protected
+    procedure DrawAxis(axis: Integer; var rci: TGLRenderContextInfo);
+  public
+    property AxisInfo[AxisID: Integer]: PGLAxisInfo read GetAxisInfo;
   private
   private
     FAbsoluteMatrix, FInvAbsoluteMatrix: TGLMatrix;
     FAbsoluteMatrix, FInvAbsoluteMatrix: TGLMatrix;
     FLocalMatrix: TGLMatrix;
     FLocalMatrix: TGLMatrix;
@@ -1874,6 +1902,11 @@ end;
 constructor TGLBaseSceneObject.Create(AOwner: TComponent);
 constructor TGLBaseSceneObject.Create(AOwner: TComponent);
 begin
 begin
   inherited Create(AOwner);
   inherited Create(AOwner);
+
+  FXAxisInfo.Init(False, $CCCC, $000000FF, $0000007F, System.Math.NaN, System.Math.NaN, 1.0);
+  FYAxisInfo.Init(False, $CCCC, $0000FF00, $00007F00, System.Math.NaN, System.Math.NaN, 1.0);
+  FZAxisInfo.Init(False, $CCCC, $00FF0000, $007F0000, System.Math.NaN, System.Math.NaN, 1.0);
+
   FListHandle := TGLListHandle.Create;
   FListHandle := TGLListHandle.Create;
   FObjectStyle := [];
   FObjectStyle := [];
   FChanges := [ocTransformation, ocStructure,
   FChanges := [ocTransformation, ocStructure,
@@ -2779,6 +2812,9 @@ begin
     TGLBaseSceneObject(Source).RebuildMatrix;
     TGLBaseSceneObject(Source).RebuildMatrix;
     SetMatrix(TGLBaseSceneObject(Source).FLocalMatrix);
     SetMatrix(TGLBaseSceneObject(Source).FLocalMatrix);
     FShowAxes := TGLBaseSceneObject(Source).FShowAxes;
     FShowAxes := TGLBaseSceneObject(Source).FShowAxes;
+    FXAxisInfo.Assign(@TGLBaseSceneObject(Source).FXAxisInfo);
+    FYAxisInfo.Assign(@TGLBaseSceneObject(Source).FYAxisInfo);
+    FZAxisInfo.Assign(@TGLBaseSceneObject(Source).FZAxisInfo);
     FObjectsSorting := TGLBaseSceneObject(Source).FObjectsSorting;
     FObjectsSorting := TGLBaseSceneObject(Source).FObjectsSorting;
     FVisibilityCulling := TGLBaseSceneObject(Source).FVisibilityCulling;
     FVisibilityCulling := TGLBaseSceneObject(Source).FVisibilityCulling;
     FRotation.Assign(TGLBaseSceneObject(Source).FRotation);
     FRotation.Assign(TGLBaseSceneObject(Source).FRotation);
@@ -3669,7 +3705,13 @@ begin
     vCurrentRenderingObject := Self;
     vCurrentRenderingObject := Self;
 {$IFNDEF USE_OPTIMIZATIONS}
 {$IFNDEF USE_OPTIMIZATIONS}
     if FShowAxes then
     if FShowAxes then
-      DrawAxes(ARci, $CCCC);
+      DrawAxes(ARci, $CCCC)
+    else
+    begin
+      if FXAxisInfo.Visible then DrawAxis(0, ARci);
+      if FYAxisInfo.Visible then DrawAxis(1, ARci);
+      if FZAxisInfo.Visible then DrawAxis(2, ARci);
+    end;
 {$ENDIF}
 {$ENDIF}
     if Assigned(FEffects) and (FEffects.Count > 0) then
     if Assigned(FEffects) and (FEffects.Count > 0) then
     begin
     begin
@@ -7979,18 +8021,111 @@ begin
 end;
 end;
 
 
 function TGLInitializableObjectList.GetItems(
 function TGLInitializableObjectList.GetItems(
-  const Index: Integer): IGLInitializable;
+  const Index: TListSize): IGLInitializable;
 begin
 begin
   Result := IGLInitializable(inherited Get(Index));
   Result := IGLInitializable(inherited Get(Index));
 end;
 end;
 
 
-procedure TGLInitializableObjectList.PutItems(const Index: Integer;
+procedure TGLInitializableObjectList.PutItems(const Index: TListSize;
   const Value: IGLInitializable);
   const Value: IGLInitializable);
 begin
 begin
   inherited Put(Index, Pointer(Value));
   inherited Put(Index, Pointer(Value));
 end;
 end;
 
 
 //------------------------------------------------------------------------------
 //------------------------------------------------------------------------------
+
+{ TGLAxisInfo }
+
+procedure TGLAxisInfo.Assign(Source: PGLAxisInfo);
+begin
+  Visible := Source.Visible;
+  Pattern := Source.Pattern;
+  ColorMax := Source.ColorMax;
+  ColorMin := Source.ColorMin;
+  BoundMax := Source.BoundMax;
+  BoundMin := Source.BoundMin;
+  LineWidth := Source.LineWidth;
+end;
+
+procedure TGLAxisInfo.Init(AVisible: Boolean; APattern: Word; AColorMax, AColorMin: TColor; ABoundMax, ABoundMin, ALineWidth: Single);
+begin
+  Visible := AVisible;
+  Pattern := APattern;
+  ColorMax := AColorMax;
+  ColorMin := AColorMin;
+  BoundMax := ABoundMax;
+  BoundMin := ABoundMin;
+  LineWidth := ALineWidth;
+end;
+
+procedure TGLBaseSceneObject.DrawAxis(axis: Integer; var rci: TGLRenderContextInfo);
+var
+  AxisLenMax: Single;
+  AxisLenMin: Single;
+  AxisInfo: PGLAxisInfo;
+  ColorMax: TGLColorVector;
+  ColorMin: TGLColorVector;
+begin
+  AxisInfo := GetAxisInfo(Axis);
+  if AxisInfo = nil then Exit;
+
+  if IsNan(AxisInfo.BoundMax) then
+    AxisLenMax := FScene.CurrentBuffer.FCamera.FDepthOfView
+  else
+    AxisLenMax := AxisInfo.BoundMax;
+
+  if IsNan(AxisInfo.BoundMin) then
+    AxisLenMin := -FScene.CurrentBuffer.FCamera.FDepthOfView
+  else
+    AxisLenMin := AxisInfo.BoundMin;
+
+  ColorMax := ConvertWinColor(AxisInfo.ColorMax);
+  ColorMin := ConvertWinColor(AxisInfo.ColorMin);
+
+  glPushAttrib(GL_ENABLE_BIT or GL_LIGHTING_BIT or GL_LINE_BIT);
+  glDisable(GL_LIGHTING);
+  glEnable(GL_LINE_STIPPLE);
+  if not rci.ignoreBlendingRequests then begin
+    glEnable(GL_BLEND);
+    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+  end;
+  glLineWidth(AxisInfo.LineWidth);
+  glLineStipple(1, AxisInfo.Pattern);
+  glBegin(GL_LINES);
+  if axis = 0 then
+  begin
+    glColor3f(ColorMin.X, ColorMin.Y, ColorMin.Z); glVertex3f(0, 0, 0); glVertex3f(AxisLenMin, 0, 0);
+    glColor3f(ColorMax.X, ColorMax.Y, ColorMax.Z); glVertex3f(0, 0, 0); glVertex3f(AxisLenMax, 0, 0);
+  end;
+  if axis = 1 then
+  begin
+    glColor3f(ColorMin.X, ColorMin.Y, ColorMin.Z); glVertex3f(0, 0, 0); glVertex3f(0, AxisLenMin, 0);
+    glColor3f(ColorMax.X, ColorMax.Y, ColorMax.Z); glVertex3f(0, 0, 0); glVertex3f(0, AxisLenMax, 0);
+  end;
+  if axis = 2 then
+  begin
+    glColor3f(ColorMin.X, ColorMin.Y, ColorMin.Z); glVertex3f(0, 0, 0); glVertex3f(0, 0, AxisLenMin);
+    glColor3f(ColorMax.X, ColorMax.Y, ColorMax.Z); glVertex3f(0, 0, 0); glVertex3f(0, 0, AxisLenMax);
+  end;
+  glEnd;
+  glPopAttrib;
+  // clear fpu exception flag (sometime raised by the call to glEnd)
+{$IFDEF CPUX86}
+  asm fclex end;
+{$ENDIF}
+end;
+
+function TGLBaseSceneObject.GetAxisInfo(AxisID: Integer): PGLAxisInfo;
+begin
+  case AxisID of
+    0: Result := @FXAxisInfo;
+    1: Result := @FYAxisInfo;
+    2: Result := @FZAxisInfo;
+    else
+      Result := nil;
+  end;
+end;
+
 initialization
 initialization
 //------------------------------------------------------------------------------
 //------------------------------------------------------------------------------