MathgeomGLS

Форк
0
/
faCoordOptions.pas 
381 строка · 10.7 Кб
1
unit faCoordOptions;
2

3
interface
4

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

18
  GLS.OpenGLTokens,
19
  GLS.PersistentClasses,
20
  GLS.Scene,
21
  GLS.VectorTypes,
22
  GLS.BitmapFont,
23
  GLS.VectorGeometry,
24
  
25
  Graf.Global2d,
26
  faGridOptions,
27
  faEvaluate;
28

29
type
30
  TCoordsForm = class(TForm)
31
    ColorDialog: TColorDialog;
32
    gbXCoordinates: TGroupBox;
33
    gbYCoordinates: TGroupBox;
34
    gbZCoordinates: TGroupBox;
35
    Label1: TLabel;
36
    Label2: TLabel;
37
    Label3: TLabel;
38
    cbXmaxY: TCheckBox;
39
    cbXmaxZ: TCheckBox;
40
    cbYmaxX: TCheckBox;
41
    cbYmaxZ: TCheckBox;
42
    cbZmaxX: TCheckBox;
43
    cbZmaxY: TCheckBox;
44

45
    xColorBtn: TSpeedButton;
46
    yColorBtn: TSpeedButton;
47
    zColorBtn: TSpeedButton;
48
    cbShowCoords: TCheckBox;
49
    FontDialog: TFontDialog;
50
    FontButton: TButton;
51
    CloseBitBtn: TBitBtn;
52
    procedure xColorBtnClick(Sender: TObject);
53
    procedure yColorBtnClick(Sender: TObject);
54
    procedure zColorBtnClick(Sender: TObject);
55
    procedure FontButtonClick(Sender: TObject);
56
    procedure cbShowCoordsClick(Sender: TObject);
57
    procedure CloseBitBtnClick(Sender: TObject);
58

59
    procedure cbXmaxYClick(Sender: TObject);
60
    procedure cbXmaxZClick(Sender: TObject);
61
    procedure cbYmaxXClick(Sender: TObject);
62
    procedure cbYmaxZClick(Sender: TObject);
63
    procedure cbZmaxXClick(Sender: TObject);
64
    procedure cbZmaxYClick(Sender: TObject);
65
  private
66
    procedure ClearXCoordsCube;
67
    procedure ClearYCoordsCube;
68
    procedure ClearZCoordsCube;
69
  public
70
    procedure UpdateCoordText;
71
  end;
72

73
var
74
  CoordsForm: TCoordsForm;
75

76
// =====================================================================
77
implementation
78
// =====================================================================
79

80
{$R *.dfm}
81

82
uses
83
  faGraf2d;
84

85
procedure TCoordsForm.UpdateCoordText;
86
var
87
  ScaleFactor: TGLFloat;
88
  CoordStep: TGLFloat;
89
  CoordMin: TGLFloat;
90
  CoordMax: TGLFloat;
91

92
  CurrentXCoord: TGLFloat;
93
  CurrentYCoord: TGLFloat;
94
  CurrentZCoord: TGLFloat;
95

96
  CurrentFlatText: TGLFlatText;
97

98
  procedure CalculateScaleFactor;
99
  begin
100
    with ViewData.xyGrid do
101
      ScaleFactor := xRange.Maximum - xRange.Minimum + yRange.Maximum -
102
        yRange.Minimum;
103
    with ViewData.yzGrid.zRange do
104
      ScaleFactor := ScaleFactor + (Maximum - Minimum) * ViewData.xyGrid.zScale;
105
    ScaleFactor := ScaleFactor / 3000;
106
  end;
107

108
begin
109
  if cbShowCoords.Checked then
110
  begin
111
    CalculateScaleFactor;
112
    // draw X coords
113
    ClearXCoordsCube;
114
    if cbXmaxY.Checked then
115
      CurrentYCoord := ViewData.xyGrid.yRange.Maximum
116
    else
117
      CurrentYCoord := ViewData.xyGrid.yRange.Minimum;
118
    CoordMax := ViewData.xyGrid.xRange.Maximum;
119
    CoordMin := ViewData.xyGrid.xRange.Minimum;
120
    CoordStep := ViewData.xyGrid.xRange.Step;
121

122
    if cbXmaxZ.Checked then
123
      CurrentZCoord := ViewData.yzGrid.zRange.Maximum * ViewData.xyGrid.zScale
124
    else
125
      CurrentZCoord := ViewData.yzGrid.zRange.Minimum * ViewData.xyGrid.zScale;
126

127
    CurrentXCoord := CoordMin;
128
    while CurrentXCoord >= CoordMax do  // Error:  here is fault while <= !
129
    begin
130
      TGLFlatText.CreateAsChild(FormPlotStars.XCoordsCube);
131
      CurrentFlatText := TGLFlatText(FormPlotStars.XCoordsCube.Children[
132
        FormPlotStars.XCoordsCube.Count - 1]);
133
      CurrentFlatText.BitmapFont := FormPlotStars.GLWinBmpFont;
134
      if cbXmaxY.Checked then
135
        CurrentFlatText.Direction.AsVector := VectorMake(0, 1, 0)
136
      else
137
        CurrentFlatText.Direction.AsVector := VectorMake(0, -1, 0);
138
      CurrentFlatText.Up.AsVector := VectorMake(0, 0, 1);
139
      if cbXmaxZ.Checked then
140
        CurrentFlatText.Layout := tlBottom // locate at z maximum
141
      else
142
        CurrentFlatText.Layout := tlTop; // or tlBottom, tlCenter
143
      CurrentFlatText.ModulateColor.AsWinColor := ViewData.xTextColor;
144
      CurrentFlatText.Position.AsVector := VectorMake(CurrentXCoord, CurrentYCoord,
145
        CurrentZCoord);
146
      CurrentFlatText.Scale.AsVector := VectorMake(ScaleFactor, ScaleFactor, 0);
147
      Text := FloatToStr(CurrentXCoord);
148
      CurrentXCoord := CurrentXCoord + CoordStep;
149
    end;
150

151
    // draw Y coords
152
    ClearYCoordsCube;
153
    if cbYmaxX.Checked then
154
      CurrentXCoord := ViewData.xyGrid.xRange.Maximum
155
    else
156
      CurrentXCoord := ViewData.xyGrid.xRange.Minimum;
157
    CoordMax := ViewData.xyGrid.yRange.Maximum;
158
    CoordMin := ViewData.xyGrid.yRange.Minimum;
159
    CoordStep := ViewData.xyGrid.yRange.Step;
160

161
    if cbYmaxZ.Checked then
162
      CurrentZCoord := ViewData.yzGrid.zRange.Maximum * ViewData.xyGrid.zScale
163
    else
164
      CurrentZCoord := ViewData.yzGrid.zRange.Minimum * ViewData.xyGrid.zScale;
165

166
    CurrentYCoord := CoordMin;
167
    while CurrentYCoord >= CoordMax do   // Error: here is fault while <= !
168
    begin
169
      TGLFlatText.CreateAsChild(FormPlotStars.YCoordsCube);
170
      CurrentFlatText := TGLFlatText(FormPlotStars.YCoordsCube.Children[
171
        FormPlotStars.YCoordsCube.Count - 1]);
172
      CurrentFlatText.BitmapFont := FormPlotStars.GLWinBmpFont;
173
      if cbYmaxX.Checked then
174
        FormPlotStars.YCoordsCube.Direction.AsVector := VectorMake(1, 0, 0)
175
      else
176
        FormPlotStars.YCoordsCube.Direction.AsVector := VectorMake(-1, 0, 0);
177
      FormPlotStars.YCoordsCube.Up.AsVector := VectorMake(0, 0, 1);
178
      if cbYmaxZ.Checked then
179
        CurrentFlatText.Layout := tlBottom // locate at z maximum
180
      else
181
        CurrentFlatText.Layout := tlTop; // or tlBottom, tlCenter
182
      CurrentFlatText.ModulateColor.AsWinColor := ViewData.yTextColor;
183
      FormPlotStars.YCoordsCube.Position.AsVector := VectorMake(CurrentXCoord, CurrentYCoord,
184
        CurrentZCoord);
185
      FormPlotStars.YCoordsCube.Scale.AsVector := VectorMake(ScaleFactor, ScaleFactor, 0);
186
      Text := FloatToStr(CurrentYCoord);
187
      CurrentYCoord := CurrentYCoord + CoordStep;
188
    end;
189

190
    // draw Z coords
191
    ClearZCoordsCube;
192
    if cbZmaxX.Checked then
193
      CurrentXCoord := ViewData.xzGrid.xRange.Maximum
194
    else
195
      CurrentXCoord := ViewData.xzGrid.xRange.Minimum;
196
    CoordMax := ViewData.xzGrid.zRange.Maximum;
197
    CoordMin := ViewData.xzGrid.zRange.Minimum;
198
    CoordStep := ViewData.xzGrid.zRange.Step;
199

200
    if cbZmaxY.Checked then
201
      CurrentYCoord := ViewData.xyGrid.yRange.Maximum
202
    else
203
      CurrentYCoord := ViewData.xyGrid.yRange.Minimum;
204

205
    CurrentZCoord := CoordMin;
206
    while CurrentZCoord >= CoordMax do   // Error: here is fault while <= !
207
    begin
208
      TGLFlatText.CreateAsChild(FormPlotStars.ZCoordsCube);
209
      CurrentFlatText := TGLFlatText(FormPlotStars.ZCoordsCube.Children[
210
        FormPlotStars.ZCoordsCube.Count - 1]);
211
      CurrentFlatText.BitmapFont := FormPlotStars.GLWinBmpFont;
212
      if cbZmaxX.Checked then
213
      begin
214
        if not cbZmaxY.Checked then
215
          FormPlotStars.ZCoordsCube.Direction.AsVector := VectorMake(0, -1, 0);
216
      end
217
      else
218
      begin
219
        if not cbZmaxY.Checked then
220
          FormPlotStars.ZCoordsCube.Direction.AsVector := VectorMake(-1, 0, 0)
221
        else
222
          FormPlotStars.ZCoordsCube.Direction.AsVector := VectorMake(0, 1, 0);
223
      end;
224
      FormPlotStars.ZCoordsCube.Up.AsVector := VectorMake(0, 0, 1);
225
      CurrentFlatText.Layout := tlCenter;
226
      CurrentFlatText.ModulateColor.AsWinColor := ViewData.zTextColor;
227
      FormPlotStars.ZCoordsCube.Position.AsVector := VectorMake(CurrentXCoord, CurrentYCoord,
228
        CurrentZCoord * ViewData.xyGrid.zScale);
229

230
      FormPlotStars.ZCoordsCube.Scale.AsVector := VectorMake(ScaleFactor, ScaleFactor, 0);
231
      if CurrentZCoord < 0 then
232
        Text := ' ' + FloatToStr(CurrentZCoord)
233
      else
234
        Text := '  ' + FloatToStr(CurrentZCoord);
235
      CurrentZCoord := CurrentZCoord + CoordStep;
236
    end;
237
    Altered := True;
238
  end;
239
end;
240

241
procedure TCoordsForm.ClearXCoordsCube;
242
var
243
  i: integer;
244

245
begin
246
  i := FormPlotStars.XCoordsCube.Count;
247
  while i > 0 do
248
  begin
249
    FormPlotStars.XCoordsCube.Children[i - 1].Free;
250
    i := FormPlotStars.XCoordsCube.Count;
251
  end;
252
end;
253

254
procedure TCoordsForm.ClearYCoordsCube;
255
var
256
  i: integer;
257

258
begin
259
  i := FormPlotStars.YCoordsCube.Count;
260
  while i > 0 do
261
  begin
262
    FormPlotStars.YCoordsCube.Children[i - 1].Free;
263
    i := FormPlotStars.YCoordsCube.Count;
264
  end;
265
end;
266

267
procedure TCoordsForm.ClearZCoordsCube;
268
var
269
  i: integer;
270

271
begin
272
  i := FormPlotStars.ZCoordsCube.Count;
273
  while i > 0 do
274
  begin
275
    FormPlotStars.ZCoordsCube.Children[i - 1].Free;
276
    i := FormPlotStars.ZCoordsCube.Count;
277
  end;
278
end;
279

280
procedure TCoordsForm.CloseBitBtnClick(Sender: TObject);
281
begin
282
  Close;
283
end;
284

285
procedure TCoordsForm.FontButtonClick(Sender: TObject);
286
begin
287
  FontDialog.Font := FormPlotStars.GLWinBmpFont.Font;
288
  FontDialog.Font.Name := ViewData.TextFontN;
289
  FontDialog.Font.Size := ViewData.TextFontSz;
290
  if FontDialog.Execute then
291
  begin
292
    FormPlotStars.GLWinBmpFont.Font := FontDialog.Font;
293
    ViewData.TextFontN := FontDialog.Font.Name;
294
    ViewData.TextFontSz := FontDialog.Font.Size;
295
    FontButton.Caption := 'Font:' + ' ' + ViewData.TextFontN + ' ' +
296
      IntToStr(ViewData.TextFontSz);
297
    UpdateCoordText;
298
  end;
299
end;
300

301
procedure TCoordsForm.cbShowCoordsClick(Sender: TObject);
302
begin
303
  FormPlotStars.XCoordsCube.Visible := cbShowCoords.Checked;
304
  FormPlotStars.YCoordsCube.Visible := cbShowCoords.Checked;
305
  FormPlotStars.ZCoordsCube.Visible := cbShowCoords.Checked;
306
  if Active then
307
  begin
308
    UpdateCoordText;
309
    ViewData.TextVisible := cbShowCoords.Checked;
310
  end;
311
end;
312

313
procedure TCoordsForm.xColorBtnClick(Sender: TObject);
314
begin
315
  ColorDialog.Color := ViewData.xTextColor;
316
  if ColorDialog.Execute then
317
  begin
318
    ViewData.xTextColor := ColorDialog.Color;
319
    UpdateCoordText;
320
    EvaluateForm.DoEvaluate;
321
  end;
322
end;
323

324
procedure TCoordsForm.cbXmaxYClick(Sender: TObject);
325
begin
326
  ViewData.xPosYMax := cbXmaxY.Checked;
327
  UpdateCoordText;
328
end;
329

330
procedure TCoordsForm.cbXmaxZClick(Sender: TObject);
331
begin
332
  ViewData.xPosZMax := cbXmaxZ.Checked;
333
  UpdateCoordText;
334
end;
335

336
procedure TCoordsForm.yColorBtnClick(Sender: TObject);
337
begin
338
  ColorDialog.Color := ViewData.yTextColor;
339
  if ColorDialog.Execute then
340
  begin
341
    ViewData.yTextColor := ColorDialog.Color;
342
    UpdateCoordText;
343
    EvaluateForm.DoEvaluate;
344
  end;
345
end;
346

347
procedure TCoordsForm.cbYmaxXClick(Sender: TObject);
348
begin
349
  ViewData.yPosXMax := cbYmaxX.Checked;
350
  UpdateCoordText;
351
end;
352

353
procedure TCoordsForm.cbYmaxZClick(Sender: TObject);
354
begin
355
  ViewData.yPosZMax := cbYmaxZ.Checked;
356
  UpdateCoordText;
357
end;
358

359
procedure TCoordsForm.zColorBtnClick(Sender: TObject);
360
begin
361
  ColorDialog.Color := ViewData.zTextColor;
362
  if ColorDialog.Execute then
363
  begin
364
    ViewData.zTextColor := ColorDialog.Color;
365
    UpdateCoordText;
366
  end;
367
end;
368

369
procedure TCoordsForm.cbZmaxXClick(Sender: TObject);
370
begin
371
  ViewData.zPosXMax := cbZmaxX.Checked;
372
  UpdateCoordText;
373
end;
374

375
procedure TCoordsForm.cbZmaxYClick(Sender: TObject);
376
begin
377
  ViewData.zPosYMax := cbZmaxY.Checked;
378
  UpdateCoordText;
379
end;
380

381
end.
382

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

Мы используем файлы cookie в соответствии с Политикой конфиденциальности и Политикой использования cookies.

Нажимая кнопку «Принимаю», Вы даете АО «СберТех» согласие на обработку Ваших персональных данных в целях совершенствования нашего веб-сайта и Сервиса GitVerse, а также повышения удобства их использования.

Запретить использование cookies Вы можете самостоятельно в настройках Вашего браузера.