CalenTools a collection of calendar stuff

[redwdc]

Some of this is quite old.  Some I wrote in the past couple of months.

I'm open to any comments. I know the coding is a bit simplistic and rough around the edges so to speak.

I just found out that my ASCII boxes didn't survive the copy and paste process. Oh well.

Oh, thanks to Jack for the help with the convert to Julian Day algorithm.

Code: QB64: [Select]

1. Dim Shared Dt$
2. Dim Shared y
3. Dim Shared m
4. Dim Shared d
5. Dim Shared y$
6. Dim Shared m$
7. Dim Shared d$
8. Dim Shared JD
9. Dim Shared row
10. Dim Shared col
11. Dim Shared FDay$
12. Dim Shared dow
13. Dim Shared doy
14. Dim Shared DM
15. Dim Shared LY
16. Dim Shared dlm
17. Dim Shared dtm
18. Dim Shared dnm
19. Dim Shared MoNa$
20. Dim Shared WkDa$
21. Dim Shared xerr
22.  
23. Screen _NewImage(80, 50)
24. _ScreenMove _Middle
25. _Title "CalenTools"
26.  
27. xerr = 0
28. FDay$ = ""
29.  
30. filenum = FreeFile
31. If _FileExists("calentools.dat") Then
32.     Open "calentools.dat" For Input As #filenum
33.     Input #filenum, FDay$
34.     Close #filenum
35. End If
36.  
37. Main_Menu
38. Sub Main_Menu
39.     Cls
40.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
41.     Print "º                                  Main Menu                                   º"
42.     Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
43.     Print "º 0. CalenTools only works for years between 1583 and 3266 inclusive.          º"
44.     Print "º    See why, and read about Julian Day numbers and ISO week numbers.          º"
45.     Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ"
46.     Print "º 1. Add or Subtract days from a date.                                         º"
47.     Print "º 2. Calendars for a month and/or a year.                                      º"
48.     Print "º 3. Day of week e.g., 1968-03-17 was a Sunday.                                º"
49.     Print "º 4. Day of week repetitive e.g., what years following 1968 was 03-17 a Sunday.º"
50.     Print "º 5. Day of year number from date e.g., 1968-03-17 was 77th day of the year.   º"
51.     Print "º 6. Date from day of year number e.g., in 1968 77th day was 03-17.            º"
52.     Print "º 7. Difference between two dates in Years Months and Days.                    º"
53.     Print "º 8. Find Easter day.                                                          º"
54.     Print "º 9. Date to Julian Day number.                                                º"
55.     Print "º A. Julian Day number to date.                                                º"
56.     Print "º B. Was/is/will it be a Leap Year.                                            º"
57.     Print "º c. Week number of the year (this is ISO week numbers).                       º"
58.     Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ"
59.     Print "º Q. To Quit.  You can also quit from any other prompt by entering Q.          º"
60.     Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
61.     Print "º Enter the number/letter of your choice:                                      º"
62.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
63.     Locate 22, 42: Input " ", q$:
64.     q$ = LCase$(q$)
65.     Select Case q$
66.         Case "0": Why_Dates
67.         Case "1": Start_ASD
68.         Case "2": Start_Cals
69.         Case "3": Start_DoW
70.         Case "4": Start_DoWR
71.         Case "5": Start_DoY
72.         Case "6": Start_RDoY
73.         Case "7": Start_DYMD
74.         Case "8": Start_Easter
75.         Case "9": Start_Date_to_JD
76.         Case "a": Start_JD_to_Date
77.         Case "b": Start_Leap_Year
78.         Case "c": Start_WkNo
79.         Case "q": Done
80.         Case Else: Main_Menu
81.     End Select
82. End Sub
83.  
84. Sub Start_ASD
85.     Cls
86.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
87.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Add or Subtract Days  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
88.     Print
89.     Input " Are you Adding to or Subtracting from a date (A/S)"; q$
90.     q$ = LCase$(q$)
91.  
92.     If q$ = "a" Then
93.         OpWd$ = " plus "
94.         xWd$ = "add"
95.         yWd$ = "add to"
96.     ElseIf q$ = "s" Then
97.         OpWd$ = " minus "
98.         xWd$ = "subtrtact"
99.         yWd$ = "subtrtact from"
100.     ElseIf q$ = "q" Then
101.         Done
102.     Else
103.         Print " You must enter 'A' for adding or 'S' for subtracting."
104.         Input " Press 'Enter' to continue."; q$
105.         If LCase$(q$) = "q" Then Done
106.         Start_ASD
107.     End If
108.  
109.     Print " Enter the number of days you want to "; xWd$; ":";: Input " ", ND$
110.     If LCase$(ND$) = "q" Then Done
111.     ND = Val(ND$)
112.  
113.     Print " Enter date to "; yWd$; " (yyyy-mm-dd)";: Input " ", Dt$
114.     If LCase$(Dt$) = "q" Then Done
115.  
116.     Date_to_YMD
117.     If xerr = 1 Then xerr = 0: Start_ASD
118.  
119.     Date_to_JD
120.     JDs = JD
121.     If LCase$(q$) = "a" Then
122.         JD = JDs + ND
123.     Else
124.         JD = JDs - ND
125.     End If
126.     JD_to_Date
127.  
128.     Zellers
129.  
130.     Day_Names_Long
131.  
132.     YMD_to_Str
133.  
134.     Print: Print
135.     Print " "; Dt$; RTrim$(OpWd$); ND; "days is "; WkDa$; ","; y$; "-" + LTrim$(m$); "-"; LTrim$(d$)
136.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
137.     Again: Start_ASD
138. End Sub
139.  
140. Sub Start_Cals
141.     Cls
142.     If FDay$ = "s" Or FDay$ = "m" Then
143.         Cals
144.     Else
145.         Get_1st_Day
146.     End If
147. End Sub
148.  
149. Sub Get_1st_Day
150.     Cls
151.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
152.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Calendars  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
153.     Print
154.     Print " Do you wish weeks to start on Sunday or Monday.  Your choice will be"
155.     Print " remembered until you quit, unless you change it in the Calendar menu."
156.     Input " (S/M): ", FDay$
157.     FDay$ = LCase$(FDay$)
158.     If FDay$ = "q" Then
159.         Done
160.     ElseIf FDay$ = "s" Or FDay$ = "m" Then
161.         Cals
162.     Else
163.         Get_1st_Day
164.     End If
165. End Sub
166.  
167. Sub Cals:
168.     Cls
169.     Tday = Val(Mid$(Date$, 4, 2))
170.     Locate 1, 18: Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
171.     Locate 2, 18: Print "º                 Calendar                  º"
172.     Locate 3, 18: Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
173.     Locate 4, 18: Print "º 1. This month                             º"
174.     Locate 5, 18: Print "º 2. Another month this year                º"
175.     Locate 6, 18: Print "º 3. A month in a dIfferent year            º"
176.     Locate 7, 18: Print "º 4. Calendar of this year                  º"
177.     Locate 8, 18: Print "º 5. Calendar of another year               º"
178.     Locate 9, 18: Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ"
179.     Locate 10, 18: Print "º C. Change first day of week               º"
180.     Locate 11, 18: Print "º M. Main Menu                              º"
181.     Locate 12, 18: Print "º S. Save 1st day of week to disc           º"
182.     Locate 13, 18: Print "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ"
183.     Locate 14, 18: Print "º Q. To Quit CalenTools                     º"
184.     Locate 15, 18: Print "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
185.     Locate 16, 18: Print "º Enter the number/letter of your choice:   º"
186.     Locate 17, 18: Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
187.     Locate 16, 59: Input " ", q$
188.     q$ = LCase$(q$)
189.     Select Case q$
190.         Case "1"
191.             y = Val(Right$(Date$, 4))
192.             m = Val(Left$(Date$, 2))
193.             Make_Month
194.         Case "2"
195.             Locate 18, 19: Input " Enter month mm: ", m$
196.             If LCase$(q$) = "q" Then Done
197.             m = Val(m$)
198.             If m < 1 Or m > 12 Then
199.                 Print " Enter a month number between 1 and 12."
200.                 Input " Press 'Enter' to continue. ", q$
201.                 If LCase$(q$) = "q" Then Done
202.                 Cals
203.             End If
204.             y = Val(Right$(Date$, 4))
205.             Make_Month
206.         Case "3"
207.             Locate 18, 19: Input " Enter a year and month yyyy-mm: ", Dt$
208.             If LCase$(Dt$) = "q" Then Done
209.             If Len(Dt$) <> 7 Then
210.                 Print " Enter a 4 digit year '-' 2 digit month, e.g., yyyy-mm"
211.                 Input " Press 'Enter' to continue. ", q$
212.                 Cals
213.             End If
214.             y = Val(Left$(Dt$, 4))
215.             m = Val(Right$(Dt$, 2))
216.             If m < 1 Or m > 12 Or y < 1583 Or y > 3266 Then
217.                 Print " You must enter year from 1583 to 3266 and a month from 1 - 12."
218.                 Input " Press 'Enter' to continue. ", q$
219.                 If LCase$(q$) = "q" Then Done
220.                 Cals
221.             End If
222.             Make_Month
223.         Case "4"
224.             y = Val(Right$(Date$, 4))
225.             Make_Year
226.         Case "5"
227.             Locate 18, 19: Input " Enter a year yyyy ", y$
228.             If LCase$(y$) = "q" Then Done
229.             y = Val(y$)
230.             If Len(y) <> 4 Or y < 1583 Or y > 3266 Then
231.                 Print
232.                 Print " Enter a year between 1583 and 3266."
233.                 Input " Press 'Enter' to continue. ", q$
234.                 If LCase$(q$) = "q" Then Done
235.                 Cals
236.             End If
237.             Make_Year
238.         Case "c"
239.             Get_1st_Day: Cals
240.         Case "m"
241.             Main_Menu
242.         Case "s"
243.             Save_1st_Day
244.         Case "q"
245.             Done
246.         Case Else
247.             Cals
248.     End Select
249.     If Val(q$) < 4 Then row = row + 1
250.     Locate row - 1, 1: Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
251.     Again: Start_Cals
252. End Sub
253.  
254. Sub Make_Month
255.     Cls
256.     Print
257.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
258.     row = 3
259.     col = 30
260.     d = 1
261.     Make_Cal
262. End Sub
263.  
264. Sub Make_Year
265.     Cls
266.     Print
267.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
268.     row = 3
269.     m = 1
270.     d = 1
271.     nm = m
272.     For mr = 1 To 4
273.         col = 5
274.         For cm = 1 To 3
275.             Make_Cal
276.             nm = nm + 1
277.             d = 1
278.             m = nm
279.             row = row - 8
280.             col = col + 25
281.         Next cm
282.         row = row + 9
283.     Next mr
284. End Sub
285.  
286. Sub Make_Cal
287.     TDay = Val(Mid$(Date$, 4, 2))
288.     Zellers
289.     If FDay$ = "m" Then dow = dow - 1: If dow < 0 Then dow = 6
290.     n2 = dow
291.  
292.     Day_Of_Year
293.     n1 = doy: m1 = m
294.     m = m + 1
295.  
296.     If m > 12 Then
297.         n3 = 31
298.     Else
299.         Day_Of_Year: n3 = doy - n1
300.     End If
301.  
302.     m = m1
303.     Month_Names_Long
304.     Color 7, 0: Locate row, col + 1: Print MoNa$; " "; y
305.     row = row + 1
306.  
307.     If FDay$ = "m" Then
308.         Color 7, 0: Locate row, col + 1: Print "Mo Tu We Th Fr"
309.         Color 12, 0: Locate row, col + 16: Print "Sa Su": Color 7, 0
310.     Else
311.         Color 12, 0: Locate row, col + 1: Print "Su"
312.         Color 7, 0: Locate row, col + 4: Print "Mo Tu We Th Fr"
313.         Color 12, 0: Locate row, col + 19: Print "Sa": Color 7, 0
314.     End If
315.  
316.     row = row + 1
317.     dn = 0
318.  
319.     ' This sets up printing "Gray Days"
320.     DM = m1
321.     Days_In_Month
322.     GD = dlm - n2 + 1
323.     aGD = 1
324.  
325.     ' Print the calendars
326.     For i = 1 To 6
327.         C = col
328.         g = 1
329.         wkd = 0
330.         For j = 1 To 7
331.             s = C
332.             If g < n2 + 1 And i = 1 Or dn >= n3 Then
333.  
334.                 If dn < 1 Then
335.                     Color 8, 0: Locate row, s: Print GD
336.                 ElseIf dn >= n3 Then
337.                     If aGD <= 9 Then s = s + 1
338.                     Color 8, 0: Locate row, s: Print aGD
339.                     Color 7, 0
340.                     aGD = aGD + 1
341.                 End If
342.  
343.             ElseIf m1 = Val(Left$(Date$, 2)) And y = Val(Right$(Date$, 4)) And dn + 1 = TDay Then
344.                 dn = dn + 1
345.                 If dn <= 9 Then s = s + 1
346.                 Color 11, 0: Locate row, s: Print dn
347.             ElseIf (FDay$ = "s" And wkd = 0 Or wkd = 6) Or (FDay$ = "m" And wkd >= 5 Or wkd = 6) Then
348.                 dn = dn + 1
349.                 If dn <= 9 Then s = s + 1
350.                 Color 12, 0: Locate row, s: Print dn: Color 7, 0
351.             ElseIf m1 <> Val(Left$(Date$, 2)) Or y <> Val(Right$(Date$, 4)) Or dn + 1 <> TDay Then
352.                 dn = dn + 1
353.                 If dn <= 9 Then s = s + 1
354.                 Color 7, 0: Locate row, s: Print dn
355.             End If
356.             wkd = wkd + 1
357.             C = C + 3
358.             g = g + 1
359.             GD = GD + 1
360.         Next j
361.         row = row + 1
362.     Next i
363. End Sub
364.  
365. Sub Start_DoW
366.     Cls
367.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
368.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Day of Week  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
369.     Print
370.     Print " Enter date to check (yyyy-mm-dd)";: Input Dt$
371.     If LCase$(Dt$) = "q" Then Done
372.  
373.     Date_to_YMD
374.     If xerr = 1 Then xerr = 0: Start_DoW
375.  
376.     Zellers
377.  
378.     Day_Names_Long
379.  
380.     YMD_to_Str
381.  
382.     Print: Print
383.     Print " "; Dt$; " was/is/will be a "; WkDa$
384.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
385.     Again: Start_DoW
386. End Sub
387.  
388. Sub Start_DoWR
389.     Cls
390.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
391.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Day of Week Repetitive  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
392.     Print
393.     Print " Enter date to start checking at (yyyy-mm-dd)";: Input Dt$
394.     If LCase$(Dt$) = "q" Then Done
395.  
396.     Date_to_YMD
397.     If xerr = 1 Then xerr = 0: Start_DoWR
398.  
399.     Print
400.     Print " Do you want to check until today or for a given number of years?"
401.     Input " Press 0 for today or a (positive) number up to 250 "; YrCt$
402.     If LCase$(YrCt$) = "q" Then Done
403.     YrCt = Val(YrCt$)
404.  
405.     If YrCt < 1 Then
406.         YrCt = Val(Right$(Date$, 4)) - y
407.     ElseIf YrCt > 250 Then
408.         YrCt = 250
409.     End If
410.  
411.     Zellers
412.     b = dow
413.  
414.     Print
415.     Print " Date             Day YrNo Count"
416.     Print
417.     row = 10
418.     col = 23
419.     x = 0
420.     C = 0
421.     Do Until x = YrCt
422.         Zellers
423.  
424.         Day_Names_Short
425.  
426.         c$ = Str$(C)
427.         x$ = Str$(x)
428.  
429.         If b = dow Then
430.             y$ = Str$(y)
431.             If m < 10 Then
432.                 m$ = "0" + LTrim$(Str$(m))
433.             Else
434.                 m$ = Str$(m)
435.             End If
436.             If d < 10 Then
437.                 d$ = "0" + LTrim$(Str$(d))
438.             Else
439.                 d$ = Str$(d)
440.             End If
441.  
442.             Locate row, 1: Print " "; LTrim$(y$); "-"; LTrim$(m$); "-"; LTrim$(d$); "  was  "; WkDa$
443.  
444.             If x < 10 Then
445.                 Locate row, col + 2: Print x$
446.             ElseIf x < 100 Then
447.                 Locate row, col + 1: Print x$
448.             Else
449.                 Locate row, col: Print x$
450.             End If
451.  
452.             If C < 10 Then
453.                 Locate row, col + 7: Print c$
454.             ElseIf C < 100 Then
455.                 Locate row, col + 6: Print c$
456.             Else
457.                 Locate row, col + 5: Print c$
458.             End If
459.             C = C + 1
460.             row = row + 1
461.         End If
462.  
463.         x = x + 1
464.         y = y + 1
465.     Loop
466.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
467.     Again: Start_DoWR
468. End Sub
469.  
470. Sub Start_DoY
471.     Cls
472.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
473.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Day of Year  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
474.     Print
475.     Input " Enter a date, e.g. 1969-07-20 (yyyy-mm-dd): "; Dt$
476.     If LCase$(Dt$) = "q" Then Done
477.  
478.     Date_to_YMD
479.     If xerr = 1 Then xerr = 0: Start_DoY
480.  
481.     Day_Of_Year
482.  
483.     YMD_to_Str
484.  
485.     Print: Print
486.     Print " "; Dt$; " was/is/will be day number "; doy
487.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
488.     Again: Start_DoY
489. End Sub
490.  
491. Sub Start_RDoY
492.     Cls
493.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
494.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Reverse Day of Year  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
495.     Print
496.     Input " Enter year and day number, 1969-074 (yyyy-nnn): "; Dt$
497.     If LCase$(Dt$) = "q" Then Done
498.  
499.     If Len(Dt$) <> 8 Then
500.         Print " You need a 4 digit year '-' 3 digit day number: yyyy-nnn."
501.         Input " Press 'Enter' to continue. ", q$
502.         If LCase$(q$) = "q" Then Done
503.         Start_RDoY
504.     End If
505.  
506.     y = Val(Left$(Dt$, 4))
507.     If y < 1583 Or y > 3266 Then
508.         Print
509.         Print " Enter a year between 1583 and 3266."
510.         Input " Press 'Enter' to continue. ", q$
511.         If LCase$(q$) = "q" Then Done
512.         Start_RDoY
513.     End If
514.  
515.     doy = Val(Right$(Dt$, Len(Dt$) - InStr(Dt$, "-")))
516.  
517.     Leap_Year
518.     If LY = 0 Then
519.         diy = 365
520.     Else
521.         diy = 366
522.     End If
523.  
524.     If doy < 1 Or doy > diy Then
525.         Print " You need day of year number between 1 and "; diy
526.         Input " Press 'Enter' to continue. ", q$
527.         If LCase$(q$) = "q" Then Done
528.         Start_RDoY
529.     End If
530.  
531.     If doy > 59 + LY Then
532.         d = doy + 2 - LY
533.     Else
534.         d = doy
535.     End If
536.  
537.     m = 100 * (d + 91) \ 3055
538.     d = d + 91 - (3055 * m \ 100)
539.     m = m - 2
540.  
541.     Zellers
542.  
543.     Day_Names_Long
544.  
545.     Month_Names_Long
546.  
547.     YMD_to_Str
548.  
549.     Print: Print
550.     Print " For day number"; doy; "of"; y$; " the date was/is/will be "; WkDa$; ", "; MoNa$; d$
551.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
552.     Again: Start_RDoY
553. End Sub
554.  
555. Sub Start_DYMD
556.     Cls
557.     Print "ÉÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍ»"
558.     Print "ÈÍÍÍÍÍÍÍÍÍͼ  Difference Between Dates in Years, Months, and Days  ÈÍÍÍÍÍÍÍÍÍÍͼ"
559.     Print
560.  
561.     Input " Enter first date (yyyy-mm-dd)"; Dt$
562.     If LCase$(Dt$) = "q" Then Done
563.  
564.     Date_to_YMD
565.     If xerr = 1 Then xerr = 0: Start_DYMD
566.  
567.     Yr1 = y
568.     Mo1 = m
569.     Da1 = d
570.     Dt1$ = Dt$
571.  
572.     Date_to_JD
573.     JD1 = JD
574.  
575.     Input " Enter second date (yyyy-mm-dd)"; Dt$
576.     If LCase$(Dt$) = "q" Then Done
577.  
578.     Date_to_YMD
579.     If xerr = 1 Then xerr = 0: Start_DYMD
580.  
581.     Yr2 = y
582.     mo2 = m
583.     da2 = d
584.     Dt2$ = Dt$
585.  
586.     Date_to_JD
587.     JD2 = JD
588.  
589.     ' Determine which Date/JD is larger.
590.     If JD1 > JD2 Then
591.         LrJD = JD1
592.         LrYr = Yr1
593.         LrMo = Mo1
594.         LrDa = Da1
595.         LrDt$ = Dt1$
596.         SmJD = JD2
597.         SmYr = Yr2
598.         SmMo = mo2
599.         SmDa = da2
600.         SmDt$ = Dt2$
601.     Else
602.         LrJD = JD2
603.         LrYr = Yr2
604.         LrMo = mo2
605.         LrDa = da2
606.         LrDt$ = Dt2$
607.         SmJD = JD1
608.         SmYr = Yr1
609.         SmMo = Mo1
610.         SmDa = Da1
611.         SmDt$ = Dt1$
612.     End If
613.  
614.     ' Find the difference between the two dates in days.
615.     OpJ$ = Str$(LrJD - SmJD)
616.     OpJD = LrJD - SmJD
617.  
618.     ' Find the Days, Months, and Years between the two dates.
619.     ' Find Days
620.     If SmDa = LrDa Then
621.         OpDa = 0
622.     ElseIf SmDa < LrDa Then
623.         OpDa = LrDa - SmDa
624.     Else
625.         DM = LrMo
626.         y = LrYr
627.         Days_In_Month
628.         OpDa = LrDa + dlm - SmDa
629.         LrMo = LrMo - 1
630.     End If
631.  
632.     'find Months
633.     If SmMo = LrMo Then
634.         OpMo = 0
635.     ElseIf SmMo < LrMo Then
636.         OpMo = LrMo - SmMo
637.     Else
638.         OpMo = LrMo + 12 - SmMo
639.         LrYr = LrYr - 1
640.     End If
641.  
642.     'find Years
643.     If LrYr = SmYr Then
644.         OpYr = 0
645.     Else
646.         OpYr = LrYr - SmYr
647.     End If
648.  
649.     SJD$ = Str$(SmJD)
650.     LJD$ = Str$(LrJD)
651.  
652.     Print: Print
653.     Print " The difference between "; SmDt$; " and "; LrDt$; " is:"
654.     Print
655.     Print " "; LTrim$(OpJ$); " Days,"
656.     Print " or"; OpYr; "Years,"; OpMo; "Months, and"; OpDa; "Days,"
657.     Print " or"; OpYr * 12 + OpMo; "Months and"; OpDa; "Days,"
658.     Print " or"; OpJD \ 7; "Weeks and"; OpJD Mod 7; "Days."
659.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
660.     Again: Start_DYMD
661. End Sub
662.  
663. Sub Start_Easter
664.     Cls
665.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
666.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Find Easter  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
667.     Print
668.     Input " Enter a year yyyy: ", y$
669.     If LCase$(y$) = "q" Then Done
670.     y = Val(y$)
671.  
672.     If Len(y) <> 4 Or y < 1583 Or y > 3266 Then
673.         Print
674.         Print " Enter a year between 1583 and 3266."
675.         Input " Press 'Enter' to continue. ", q$
676.         If LCase$(q$) = "q" Then Done
677.         Start_RDoY
678.     End If
679.  
680.     A = y Mod 19
681.     B = y Mod 4
682.     C = y Mod 7
683.     P = (y \ 100)
684.     Q = ((13 + 8 * P) \ 25)
685.     m = (15 - Q + P - P \ 4) Mod 30
686.     n = (4 + P - P \ 4) Mod 7
687.     d = (19 * A + m) Mod 30
688.     E = (2 * B + 4 * C + 6 * d + n) Mod 7
689.     day = (22 + d + E)
690.  
691.     If d = 29 And E = 6 Then
692.         m = 4
693.         d = 19
694.     ElseIf d = 28 And E = 6 Then
695.         m = 4
696.         d = 18
697.     Else
698.         If day > 31 Then
699.             day$ = Str$(day - 31)
700.             If Val(day$) < 10 Then day$ = Str$(0) + LTrim$(day$)
701.             m = 4
702.             d = day - 31
703.         Else
704.             day$ = Str$(day)
705.             If Val(day$) < 10 Then day$ = Str$(0) + LTrim$(day$)
706.             m = 3
707.             d = day
708.         End If
709.     End If
710.  
711.     Month_Names_Long
712.     Print: Print
713.     Print " In"; y; "Easter was/is/will be on Sunday, "; MoNa$; day$
714.  
715.     Date_to_JD
716.     JD = JD - 47
717.  
718.     JD_to_Date
719.  
720.     YMD_to_Str
721.  
722.     Month_Names_Long
723.  
724.     Print " And Mardi Gras was/is/will be on Tuesday, "; MoNa$; d$
725.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
726.     Again: Start_Easter
727. End Sub
728.  
729. Sub Start_Date_to_JD
730.     Cls
731.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
732.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Date to Julian Day Number  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
733.     Print
734.     Input " Enter a date yyyy-mm-dd: ", Dt$
735.     If LCase$(Dt$) = "q" Then Done
736.  
737.     Date_to_YMD
738.     If xerr = 1 Then xerr = 0: Start_Date_to_JD
739.  
740.     Date_to_JD
741.  
742.     Print: Print
743.     Print " "; LTrim$(Dt$); " is Julian Day number: "; JD
744.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
745.     Again: Start_Date_to_JD
746. End Sub
747.  
748. Sub Start_JD_to_Date
749.     Cls
750.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
751.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Julian Day Number to Date  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
752.     Print
753.     Input " Enter a number between 2299239 (1583-01-01) and 2914307 (3266-12-31): ", JD$
754.     If LCase$(JD$) = "q" Then Done
755.     JD = Val(JD$)
756.  
757.     If JD < 2299239 Or JD > 2914672 Then
758.         Print " You entered "; JD$; " This is an incorrect value for the JD number."
759.         Input " Press 'Enter' to continue. ", q$
760.         If LCase$(q$) = "q" Then Done
761.         Start_JD_to_Date
762.     End If
763.  
764.     JD_to_Date
765.  
766.     Zellers
767.  
768.     Day_Names_Long
769.  
770.     YMD_to_Str
771.  
772.     Print: Print
773.     Print " "; JD$; " is the Julian Day Number for "; WkDa$ + y$ + "-" + LTrim$(m$) + "-" + LTrim$(d$)
774.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
775.     Again: Start_JD_to_Date
776. End Sub
777.  
778. Sub Start_Leap_Year
779.     Cls
780.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
781.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Leap Year  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
782.     Print
783.     Input " Enter a year yyyy: ", y$
784.     If LCase$(y$) = "q" Then Done
785.     y = Val(y$)
786.     If y < 1583 Or y > 3266 Then
787.         Print
788.         Print " Enter a year between 1583 and 3266."
789.         Input " Press 'Enter' to continue. ", q$
790.         If LCase$(q$) = "q" Then Done
791.         Start_Leap_Year
792.     End If
793.  
794.     Leap_Year
795.     If LY = 1 Then
796.         ly$ = "Yes"
797.         lyw$ = "was/is/will be"
798.     Else
799.         ly$ = "No"
800.         lyw$ = "wasn't/isn't/won't be"
801.     End If
802.     Print: Print
803.     Print " "; ly$; " "; y$; " "; lyw$; " a Leap Year."
804.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
805.     Again: Start_Leap_Year
806. End Sub
807.  
808. Sub Start_WkNo
809.     Cls
810.     Print "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
811.     Print "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ  Week Number  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
812.     Print
813.     Input " Enter a date yyyy-mm-dd: ", Dt$
814.     If LCase$(Dt$) = "q" Then Done
815.     Date_to_YMD
816.     If xerr = 1 Then xerr = 0: Start_WkNo
817.  
818.     lwn = (y + (y \ 4) - (y \ 100) + (y \ 400)) Mod 7
819.  
820.     Zellers
821.     If dow = 0 Then dow = 7
822.  
823.     Day_Of_Year
824.  
825.     WN = (10 + doy - dow) \ 7
826.  
827.     If WN < 1 Then
828.         yy = y: y = y - 1
829.         mm = m: m = 1
830.         dd = d: d = 1
831.         Zellers
832.         Leap_Year
833.         If dow = 4 Then
834.             WN = 53
835.         ElseIf dow = 3 And LY = 1 Then
836.             WN = 53
837.         Else
838.             WN = 52
839.         End If
840.         y = yy: m = mm: d = dd
841.         Zellers
842.         If dow = 7 Then dow = 0
843.         Day_Names_Long
844.         If m = 1 And WN > 50 Then y = y - 1
845.         WN$ = Str$(WN)
846.         Print: Print
847.         Print " "; Dt$; " is "; WkDa$; " of week number"; RTrim$(WN$); ","; y
848.     Else
849.         Zellers
850.         If dow = 7 Then dow = 0
851.         Day_Names_Long
852.         If lwn < 4 And WN = 53 Then
853.             WN = 1
854.             y = y + 1
855.         End If
856.         WN$ = Str$(WN)
857.         Print: Print
858.         Print " "; Dt$; " is "; WkDa$; " of week number"; RTrim$(WN$); ","; y
859.     End If
860.  
861.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
862.     Again: Start_WkNo
863. End Sub
864.  
865. ' ================================================================================
866. '                        common SUBs used by other routines
867. ' ================================================================================
868.  
869. Sub Again
870.     Dt$ = ""
871.     y = 0
872.     m = 0
873.     d = 0
874.     JD = 0
875.     row = CsrLin
876.     Do
877.         Locate row, 1: Print "                                                                               "
878.         Locate row, 1: Input " Enter 'A' to go again, 'M' for main menu, or 'Q' to quit (A/M/Q)"; q$
879.         q$ = LCase$(q$)
880.         If q$ = "a" Then
881.             Exit Do
882.         ElseIf q$ = "m" Then
883.             Main_Menu
884.         ElseIf q$ = "q" Then
885.             Done
886.         End If
887.     Loop
888. End Sub
889.  
890. ' Gives the day of week for any Gregorian calendar date.
891. Sub Zellers
892.     If m > 2 Then
893.         mz = m - 2: yz = y
894.     Else
895.         mz = m + 10: yz = y - 1
896.     End If
897.  
898.     cz = yz \ 100: dz = yz - 100 * cz
899.     dow = ((13 * mz - 1) \ 5) + d + dz + (dz \ 4) + (cz \ 4) - cz - cz + 77
900.     dow = dow - 7 * (dow \ 7)
901. End Sub
902.  
903. ' Gives the day of the year
904. Sub Day_Of_Year
905.     doy = (3055 * (m + 2) \ 100) - 91
906.     Leap_Year
907.     If m > 2 Then doy = doy - 2 + LY
908.     doy = doy + d
909. End Sub
910.  
911. Sub Leap_Year
912.     LY = 0
913.     If y Mod 4 = 0 Then LY = 1
914.     If y Mod 100 = 0 Then LY = 0
915.     If y Mod 400 = 0 Then LY = 1
916. End Sub
917.  
918. ' Get the number of days for last month (dlm), this month (dtm), and next month (dnm)
919. Sub Days_In_Month
920.     Leap_Year
921.     DM1 = DM * 2 - 1
922.     dlm = Val(Mid$("313128313031303131303130", DM1, 2))
923.     If dlm = 28 And LY = 1 Then dlm = 29
924.     dtm = Val(Mid$("312831303130313130313031", DM1, 2))
925.     If dtm = 28 And LY = 1 Then dtm = 29
926.     dnm = Val(Mid$("283130313031313031303131", DM1, 2))
927.     If dnm = 28 And LY = 1 Then dnm = 29
928. End Sub
929.  
930. ' Convert a Gregorian Date to a Julian Day number.
931. Sub Date_to_JD
932.     JD = d - 32075 + (1461 * (y + 4800 + ((m - 14) \ 12)) \ 4) + 367 * (m - 2 - ((m - 14) \ 12) * 12) \ 12 - 3 * ((y + 4900 + ((m - 14) \ 12)) \ 100) \ 4
933. End Sub
934.  
935. ' Convert a Julian Day number to a Gregorian Date.
936. Sub JD_to_Date
937.     L = JD + 68569
938.     n = 4 * L \ 146097
939.     L = L - (146097 * n + 3) \ 4
940.     y = 4000 * (L + 1) \ 1461001
941.     L = L - (1461 * y \ 4) + 31
942.     m = 80 * L \ 2447
943.     d = L - (2447 * m \ 80)
944.     L = m \ 11
945.     m = m + 2 - (12 * L)
946.     y = 100 * (n - 49) + y + L
947. End Sub
948.  
949. Sub Day_Names_Short
950.     Select Case dow
951.         Case 0: WkDa$ = "Sun"
952.         Case 1: WkDa$ = "Mon"
953.         Case 2: WkDa$ = "Tue"
954.         Case 3: WkDa$ = "Wed"
955.         Case 4: WkDa$ = "Thu"
956.         Case 5: WkDa$ = "Fri"
957.         Case 6: WkDa$ = "Sat"
958.     End Select
959. End Sub
960.  
961. Sub Day_Names_Long
962.     Select Case dow
963.         Case 0: WkDa$ = "Sunday"
964.         Case 1: WkDa$ = "Monday"
965.         Case 2: WkDa$ = "Tuesday"
966.         Case 3: WkDa$ = "Wednesday"
967.         Case 4: WkDa$ = "Thursday"
968.         Case 5: WkDa$ = "Friday"
969.         Case 6: WkDa$ = "Saturday"
970.     End Select
971. End Sub
972.  
973. Sub Month_Names_Short
974.     Select Case m
975.         Case 1: MoNa$ = "Jan"
976.         Case 2: MoNa$ = "Feb"
977.         Case 3: MoNa$ = "Mar"
978.         Case 4: MoNa$ = "Apr"
979.         Case 5: MoNa$ = "May"
980.         Case 6: MoNa$ = "Jun"
981.         Case 7: MoNa$ = "Jul"
982.         Case 8: MoNa$ = "Aug"
983.         Case 9: MoNa$ = "Sep"
984.         Case 10: MoNa$ = "Oct"
985.         Case 11: MoNa$ = "Nov"
986.         Case 12: MoNa$ = "Dec"
987.     End Select
988. End Sub
989.  
990. Sub Month_Names_Long
991.     Select Case m
992.         Case 1: MoNa$ = "January"
993.         Case 2: MoNa$ = "February"
994.         Case 3: MoNa$ = "March"
995.         Case 4: MoNa$ = "April"
996.         Case 5: MoNa$ = "May"
997.         Case 6: MoNa$ = "June"
998.         Case 7: MoNa$ = "July"
999.         Case 8: MoNa$ = "August"
1000.         Case 9: MoNa$ = "September"
1001.         Case 10: MoNa$ = "October"
1002.         Case 11: MoNa$ = "November"
1003.         Case 12: MoNa$ = "December"
1004.     End Select
1005. End Sub
1006.  
1007. ' Convert input date (Dt$) to year, month, and day integers And check that they are valid
1008. Sub Date_to_YMD
1009.     y = Val(Left$(Dt$, 4))
1010.     m = Val(Mid$(Dt$, 6, 2))
1011.     d = Val(Right$(Dt$, 2))
1012.  
1013.     DM = m
1014.     Days_In_Month
1015.     If Len(Dt$) <> 10 Then
1016.         Print
1017.         Print " Your date has too few or too many characters in it."
1018.         Input " Press 'Enter' to continue. ", q$
1019.         If LCase$(q$) = "q" Then Done
1020.         xerr = 1
1021.     ElseIf y < 1583 Or y > 3266 Then
1022.         Print
1023.         Print " Enter a year between 1583 and 3266."
1024.         Input " Press 'Enter' to continue. ", q$
1025.         If LCase$(q$) = "q" Then Done
1026.         xerr = 1
1027.     ElseIf m < 1 Or m > 12 Then
1028.         Print
1029.         Print " Enter a month number between 1 and 12."
1030.         Input " Press 'Enter' to continue. ", q$
1031.         If LCase$(q$) = "q" Then Done
1032.         xerr = 1
1033.     ElseIf d < 1 Or d > dtm Then
1034.         Print
1035.         Print " Enter a day number between 1 and "; dtm;
1036.         Input " Press 'Enter' to continue. ", q$
1037.         If LCase$(q$) = "q" Then Done
1038.         xerr = 1
1039.     End If
1040. End Sub
1041.  
1042. ' Convert Year, month, and day integers to strings and add leading 0s to digits less than 10
1043. Sub YMD_to_Str
1044.     y$ = Str$(y)
1045.     m$ = Str$(m)
1046.     d$ = Str$(d)
1047.  
1048.     If m < 10 Then m$ = Str$(0) + LTrim$(m$)
1049.     If d < 10 Then d$ = Str$(0) + LTrim$(d$)
1050. End Sub
1051.  
1052. Sub Why_Dates
1053.     Cls
1054.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
1055.     Print
1056.     Print "    CalenTools will not work with years prior to 1583 or after 3266, this was"
1057.     Print " done intentionally partly as an error prevention measure."
1058.     Print "    Prior to 1583 most of the western world used the Julian Calendar which had"
1059.     Print " an extra 3 leap years every 400 years.  Pope Gregory XIII wrote a papal bull"
1060.     Print " in Feb. 1582 to correct for this error by suppressing 10 days.  Thus causing"
1061.     Print " Oct. 5, 1582 to become Oct. 15, 1582.  (So I dropped the last two and a half"
1062.     Print " months of 1582 because and I don't think most people will need them)."
1063.     Print "    The papel bull was adopted by most countries at different times.  A lof of"
1064.     Print " Roman Catholic countries Spain, Portugal, etc. and their colonies changed on"
1065.     Print " Oct. 15, 1582. Great Britain and the American colonies changed in 1752.  The"
1066.     Print " most recant change from The Julian calendar that I know of is Turkey in 1927."
1067.     Print "    As Far as I know only a few religions still use the Julian calendar.  You"
1068.     Print " can use the search engine of your choice to find a list of when the different"
1069.     Print " countries adopted the Gregorian calendar."
1070.     Print "    As for after 3266, it my be my limited sense of reality, but I don't really"
1071.     Print " think it's necessary as I think there will be something better by then.  Maybe"
1072.     Print " even a whole new calendar system. "
1073.     Print "    Also it's the end of the first Julian Period so Julian Day numbers will"
1074.     Print " restart at one.  I'm using Julian Day numbers are here to 'Add or Subtract"
1075.     Print " Days' and to find the 'Difference between two dates'."
1076.     Print "    The Julian Period and Julian Day numbers (not to be confused with the"
1077.     Print " Julian Calendar) start at noon on -4712-01-01 of the Julian calendar (or"
1078.     Print " -4713-11-24 Gregorian Calendar).  This is because in 4713 BC the 'Indiction'"
1079.     Print " (15 yrs.), the 'Golden Number' (19) and the 'Solar Number' (28 yrs.) were all"
1080.     Print " one.  The Julian Period is 7980 years long.  The next time this happens is"
1081.     Print " Jan. 01, 3268 Julian calendar or Nov. 24, 3267 Gregorian calendar."
1082.     Print "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
1083.     Print
1084.     Print "    The ISO (International Organization for Standardization) week starts on"
1085.     Print " Mon. The 1st week of the year has Jan. 4th and the first Thu. of the year in"
1086.     Print " it. If Jan. the 1st is a Thu., making Sun. the 4th the last day of the week,"
1087.     Print " the first day of the first week is Mon. Dec. 29th of the previous year.  If"
1088.     Print " Jan. 4th is a Mon. then Jan. 1st is Fri. of the last week of the previous year."
1089.     Print "    Also a year that starts on Thu. (or Wed. if a leap year) has 53 weeks"
1090.     Print " because there are 53 Thu. in the year and therefore 53 continuous weeks that"
1091.     Print " each have at least 4 days of the current calendar year per week.  Therefore,"
1092.     Print " Fri. Jan. 1st 2016 is Fri. of the 53rd week of 2015."
1093.     Print "    There are 71 of these 53 week years every 400 years."
1094.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
1095.     Input " Press 'Enter' to continue. ", q$
1096.     If LCase$(q$) = "q" Then
1097.         Done
1098.     Else
1099.         Main_Menu
1100.     End If
1101. End Sub
1102.  
1103. Sub Save_1st_Day
1104.     Cls
1105.     Print
1106.     Print "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
1107.     Print " Saving this will create a 3 byte file on your hard drive.  This file will"
1108.     Print " waste a lot of space.  Depending on drive size and operating system you are"
1109.     Print " wasting, on average, between 509 to 4093 bytes.  Just to save you from having"
1110.     Print " to press 's' or 'm' every time you view calendars in CalenTools."
1111.     Print
1112.     Print " The file it creates will be in the same directory that you have CalenTools in."
1113.     Print " So if you have it on the desktop you will end up with two CalenTools files on"
1114.     Print " your desktop.   Also if for whatever reason you happen to have a file named"
1115.     Print " 'calentools.dat' in the same directory it will be over written."
1116.     Print
1117.     Input " Do you wish to continue (Y/N)"; q$
1118.     q$ = LCase$(q$)
1119.     If q$ = "q" Then
1120.         Done
1121.     ElseIf q$ = "n" Then
1122.         Cals
1123.     ElseIf q$ = "y" Then
1124.         Do_Save
1125.     Else
1126.         Save_1st_Day
1127.     End If
1128. End Sub
1129.  
1130. Sub Do_Save
1131.     fd$ = FDay$ 'This is in case you are using Sun. but want to save Mon.
1132.     Print
1133.     Input " Do you want the week to start on Sunday or Monday (S/M)"; q$
1134.     q$ = LCase$(q$)
1135.     If q$ = "q" Then Done
1136.     FDay$ = q$
1137.     filenum = FreeFile
1138.     Open "calentools.dat" For Output As #filenum
1139.     Print #filenum, FDay$
1140.     Close #filenum
1141.     FDay$ = fd$
1142.     Cals
1143. End Sub
1144.  
1145. Sub Done
1146.     System
1147. End Sub
1148.