MathgeomGLS
381 строка · 10.7 Кб
1unit faCoordOptions;
2
3interface
4
5uses
6Winapi.Windows,
7Winapi.Messages,
8System.SysUtils,
9System.Variants,
10System.Classes,
11Vcl.Graphics,
12Vcl.Controls,
13Vcl.Forms,
14Vcl.Dialogs,
15Vcl.Buttons,
16Vcl.StdCtrls,
17
18GLS.OpenGLTokens,
19GLS.PersistentClasses,
20GLS.Scene,
21GLS.VectorTypes,
22GLS.BitmapFont,
23GLS.VectorGeometry,
24
25Graf.Global2d,
26faGridOptions,
27faEvaluate;
28
29type
30TCoordsForm = class(TForm)
31ColorDialog: TColorDialog;
32gbXCoordinates: TGroupBox;
33gbYCoordinates: TGroupBox;
34gbZCoordinates: TGroupBox;
35Label1: TLabel;
36Label2: TLabel;
37Label3: TLabel;
38cbXmaxY: TCheckBox;
39cbXmaxZ: TCheckBox;
40cbYmaxX: TCheckBox;
41cbYmaxZ: TCheckBox;
42cbZmaxX: TCheckBox;
43cbZmaxY: TCheckBox;
44
45xColorBtn: TSpeedButton;
46yColorBtn: TSpeedButton;
47zColorBtn: TSpeedButton;
48cbShowCoords: TCheckBox;
49FontDialog: TFontDialog;
50FontButton: TButton;
51CloseBitBtn: TBitBtn;
52procedure xColorBtnClick(Sender: TObject);
53procedure yColorBtnClick(Sender: TObject);
54procedure zColorBtnClick(Sender: TObject);
55procedure FontButtonClick(Sender: TObject);
56procedure cbShowCoordsClick(Sender: TObject);
57procedure CloseBitBtnClick(Sender: TObject);
58
59procedure cbXmaxYClick(Sender: TObject);
60procedure cbXmaxZClick(Sender: TObject);
61procedure cbYmaxXClick(Sender: TObject);
62procedure cbYmaxZClick(Sender: TObject);
63procedure cbZmaxXClick(Sender: TObject);
64procedure cbZmaxYClick(Sender: TObject);
65private
66procedure ClearXCoordsCube;
67procedure ClearYCoordsCube;
68procedure ClearZCoordsCube;
69public
70procedure UpdateCoordText;
71end;
72
73var
74CoordsForm: TCoordsForm;
75
76// =====================================================================
77implementation
78// =====================================================================
79
80{$R *.dfm}
81
82uses
83faGraf2d;
84
85procedure TCoordsForm.UpdateCoordText;
86var
87ScaleFactor: TGLFloat;
88CoordStep: TGLFloat;
89CoordMin: TGLFloat;
90CoordMax: TGLFloat;
91
92CurrentXCoord: TGLFloat;
93CurrentYCoord: TGLFloat;
94CurrentZCoord: TGLFloat;
95
96CurrentFlatText: TGLFlatText;
97
98procedure CalculateScaleFactor;
99begin
100with ViewData.xyGrid do
101ScaleFactor := xRange.Maximum - xRange.Minimum + yRange.Maximum -
102yRange.Minimum;
103with ViewData.yzGrid.zRange do
104ScaleFactor := ScaleFactor + (Maximum - Minimum) * ViewData.xyGrid.zScale;
105ScaleFactor := ScaleFactor / 3000;
106end;
107
108begin
109if cbShowCoords.Checked then
110begin
111CalculateScaleFactor;
112// draw X coords
113ClearXCoordsCube;
114if cbXmaxY.Checked then
115CurrentYCoord := ViewData.xyGrid.yRange.Maximum
116else
117CurrentYCoord := ViewData.xyGrid.yRange.Minimum;
118CoordMax := ViewData.xyGrid.xRange.Maximum;
119CoordMin := ViewData.xyGrid.xRange.Minimum;
120CoordStep := ViewData.xyGrid.xRange.Step;
121
122if cbXmaxZ.Checked then
123CurrentZCoord := ViewData.yzGrid.zRange.Maximum * ViewData.xyGrid.zScale
124else
125CurrentZCoord := ViewData.yzGrid.zRange.Minimum * ViewData.xyGrid.zScale;
126
127CurrentXCoord := CoordMin;
128while CurrentXCoord >= CoordMax do // Error: here is fault while <= !
129begin
130TGLFlatText.CreateAsChild(FormPlotStars.XCoordsCube);
131CurrentFlatText := TGLFlatText(FormPlotStars.XCoordsCube.Children[
132FormPlotStars.XCoordsCube.Count - 1]);
133CurrentFlatText.BitmapFont := FormPlotStars.GLWinBmpFont;
134if cbXmaxY.Checked then
135CurrentFlatText.Direction.AsVector := VectorMake(0, 1, 0)
136else
137CurrentFlatText.Direction.AsVector := VectorMake(0, -1, 0);
138CurrentFlatText.Up.AsVector := VectorMake(0, 0, 1);
139if cbXmaxZ.Checked then
140CurrentFlatText.Layout := tlBottom // locate at z maximum
141else
142CurrentFlatText.Layout := tlTop; // or tlBottom, tlCenter
143CurrentFlatText.ModulateColor.AsWinColor := ViewData.xTextColor;
144CurrentFlatText.Position.AsVector := VectorMake(CurrentXCoord, CurrentYCoord,
145CurrentZCoord);
146CurrentFlatText.Scale.AsVector := VectorMake(ScaleFactor, ScaleFactor, 0);
147Text := FloatToStr(CurrentXCoord);
148CurrentXCoord := CurrentXCoord + CoordStep;
149end;
150
151// draw Y coords
152ClearYCoordsCube;
153if cbYmaxX.Checked then
154CurrentXCoord := ViewData.xyGrid.xRange.Maximum
155else
156CurrentXCoord := ViewData.xyGrid.xRange.Minimum;
157CoordMax := ViewData.xyGrid.yRange.Maximum;
158CoordMin := ViewData.xyGrid.yRange.Minimum;
159CoordStep := ViewData.xyGrid.yRange.Step;
160
161if cbYmaxZ.Checked then
162CurrentZCoord := ViewData.yzGrid.zRange.Maximum * ViewData.xyGrid.zScale
163else
164CurrentZCoord := ViewData.yzGrid.zRange.Minimum * ViewData.xyGrid.zScale;
165
166CurrentYCoord := CoordMin;
167while CurrentYCoord >= CoordMax do // Error: here is fault while <= !
168begin
169TGLFlatText.CreateAsChild(FormPlotStars.YCoordsCube);
170CurrentFlatText := TGLFlatText(FormPlotStars.YCoordsCube.Children[
171FormPlotStars.YCoordsCube.Count - 1]);
172CurrentFlatText.BitmapFont := FormPlotStars.GLWinBmpFont;
173if cbYmaxX.Checked then
174FormPlotStars.YCoordsCube.Direction.AsVector := VectorMake(1, 0, 0)
175else
176FormPlotStars.YCoordsCube.Direction.AsVector := VectorMake(-1, 0, 0);
177FormPlotStars.YCoordsCube.Up.AsVector := VectorMake(0, 0, 1);
178if cbYmaxZ.Checked then
179CurrentFlatText.Layout := tlBottom // locate at z maximum
180else
181CurrentFlatText.Layout := tlTop; // or tlBottom, tlCenter
182CurrentFlatText.ModulateColor.AsWinColor := ViewData.yTextColor;
183FormPlotStars.YCoordsCube.Position.AsVector := VectorMake(CurrentXCoord, CurrentYCoord,
184CurrentZCoord);
185FormPlotStars.YCoordsCube.Scale.AsVector := VectorMake(ScaleFactor, ScaleFactor, 0);
186Text := FloatToStr(CurrentYCoord);
187CurrentYCoord := CurrentYCoord + CoordStep;
188end;
189
190// draw Z coords
191ClearZCoordsCube;
192if cbZmaxX.Checked then
193CurrentXCoord := ViewData.xzGrid.xRange.Maximum
194else
195CurrentXCoord := ViewData.xzGrid.xRange.Minimum;
196CoordMax := ViewData.xzGrid.zRange.Maximum;
197CoordMin := ViewData.xzGrid.zRange.Minimum;
198CoordStep := ViewData.xzGrid.zRange.Step;
199
200if cbZmaxY.Checked then
201CurrentYCoord := ViewData.xyGrid.yRange.Maximum
202else
203CurrentYCoord := ViewData.xyGrid.yRange.Minimum;
204
205CurrentZCoord := CoordMin;
206while CurrentZCoord >= CoordMax do // Error: here is fault while <= !
207begin
208TGLFlatText.CreateAsChild(FormPlotStars.ZCoordsCube);
209CurrentFlatText := TGLFlatText(FormPlotStars.ZCoordsCube.Children[
210FormPlotStars.ZCoordsCube.Count - 1]);
211CurrentFlatText.BitmapFont := FormPlotStars.GLWinBmpFont;
212if cbZmaxX.Checked then
213begin
214if not cbZmaxY.Checked then
215FormPlotStars.ZCoordsCube.Direction.AsVector := VectorMake(0, -1, 0);
216end
217else
218begin
219if not cbZmaxY.Checked then
220FormPlotStars.ZCoordsCube.Direction.AsVector := VectorMake(-1, 0, 0)
221else
222FormPlotStars.ZCoordsCube.Direction.AsVector := VectorMake(0, 1, 0);
223end;
224FormPlotStars.ZCoordsCube.Up.AsVector := VectorMake(0, 0, 1);
225CurrentFlatText.Layout := tlCenter;
226CurrentFlatText.ModulateColor.AsWinColor := ViewData.zTextColor;
227FormPlotStars.ZCoordsCube.Position.AsVector := VectorMake(CurrentXCoord, CurrentYCoord,
228CurrentZCoord * ViewData.xyGrid.zScale);
229
230FormPlotStars.ZCoordsCube.Scale.AsVector := VectorMake(ScaleFactor, ScaleFactor, 0);
231if CurrentZCoord < 0 then
232Text := ' ' + FloatToStr(CurrentZCoord)
233else
234Text := ' ' + FloatToStr(CurrentZCoord);
235CurrentZCoord := CurrentZCoord + CoordStep;
236end;
237Altered := True;
238end;
239end;
240
241procedure TCoordsForm.ClearXCoordsCube;
242var
243i: integer;
244
245begin
246i := FormPlotStars.XCoordsCube.Count;
247while i > 0 do
248begin
249FormPlotStars.XCoordsCube.Children[i - 1].Free;
250i := FormPlotStars.XCoordsCube.Count;
251end;
252end;
253
254procedure TCoordsForm.ClearYCoordsCube;
255var
256i: integer;
257
258begin
259i := FormPlotStars.YCoordsCube.Count;
260while i > 0 do
261begin
262FormPlotStars.YCoordsCube.Children[i - 1].Free;
263i := FormPlotStars.YCoordsCube.Count;
264end;
265end;
266
267procedure TCoordsForm.ClearZCoordsCube;
268var
269i: integer;
270
271begin
272i := FormPlotStars.ZCoordsCube.Count;
273while i > 0 do
274begin
275FormPlotStars.ZCoordsCube.Children[i - 1].Free;
276i := FormPlotStars.ZCoordsCube.Count;
277end;
278end;
279
280procedure TCoordsForm.CloseBitBtnClick(Sender: TObject);
281begin
282Close;
283end;
284
285procedure TCoordsForm.FontButtonClick(Sender: TObject);
286begin
287FontDialog.Font := FormPlotStars.GLWinBmpFont.Font;
288FontDialog.Font.Name := ViewData.TextFontN;
289FontDialog.Font.Size := ViewData.TextFontSz;
290if FontDialog.Execute then
291begin
292FormPlotStars.GLWinBmpFont.Font := FontDialog.Font;
293ViewData.TextFontN := FontDialog.Font.Name;
294ViewData.TextFontSz := FontDialog.Font.Size;
295FontButton.Caption := 'Font:' + ' ' + ViewData.TextFontN + ' ' +
296IntToStr(ViewData.TextFontSz);
297UpdateCoordText;
298end;
299end;
300
301procedure TCoordsForm.cbShowCoordsClick(Sender: TObject);
302begin
303FormPlotStars.XCoordsCube.Visible := cbShowCoords.Checked;
304FormPlotStars.YCoordsCube.Visible := cbShowCoords.Checked;
305FormPlotStars.ZCoordsCube.Visible := cbShowCoords.Checked;
306if Active then
307begin
308UpdateCoordText;
309ViewData.TextVisible := cbShowCoords.Checked;
310end;
311end;
312
313procedure TCoordsForm.xColorBtnClick(Sender: TObject);
314begin
315ColorDialog.Color := ViewData.xTextColor;
316if ColorDialog.Execute then
317begin
318ViewData.xTextColor := ColorDialog.Color;
319UpdateCoordText;
320EvaluateForm.DoEvaluate;
321end;
322end;
323
324procedure TCoordsForm.cbXmaxYClick(Sender: TObject);
325begin
326ViewData.xPosYMax := cbXmaxY.Checked;
327UpdateCoordText;
328end;
329
330procedure TCoordsForm.cbXmaxZClick(Sender: TObject);
331begin
332ViewData.xPosZMax := cbXmaxZ.Checked;
333UpdateCoordText;
334end;
335
336procedure TCoordsForm.yColorBtnClick(Sender: TObject);
337begin
338ColorDialog.Color := ViewData.yTextColor;
339if ColorDialog.Execute then
340begin
341ViewData.yTextColor := ColorDialog.Color;
342UpdateCoordText;
343EvaluateForm.DoEvaluate;
344end;
345end;
346
347procedure TCoordsForm.cbYmaxXClick(Sender: TObject);
348begin
349ViewData.yPosXMax := cbYmaxX.Checked;
350UpdateCoordText;
351end;
352
353procedure TCoordsForm.cbYmaxZClick(Sender: TObject);
354begin
355ViewData.yPosZMax := cbYmaxZ.Checked;
356UpdateCoordText;
357end;
358
359procedure TCoordsForm.zColorBtnClick(Sender: TObject);
360begin
361ColorDialog.Color := ViewData.zTextColor;
362if ColorDialog.Execute then
363begin
364ViewData.zTextColor := ColorDialog.Color;
365UpdateCoordText;
366end;
367end;
368
369procedure TCoordsForm.cbZmaxXClick(Sender: TObject);
370begin
371ViewData.zPosXMax := cbZmaxX.Checked;
372UpdateCoordText;
373end;
374
375procedure TCoordsForm.cbZmaxYClick(Sender: TObject);
376begin
377ViewData.zPosYMax := cbZmaxY.Checked;
378UpdateCoordText;
379end;
380
381end.
382