1 |
(* ***** BEGIN LICENSE BLOCK *****
|
2 |
* Version: MPL 1.1
|
3 |
*
|
4 |
* The contents of this file are subject to the Mozilla Public License Version
|
5 |
* 1.1 (the "License"); you may not use this file except in compliance with
|
6 |
* the License. You may obtain a copy of the License at
|
7 |
* http://www.mozilla.org/MPL/
|
8 |
*
|
9 |
* Software distributed under the License is distributed on an "AS IS" basis,
|
10 |
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
11 |
* for the specific language governing rights and limitations under the
|
12 |
* License.
|
13 |
*
|
14 |
* The Original Code is TurboPower SysTools
|
15 |
*
|
16 |
* The Initial Developer of the Original Code is
|
17 |
* TurboPower Software
|
18 |
*
|
19 |
* Portions created by the Initial Developer are Copyright (C) 1996-2002
|
20 |
* the Initial Developer. All Rights Reserved.
|
21 |
*
|
22 |
* Contributor(s):
|
23 |
*
|
24 |
* ***** END LICENSE BLOCK ***** *)
|
25 |
|
26 |
unit AstCalU;
|
27 |
|
28 |
interface
|
29 |
|
30 |
uses
|
31 |
SysUtils, Windows, Classes, Graphics, Controls,
|
32 |
Forms, Dialogs, StdCtrls, ExtCtrls,
|
33 |
|
34 |
StConst,
|
35 |
StDate,
|
36 |
StDateSt,
|
37 |
StAstro,
|
38 |
StAstroP;
|
39 |
|
40 |
|
41 |
type
|
42 |
TForm1 = class(TForm)
|
43 |
Panel1: TPanel;
|
44 |
Label1: TLabel;
|
45 |
Button1: TButton;
|
46 |
Label2: TLabel;
|
47 |
Label3: TLabel;
|
48 |
MonthEF: TEdit;
|
49 |
DateEF: TEdit;
|
50 |
YearEF: TEdit;
|
51 |
Label4: TLabel;
|
52 |
Label5: TLabel;
|
53 |
Label6: TLabel;
|
54 |
GB1: TGroupBox;
|
55 |
Label7: TLabel;
|
56 |
Label8: TLabel;
|
57 |
LocalTimeEF: TEdit;
|
58 |
SiderealTimeEF: TEdit;
|
59 |
GB2: TGroupBox;
|
60 |
Label9: TLabel;
|
61 |
Label10: TLabel;
|
62 |
Label11: TLabel;
|
63 |
Label12: TLabel;
|
64 |
Label13: TLabel;
|
65 |
SunRiseEF: TEdit;
|
66 |
MoonRiseEF: TEdit;
|
67 |
SunSetEF: TEdit;
|
68 |
MoonSetEF: TEdit;
|
69 |
TwiStartEF: TEdit;
|
70 |
TwiEndEF: TEdit;
|
71 |
GB3: TGroupBox;
|
72 |
PositionsLB: TListBox;
|
73 |
Header1: THeader;
|
74 |
GB4: TGroupBox;
|
75 |
NMFirstDate: TEdit;
|
76 |
FQFirstDate: TEdit;
|
77 |
NMFirstTime: TEdit;
|
78 |
FQFirstTime: TEdit;
|
79 |
FMFirstDate: TEdit;
|
80 |
LQFirstDate: TEdit;
|
81 |
LQFirstTime: TEdit;
|
82 |
FMFirstTime: TEdit;
|
83 |
Label14: TLabel;
|
84 |
Label15: TLabel;
|
85 |
Label16: TLabel;
|
86 |
Label17: TLabel;
|
87 |
NMSecondDate: TEdit;
|
88 |
NMSecondTime: TEdit;
|
89 |
FQSecondDate: TEdit;
|
90 |
FQSecondTime: TEdit;
|
91 |
FMSecondDate: TEdit;
|
92 |
FMSecondTime: TEdit;
|
93 |
LQSecondTime: TEdit;
|
94 |
LQSecondDate: TEdit;
|
95 |
NMPrevDate: TEdit;
|
96 |
FQPrevDate: TEdit;
|
97 |
FMPrevDate: TEdit;
|
98 |
LQPrevDate: TEdit;
|
99 |
LQPrevTime: TEdit;
|
100 |
FMPrevTime: TEdit;
|
101 |
FQPrevTime: TEdit;
|
102 |
NMPrevTime: TEdit;
|
103 |
NMNextDate: TEdit;
|
104 |
FQNextDate: TEdit;
|
105 |
FMNextDate: TEdit;
|
106 |
LQNextDate: TEdit;
|
107 |
LQNextTime: TEdit;
|
108 |
FMNextTime: TEdit;
|
109 |
FQNextTime: TEdit;
|
110 |
NMNextTime: TEdit;
|
111 |
Header2: THeader;
|
112 |
GB5: TGroupBox;
|
113 |
Label18: TLabel;
|
114 |
Label19: TLabel;
|
115 |
Label20: TLabel;
|
116 |
Label21: TLabel;
|
117 |
Label22: TLabel;
|
118 |
SpringTime: TEdit;
|
119 |
SummerTime: TEdit;
|
120 |
SummerDate: TEdit;
|
121 |
SpringDate: TEdit;
|
122 |
FallTime: TEdit;
|
123 |
WinterTime: TEdit;
|
124 |
WinterDate: TEdit;
|
125 |
FallDate: TEdit;
|
126 |
EasterEF: TEdit;
|
127 |
PhaseLabel: TLabel;
|
128 |
Label23: TLabel;
|
129 |
SunlightEF: TEdit;
|
130 |
LongEF: TEdit;
|
131 |
LatEF: TEdit;
|
132 |
Timer1: TTimer;
|
133 |
procedure Button1Click(Sender: TObject);
|
134 |
procedure FormCreate(Sender: TObject);
|
135 |
procedure Timer1Timer(Sender: TObject);
|
136 |
private
|
137 |
{ Private declarations }
|
138 |
public
|
139 |
{ Public declarations }
|
140 |
|
141 |
TheDT : TStDateTimeRec;
|
142 |
RS : TStRiseSetRec;
|
143 |
|
144 |
D, M, Y : Integer;
|
145 |
|
146 |
ObsLat,
|
147 |
ObsLong : Double;
|
148 |
|
149 |
procedure DoCalcTimes;
|
150 |
procedure DoFixedCalcs;
|
151 |
procedure DoCalcs(ObsLong, ObsLat : Double);
|
152 |
|
153 |
end;
|
154 |
|
155 |
var
|
156 |
Form1: TForm1;
|
157 |
|
158 |
|
159 |
implementation
|
160 |
|
161 |
{$R *.DFM}
|
162 |
|
163 |
|
164 |
procedure TForm1.DoCalcTimes;
|
165 |
var
|
166 |
TT : TStTime;
|
167 |
begin
|
168 |
LocalTimeEF.Text := CurrentTimeString('hh:mm:ss', False);
|
169 |
TheDT.T := CurrentTime;
|
170 |
TT := Round(SiderealTime(TheDT) * 240);
|
171 |
SiderealTimeEF.Text := StTimeToTimeString('hh:mm:ss', TT, False);
|
172 |
end;
|
173 |
|
174 |
|
175 |
procedure TForm1.DoFixedCalcs;
|
176 |
var
|
177 |
Y,
|
178 |
M ,
|
179 |
D : integer;
|
180 |
DTR : TStDateTimeRec;
|
181 |
MPR : TStMoonPosRec;
|
182 |
SPR : TStPosRec;
|
183 |
LR : TStLunarRecord;
|
184 |
PA : TStPlanetsArray;
|
185 |
|
186 |
begin
|
187 |
|
188 |
{Calculate Positions}
|
189 |
|
190 |
SPR := SunPos(TheDT);
|
191 |
PositionsLB.Items.Add('Sun ' + HoursMin(SPR.RA) + ' ' + DegsMin(SPR.DC));
|
192 |
|
193 |
MPR := MoonPos(TheDT);
|
194 |
PositionsLB.Items.Add('Moon ' + HoursMin(MPR.RA) + ' ' + DegsMin(MPR.DC));
|
195 |
|
196 |
PlanetsPos(AstJulianDate(TheDT.D) + TheDT.T/86400, PA);
|
197 |
PositionsLB.Items.Add('Mercury ' + HoursMin(PA[1].RA) + ' ' + DegsMin(PA[1].DC));
|
198 |
PositionsLB.Items.Add('Venus ' + HoursMin(PA[2].RA) + ' ' + DegsMin(PA[2].DC));
|
199 |
PositionsLB.Items.Add('Mars ' + HoursMin(PA[3].RA) + ' ' + DegsMin(PA[3].DC));
|
200 |
PositionsLB.Items.Add('Jupiter ' + HoursMin(PA[4].RA) + ' ' + DegsMin(PA[4].DC));
|
201 |
PositionsLB.Items.Add('Saturn ' + HoursMin(PA[5].RA) + ' ' + DegsMin(PA[5].DC));
|
202 |
PositionsLB.Items.Add('Uranus ' + HoursMin(PA[6].RA) + ' ' + DegsMin(PA[6].DC));
|
203 |
PositionsLB.Items.Add('Neptune ' + HoursMin(PA[7].RA) + ' ' + DegsMin(PA[7].DC));
|
204 |
PositionsLB.Items.Add('Pluto ' + HoursMin(PA[8].RA) + ' ' + DegsMin(PA[8].DC));
|
205 |
|
206 |
|
207 |
{Calculate lunar phases}
|
208 |
|
209 |
if LunarPhase(TheDT) >= 0 then
|
210 |
PhaseLabel.Caption := 'Waxing'
|
211 |
else
|
212 |
PhaseLabel.Caption := 'Waning';
|
213 |
|
214 |
|
215 |
LR := NewMoon(TheDT.D);
|
216 |
NMFirstDate.Text := StDateToDateString('mm/dd', LR.T[0].D, False);
|
217 |
NMFirstTime.Text := StTimeToTimeString('hh:mm', LR.T[0].T, False);
|
218 |
if LR.T[1].D <> BadDate then
|
219 |
begin
|
220 |
NMSecondDate.Text := StDateToDateString('mm/dd', LR.T[1].D, False);
|
221 |
NMSecondTime.Text := StTimeToTimeString('hh:mm', LR.T[1].T, False);
|
222 |
end else
|
223 |
begin
|
224 |
NMSecondDate.Text := '';
|
225 |
NMSecondTime.Text := '';
|
226 |
end;
|
227 |
|
228 |
LR := FirstQuarter(TheDT.D);
|
229 |
FQFirstDate.Text := StDateToDateString('mm/dd', LR.T[0].D, False);
|
230 |
FQFirstTime.Text := StTimeToTimeString('hh:mm', LR.T[0].T, False);
|
231 |
if LR.T[1].D <> BadDate then
|
232 |
begin
|
233 |
FQSecondDate.Text := StDateToDateString('mm/dd', LR.T[1].D, False);
|
234 |
FQSecondTime.Text := StTimeToTimeString('hh:mm', LR.T[1].T, False);
|
235 |
end else
|
236 |
begin
|
237 |
FQSecondDate.Text := '';
|
238 |
FQSecondTime.Text := '';
|
239 |
end;
|
240 |
|
241 |
LR := FullMoon(TheDT.D);
|
242 |
FMFirstDate.Text := StDateToDateString('mm/dd', LR.T[0].D, False);
|
243 |
FMFirstTime.Text := StTimeToTimeString('hh:mm', LR.T[0].T, False);
|
244 |
if LR.T[1].D <> BadDate then
|
245 |
begin
|
246 |
FMSecondDate.Text := StDateToDateString('mm/dd', LR.T[1].D, False);
|
247 |
FMSecondTime.Text := StTimeToTimeString('hh:mm', LR.T[1].T, False);
|
248 |
end else
|
249 |
begin
|
250 |
FMSecondDate.Text := '';
|
251 |
FMSecondTime.Text := '';
|
252 |
end;
|
253 |
|
254 |
LR := LastQuarter(TheDT.D);
|
255 |
LQFirstDate.Text := StDateToDateString('mm/dd', LR.T[0].D, False);
|
256 |
LQFirstTime.Text := StTimeToTimeString('hh:mm', LR.T[0].T, False);
|
257 |
if LR.T[1].D <> BadDate then
|
258 |
begin
|
259 |
LQSecondDate.Text := StDateToDateString('mm/dd', LR.T[1].D, False);
|
260 |
LQSecondTime.Text := StTimeToTimeString('hh:mm', LR.T[1].T, False);
|
261 |
end else
|
262 |
begin
|
263 |
LQSecondDate.Text := '';
|
264 |
LQSecondTime.Text := '';
|
265 |
end;
|
266 |
|
267 |
|
268 |
{Calculate Next/Previous}
|
269 |
|
270 |
DTR := PrevNewMoon(TheDT.D);
|
271 |
if DTR.D <> BadDate then
|
272 |
begin
|
273 |
NMPrevDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
274 |
NMPrevTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
275 |
end else
|
276 |
begin
|
277 |
NMPrevDate.Text := '';
|
278 |
NMPrevTime.Text := '';
|
279 |
end;
|
280 |
|
281 |
DTR := NextNewMoon(TheDT.D);
|
282 |
if DTR.D <> BadDate then
|
283 |
begin
|
284 |
NMNextDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
285 |
NMNextTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
286 |
end else
|
287 |
begin
|
288 |
NMNextDate.Text := '';
|
289 |
NMNextTime.Text := '';
|
290 |
end;
|
291 |
|
292 |
|
293 |
DTR := PrevFirstQuarter(TheDT.D);
|
294 |
if DTR.D <> BadDate then
|
295 |
begin
|
296 |
FQPrevDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
297 |
FQPrevTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
298 |
end else
|
299 |
begin
|
300 |
FQPrevDate.Text := '';
|
301 |
FQPrevTime.Text := '';
|
302 |
end;
|
303 |
|
304 |
DTR := NextFirstQuarter(TheDT.D);
|
305 |
if DTR.D <> BadDate then
|
306 |
begin
|
307 |
FQNextDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
308 |
FQNextTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
309 |
end else
|
310 |
begin
|
311 |
FQNextDate.Text := '';
|
312 |
FQNextTime.Text := '';
|
313 |
end;
|
314 |
|
315 |
|
316 |
DTR := PrevFullMoon(TheDT.D);
|
317 |
if DTR.D <> BadDate then
|
318 |
begin
|
319 |
FMPrevDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
320 |
FMPrevTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
321 |
end else
|
322 |
begin
|
323 |
FMPrevDate.Text := '';
|
324 |
FMPrevTime.Text := '';
|
325 |
end;
|
326 |
|
327 |
DTR := NextFullMoon(TheDT.D);
|
328 |
if DTR.D <> BadDate then
|
329 |
begin
|
330 |
FMNextDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
331 |
FMNextTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
332 |
end else
|
333 |
begin
|
334 |
FMNextDate.Text := '';
|
335 |
FMNextTime.Text := '';
|
336 |
end;
|
337 |
|
338 |
|
339 |
DTR := PrevLastQuarter(TheDT.D);
|
340 |
if DTR.D <> BadDate then
|
341 |
begin
|
342 |
LQPrevDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
343 |
LQPrevTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
344 |
end else
|
345 |
begin
|
346 |
LQPrevDate.Text := '';
|
347 |
LQPrevTime.Text := '';
|
348 |
end;
|
349 |
|
350 |
DTR := NextLastQuarter(TheDT.D);
|
351 |
if DTR.D <> BadDate then
|
352 |
begin
|
353 |
LQNextDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
354 |
LQNextTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
355 |
end else
|
356 |
begin
|
357 |
LQNextDate.Text := '';
|
358 |
LQNextTime.Text := '';
|
359 |
end;
|
360 |
|
361 |
|
362 |
{Calculate Other Events}
|
363 |
|
364 |
StDateToDMY(TheDT.D, D, M, Y);
|
365 |
EasterEF.Text := StDateToDateString('mm/dd', Easter(Y, 0), False);
|
366 |
|
367 |
|
368 |
DTR := Equinox(Y, 0, True);
|
369 |
SpringDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
370 |
SpringTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
371 |
|
372 |
|
373 |
DTR := Equinox(Y, 0, False);
|
374 |
FallDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
375 |
FallTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
376 |
|
377 |
|
378 |
DTR := Solstice(Y, 0, True);
|
379 |
SummerDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
380 |
SummerTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
381 |
|
382 |
|
383 |
DTR := Solstice(Y, 0, False);
|
384 |
WinterDate.Text := StDateToDateString('mm/dd', DTR.D, False);
|
385 |
WinterTime.Text := StTimeToTimeString('hh:mm', DTR.T, False);
|
386 |
end;
|
387 |
|
388 |
|
389 |
|
390 |
procedure TForm1.DoCalcs(ObsLong, ObsLat : Double);
|
391 |
begin
|
392 |
SunlightEF.Text := StTimeToTimeString('hh:mm',
|
393 |
AmountOfSunlight(TheDT.D, ObsLong, ObsLat), False);
|
394 |
|
395 |
|
396 |
RS := SunRiseSet(TheDT.D, ObsLong, ObsLat);
|
397 |
SunRiseEF.Text := StTimeToTimeString('hh:mm', RS.ORise, False);
|
398 |
SunSetEF.Text := StTimeToTimeString('hh:mm', RS.OSet, False);
|
399 |
|
400 |
RS := MoonRiseSet(TheDT.D, ObsLong, ObsLat);
|
401 |
MoonRiseEF.Text := StTimeToTimeString('hh:mm', RS.ORise, False);
|
402 |
MoonSetEF.Text := StTimeToTimeString('hh:mm', RS.OSet, False);
|
403 |
|
404 |
RS := Twilight(TheDT.D, ObsLong, ObsLat, ttAstronomical);
|
405 |
TwiStartEF.Text := StTimeToTimeString('hh:mm', RS.ORise, False);
|
406 |
TwiEndEF.Text := StTimeToTimeString('hh:mm', RS.OSet, False);
|
407 |
end;
|
408 |
|
409 |
|
410 |
procedure TForm1.Button1Click(Sender: TObject);
|
411 |
begin
|
412 |
try
|
413 |
M := StrToInt(MonthEF.Text);
|
414 |
if not (M in [1..12]) then
|
415 |
begin
|
416 |
ShowMessage('Month value out of range (1..12)');
|
417 |
Exit;
|
418 |
end;
|
419 |
|
420 |
D := StrToInt(DateEF.Text);
|
421 |
if not (D in [1..31]) then
|
422 |
begin
|
423 |
ShowMessage('Date value out of range (1..31)');
|
424 |
Exit;
|
425 |
end;
|
426 |
|
427 |
Y := StrToInt(YearEF.Text);
|
428 |
if (Y < 1800) or (Y > 2200) then
|
429 |
begin
|
430 |
ShowMessage('Year value out of range (1800..2200)');
|
431 |
Exit;
|
432 |
end;
|
433 |
|
434 |
TheDT.D := DMYToStDate(D, M, Y, 0);
|
435 |
if TheDT.D = BadDate then
|
436 |
begin
|
437 |
ShowMessage('Invalid date');
|
438 |
Exit;
|
439 |
end;
|
440 |
TheDT.T := CurrentTime;
|
441 |
|
442 |
ObsLong := StrToFloat(LongEF.Text);
|
443 |
if (ObsLong < -180) or (ObsLong > 180) then
|
444 |
begin
|
445 |
ShowMessage('Longitude out of range (-180..180)');
|
446 |
Exit;
|
447 |
end;
|
448 |
|
449 |
ObsLat := StrToFloat(LatEF.Text);
|
450 |
if (ObsLat < -90) or (ObsLat > 90) then
|
451 |
begin
|
452 |
ShowMessage('Latitude out of range (-90..90)');
|
453 |
Exit;
|
454 |
end;
|
455 |
|
456 |
PositionsLB.Clear;
|
457 |
DoFixedCalcs;
|
458 |
DoCalcs(ObsLong, ObsLat);
|
459 |
|
460 |
except
|
461 |
ShowMessage('One or more entry fields has illegal data');
|
462 |
end;
|
463 |
end;
|
464 |
|
465 |
procedure TForm1.FormCreate(Sender: TObject);
|
466 |
begin
|
467 |
TheDT.D := CurrentDate;
|
468 |
TheDT.T := CurrentTime;
|
469 |
|
470 |
StDateToDMY(TheDT.D, D, M, Y);
|
471 |
MonthEF.Text := IntToStr(M);
|
472 |
DateEF.Text := IntToStr(D);
|
473 |
YearEF.Text := IntToStr(Y);
|
474 |
|
475 |
LongEF.Text := FloatToStr(-105.27);
|
476 |
LatEF.Text := FloatToStr(38.87);
|
477 |
|
478 |
DoCalcTimes;
|
479 |
Button1Click(Button1);
|
480 |
end;
|
481 |
|
482 |
procedure TForm1.Timer1Timer(Sender: TObject);
|
483 |
begin
|
484 |
DoCalcTimes;
|
485 |
end;
|
486 |
|
487 |
end.
|