MathgeomGLS

1
unit fCirclein3D;
2

3
interface
4

5
uses
6
  Winapi.Windows,
7
  Winapi.Messages,
8
  System.SysUtils,
9
  System.Variants,
10
  System.Classes,
11
  System.Math,
12
  Vcl.Graphics,
13
  Vcl.Controls,
14
  Vcl.Forms,
15
  Vcl.Dialogs,
16
  Vcl.ComCtrls,
17

18
  GLS.Objects,
19
  GLS.Scene,
20
  Vcl.StdCtrls,
21
  GLS.SceneViewer,
22
  GLS.Coordinates,
23
  GLS.BaseClasses,
24
  GLS.SimpleNavigation;
25

26
type
27
  TForm1 = class(TForm)
28
    GLScene1: TGLScene;
29
    GLSceneViewer1: TGLSceneViewer;
30
    sbSegments: TScrollBar;
31
    Label1: TLabel;
32
    Camera: TGLCamera;
33
    LightSource: TGLLightSource;
34
    dcMeridian: TGLDummyCube;
35
    Meridian: TGLLines;
36
    Label2: TLabel;
37
    sbWidth: TScrollBar;
38
    Label3: TLabel;
39
    sbHeight: TScrollBar;
40
    Label4: TLabel;
41
    ScrollBar4: TScrollBar;
42
    chbSpline: TCheckBox;
43
    GLSimpleNavigation1: TGLSimpleNavigation;
44
    chbNodes: TCheckBox;
45
    chbDash: TCheckBox;
46
    Parallel: TGLLines;
47
    StatusBar1: TStatusBar;
48
    dcParallel: TGLDummyCube;
49
    dcGeogrid: TGLDummyCube;
50
    Merid1: TGLLines;
51
    Paral1: TGLLines;
52
    Sphere: TGLSphere;
53
    procedure chbSplineClick(Sender: TObject);
54
    procedure sbCircleChange(Sender: TObject);
55
    procedure FormCreate(Sender: TObject);
56
    procedure chbNodesClick(Sender: TObject);
57
    procedure chbDashClick(Sender: TObject);
58
  private
59
  public
60
    procedure BuildParallels;
61
    procedure BuildOrbit;
62
  end;
63

64
var
65
  Form1: TForm1;
66

67
implementation
68

69
{$R *.dfm}
70
{ TForm1 }
71

72
// ---------------------------------------------------------------------------
73
procedure TForm1.BuildParallels;
74
var
75
  A, B: Double;
76
  I, Segments: Integer;
77
  RotationAngle, theta: Double;
78
  x, y, xCenter, xRotated: Double;
79
  yCenter, yRotated: Double;
80

81
begin
82
  Segments := sbSegments.Position;
83
  A := sbWidth.Position / 100;
84
  B := sbHeight.Position / 100;
85
  RotationAngle := DegToRad(ScrollBar4.Position);
86

87
  Meridian.Nodes.Clear;
88

89
  xCenter := 0;
90
  yCenter := 0;
91
  for I := 0 to Segments do
92
  begin
93
    theta := 360 * (I / Segments) * (PI / 180);
94

95
    x := xCenter + A * Cos(theta);
96
    y := yCenter + B * Sin(theta);
97
    xRotated := xCenter + (x - xCenter) * Cos(RotationAngle) - (y - yCenter) *
98
      Sin(RotationAngle);
99
    yRotated := yCenter + (x - xCenter) * Sin(RotationAngle) + (y - yCenter) *
100
      Cos(RotationAngle);
101

102
    Meridian.Nodes.AddNode(xRotated, 0, yRotated);
103
    // Meridian.PitchAngle := 90;
104
  end;
105
end;
106

107
// ---------------------------------------------------------------------------
108
procedure TForm1.BuildOrbit;
109
var
110
  A, B: Double;
111
  I: Integer;
112
  theta: Double;
113
  x, y, xCenter, xRotated: Double;
114
  yCenter, yRotated: Double;
115

116
const
117
  Segments = 32;
118
  circleWidth = 1;
119
  circleHeight = 1;
120
  RotationAngle = 0;
121

122
begin
123
  A := circleWidth;
124
  B := circleHeight;
125

126
  Parallel.Nodes.Clear;
127

128
  xCenter := 0;
129
  yCenter := 0;
130
  for I := 0 to Segments do
131
  begin
132
    theta := 360 * (I / Segments) * (PI / 180);
133

134
    x := xCenter + A * Cos(theta);
135
    y := yCenter + B * Sin(theta);
136
    xRotated := xCenter + (x - xCenter) * Cos(RotationAngle) - (y - yCenter) *
137
      Sin(RotationAngle);
138
    yRotated := yCenter + (x - xCenter) * Sin(RotationAngle) + (y - yCenter) *
139
      Cos(RotationAngle);
140

141
    Parallel.Nodes.AddNode(xRotated, 0, yRotated);
142
    Parallel.PitchAngle := 90;
143
  end;
144
end;
145

146
// ---------------------------------------------------------------------------
147
procedure TForm1.FormCreate(Sender: TObject);
148
begin
149
  BuildParallels;
150
  BuildOrbit;
151
end;
152

153
// ---------------------------------------------------------------------------
154
procedure TForm1.sbCircleChange(Sender: TObject);
155
begin
156
  BuildParallels;
157
end;
158

159
// ---------------------------------------------------------------------------
160
procedure TForm1.chbNodesClick(Sender: TObject);
161
begin
162
  if chbNodes.Checked then
163
  begin
164
    Meridian.NodesAspect := lnaCube;
165
    Meridian.NodeSize := 0.05;
166
  end
167
  else
168
  begin
169
    Meridian.NodesAspect := lnaInvisible;
170
    Meridian.NodeSize := 0.005;
171
  end;
172
end;
173

174
// ========================================================================
175
procedure TForm1.chbSplineClick(Sender: TObject);
176
begin
177
  if chbSpline.Checked then
178
    Meridian.SplineMode := lsmCubicSpline
179
  else
180
    Meridian.SplineMode := lsmLines;
181
end;
182

183
procedure TForm1.chbDashClick(Sender: TObject);
184
begin
185
  if chbDash.Checked then
186
    Meridian.SplineMode := lsmSegments
187
  else
188
    Meridian.SplineMode := lsmLines;
189
end;
190

191
end.
192