QB64.org Forum

Active Forums => Programs => Topic started by: SMcNeill on December 24, 2020, 06:45:17 pm

Title: Calendar 2021
Post by: SMcNeill on December 24, 2020, 06:45:17 pm

https://1drv.ms/u/s!AknUrv8RXVYMkIMiwSDNKinhlbfuHg?e=6eumhM

It's the end of the year again, so I've sat down and starting working up a little calendar program for the next year (once again, like I've did for several years already...)

What I've got this time around is a nice little program which looks like the following:

Code: QB64: [Select]

1. CONST ShowGrid = -1
2. CONST ShowYear = 0
3. CONST DesiredYear = 2021
4. $COLOR:32
5.  
6. SCREEN _NEWIMAGE(1283, 720, 32)
7. _PRINTMODE _KEEPBACKGROUND
8. RANDOMIZE TIMER
9.  
10.  
11. DIM SHARED f: f = _LOADFONT("OLDENGL.ttf", 72)
12. DIM SHARED ThisMonth, Today, ThisYear
13. DIM SHARED BackGrounds(1 TO 12)
14.  
15. ThisMonth = VAL(DATE$)
16. Today = VAL(MID$(DATE$, 4))
17. ThisYear = VAL(RIGHT$(DATE$, 4))
18.  
19.  
20.  
21. TitleScreen
22. IF ShowYear THEN
23.     FOR i = 1 TO 12
24.         CLS
25.         _PUTIMAGE , BackGrounds(i)
26.         IF ShowGrid THEN DrawLines
27.         CenterMonth i, DesiredYear
28.         DrawDays i, DesiredYear
29.         SLEEP
30.     NEXT
31. ELSE
32.     CLS
33.     _PUTIMAGE , BackGrounds(1)
34.     IF ShowGrid THEN DrawLines
35.     CenterMonth ThisMonth, ThisYear
36.     DrawDays ThisMonth, ThisYear
37.     SLEEP
38. END IF
39. SYSTEM
40.  
41.  
42. SUB TitleScreen
43.     _TITLE "Steve's Calendar"
44.     CLS , SkyBlue
45.     _FONT f
46.     text$ = "Steve's Calendar"
47.     pw = _PRINTWIDTH(text$) \ 2
48.     _PRINTSTRING (640 - pw, 200), text$
49.     IF ShowYear THEN
50.         text$ = _TRIM$(STR$(DesiredYear))
51.     ELSE
52.         text$ = _TRIM$(STR$(ThisYear))
53.     END IF
54.     pw = _PRINTWIDTH(text$) \ 2
55.     _PRINTSTRING (640 - pw, 300), text$
56.     GetBackgrounds
57.     _FONT 16
58.     COLOR Black
59.     text$ = "Press <ANY KEY> to continue."
60.     pw = _PRINTWIDTH(text$) \ 2
61.     _PRINTSTRING (640 - pw, 400), text$
62.     COLOR White
63.     _FONT f
64.     SLEEP 2
65. END SUB
66.  
67.  
68. SUB GetHolidays (month, day, holiday() AS STRING)
69.     REDIM holiday(0) AS STRING
70.     SELECT CASE month
71.         CASE 1
72.             SELECT CASE day
73.                 CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "New Years Day"
74.                 CASE 6: REDIM holiday(1) AS STRING: holiday(1) = "Epiphany"
75.             END SELECT
76.         CASE 2
77.             SELECT CASE day
78.                 CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "Black History Month"
79.                 CASE 2: REDIM holiday(1) AS STRING: holiday(1) = "Groundhog Day"
80.                 CASE 14: REDIM holiday(1) AS STRING: holiday(1) = "Valentine's Day"
81.             END SELECT
82.         CASE 3
83.             SELECT CASE day
84.                 CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "Women's History Month"
85.             END SELECT
86.         CASE 4
87.             SELECT CASE day
88.                 CASE 15: REDIM holiday(1) AS STRING: holiday(1) = "Tax Day"
89.             END SELECT
90.         CASE 5
91.             SELECT CASE day
92.             END SELECT
93.         CASE 6
94.             SELECT CASE day
95.             END SELECT
96.         CASE 7
97.             SELECT CASE day
98.                 CASE 4: REDIM holiday(1) AS STRING: holiday(1) = "Independence Day"
99.             END SELECT
100.         CASE 8
101.             SELECT CASE day
102.             END SELECT
103.         CASE 9
104.             SELECT CASE day
105.                 CASE 25: REDIM holiday(1) AS STRING: holiday(1) = "Steve's Birthday"
106.             END SELECT
107.         CASE 10
108.             SELECT CASE day
109.                 CASE 31: REDIM holiday(1) AS STRING: holiday(1) = "Halloween"
110.             END SELECT
111.         CASE 11
112.             SELECT CASE day
113.                 CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "All Saint's Day"
114.                 CASE 2: REDIM holiday(1) AS STRING: holiday(1) = "All Soul's Day"
115.                 CASE 11: REDIM holiday(1) AS STRING: holiday(1) = "Vetern's Day"
116.             END SELECT
117.         CASE 12
118.             SELECT CASE day
119.                 CASE 7: REDIM holiday(1) AS STRING: holiday(1) = "Pearl Harbor Remembrance"
120.                 CASE 24: REDIM holiday(1) AS STRING: holiday(1) = "Christmas Eve"
121.                 CASE 25: REDIM holiday(1) AS STRING: holiday(1) = "Christmas"
122.                 CASE ELSE: REDIM holiday(0) AS STRING
123.             END SELECT
124.     END SELECT
125. END SUB
126.  
127.  
128. SUB GetBackgrounds
129.     IF ShowYear THEN limit = 12 ELSE limit = 1
130.     FOR i = 1 TO limit
131.         redo:
132.         t = INT(RND * 1088) + 1
133.         FOR j = 1 TO i
134.             IF BackGrounds(j) = t GOTO redo
135.             t$ = ".\Backgrounds\" + _TRIM$(STR$(t)) + ".jpg"
136.             t1 = _LOADIMAGE(t$, 32)
137.             IF t1 = -1 THEN _FREEIMAGE t1: GOTO redo
138.         NEXT
139.         BackGrounds(i) = t1
140.     NEXT
141. END SUB
142.  
143. SUB CenterMonth (month, year)
144.     _FONT f
145.     SELECT CASE month
146.         CASE 1: text$ = "January"
147.         CASE 2: text$ = "February"
148.         CASE 3: text$ = "March"
149.         CASE 4: text$ = "April"
150.         CASE 5: text$ = "May"
151.         CASE 6: text$ = "June"
152.         CASE 7: text$ = "July"
153.         CASE 8: text$ = "August"
154.         CASE 9: text$ = "September"
155.         CASE 10: text$ = "October"
156.         CASE 11: text$ = "November"
157.         CASE 12: text$ = "December"
158.     END SELECT
159.     text$ = text$ + STR$(year)
160.     pw = _PRINTWIDTH(text$) / 2
161.     _PRINTSTRING (640 - pw, 0), text$
162. END SUB
163.  
164.  
165. SUB DrawLines
166.     TopOffset = 72
167.     FOR i = 0 TO 6
168.         LINE (0, i * 90 + TopOffset)-STEP(1280, 3), _RGBA32(128, 128, 64, 160), BF
169.     NEXT
170.     FOR i = 0 TO 7
171.         LINE (i * 1280 / 7, 0 + TopOffset)-STEP(3, 540), _RGBA32(128, 128, 64, 160), BF
172.     NEXT
173. END SUB
174.  
175.  
176. SUB DrawDays (month, year)
177.     SHARED highlightday
178.     REDIM Holidays(0) AS STRING
179.     TopOffset = 76
180.     nod = NumberOfDays(month, year)
181.     y = 0
182.     FOR i = 1 TO nod
183.         text$ = _TRIM$(STR$(i))
184.         pw = _PRINTWIDTH(text$)
185.         x = GetDay(month, i, year)
186.         IF month = ThisMonth AND i = Today AND ThisYear = year THEN LINE ((x - 1) * 1280 / 7 + 3, y * 90 + TopOffset)-STEP(1280 / 7 - 3, 86), Blue, BF
187.         _PRINTSTRING (x * 1280 / 7 - pw, y * 90 + TopOffset), text$
188.         GetHolidays month, i, Holidays()
189.         u = UBOUND(holidays)
190.         IF u > 0 THEN
191.             _FONT 8
192.             FOR j = 1 TO u
193.                 pw = _PRINTWIDTH(Holidays(j))
194.                 _PRINTSTRING ((x - 1) * 1280 / 7 + 4, (y + 1) * 90 + TopOffset - 5 - j * 8), Holidays(j)
195.             NEXT
196.             _FONT f
197.         END IF
198.  
199.         IF x = 7 THEN y = y + 1
200.     NEXT
201. END SUB
202.  
203.  
204. FUNCTION NumberOfDays (month, year)
205.     SELECT CASE month
206.         CASE 1, 3, 5, 7, 8, 10, 12: NumberOfDays = 31
207.         CASE 2: IF IsLeapYear(year) THEN NumberOfDays = 29 ELSE NumberOfDays = 28
208.         CASE 4, 6, 9, 11: NumberOfDays = 30
209.     END SELECT
210. END SUB
211.  
212.  
213. FUNCTION IsLeapYear (yyyy) 'use 4 digit year
214.     IF GetDay(2, 29, yyyy) <> GetDay(3, 1, yyyy) THEN IsLeapYear = -1
215. END FUNCTION
216.  
217. FUNCTION GetDay (m, d, y) 'use 4 digit year
218.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
219.     mm = m: dd = d: yyyy = y
220.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
221.     century = yyyy MOD 100
222.     zerocentury = yyyy \ 100
223.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
224.     IF result = 0 THEN
225.         GetDay = 7
226.     ELSE
227.         GetDay = result
228.     END IF
229.     'Function changed to return a numeric value instead of a string for this program
230.     '    SELECT CASE result
231.     '        CASE 7: GetDay$ = "Saturday"
232.     '        CASE 1: GetDay$ = "Sunday"
233.     '        CASE 2: GetDay$ = "Monday"
234.     '        CASE 3: GetDay$ = "Tuesday"
235.     '        CASE 4: GetDay$ = "Wednesday"
236.     '        CASE 5: GetDay$ = "Thursday"
237.     '        CASE 6: GetDay$ = "Friday"
238.     '    END SELECT
239. END FUNCTION
240.  

Note: You'll need the resource files for it to work as intended, and those can be downloaded from the links at top, bottom or here: https://1drv.ms/u/s!AknUrv8RXVYMkIMiwSDNKinhlbfuHg?e=6eumhM

Note 2: If you don't have the resource files, you'll need to build your own in the subfolders so you can have pretty little images to work with, such as the screenshot below:

 

Note 3: I don't swear all the images in the folder are fully censored.  There's a small collection of 1088 images which I just grabbed out of a singular folder from one of my drives, and some of them may be NSFW.  There's no porn, or any such thing in there, but different folks have different artistic standards and some may view an image of the Roman statue of Venus and say, "Oh my gosh!  Not in my house!!"  If you're one of those folks, then simply don't download the resource pack, or else delete anything you find questionable.  There's nothing in it that I *personally* find inappropriate, but if my taste in "art" doesn't float your boat, feel free to replace anything with your own stuff.  :P



https://1drv.ms/u/s!AknUrv8RXVYMkIMiwSDNKinhlbfuHg?e=6eumhM

Title: Re: Calendar 2021
Post by: SMcNeill on December 24, 2020, 06:48:10 pm

Also notice the few constants which are at the top of the program:

CONST ShowGrid = -1
CONST ShowYear = 0
CONST DesiredYear = 2021

Feel free to change those, if desired.  Personally, I have mine set to ShowYear = -1 (view a whole year at once), and then I've tossed in a simple little _PRINTIMAGE routine to print out the finished pages, and I've now got me a whole nice little set of calendars to tack up on my wall for the year.   ;)

Title: Re: Calendar 2021
Post by: Richard Frost on December 25, 2020, 03:13:23 am

Code: QB64: [Select]

1. ' 136 t1 = _LOADIMAGE(t$, 32)
2. ' 137 IF t1 = -1 THEN _FREEIMAGE t1: GOTO redo
3.  
4. ' This bit caused me to wonder if an image that fails to load uses up memory, so
5. ' I wrote the following test program.  Monitoring Task Manager tells me this code
6. ' does not eat up memory.  If the line with _FREEIMAGE is commented in, an error is
7. ' immediately generated, as I expected.
8.  
9. ' So, shouldn't line 137 be IF t1 >=-1 THEN GOTO redo?
10.  
11. ' I suppose your images are all present and readable, so you don't generate an error.
12.  
13. DEFLNG A-Z
14. DO
15.     i = _LOADIMAGE("leftover bacon.jpg", 32)
16.     'IF i = -1 THEN _FREEIMAGE i
17.     _DELAY .01
18. LOOP UNTIL INKEY$ = CHR$(27)
19.  

Title: Re: Calendar 2021
Post by: SMcNeill on December 25, 2020, 10:46:51 pm

So, never one to be satisfied with something, I'm still tinkering around with this little project, converting it from what was just a calendar to what is now steadily on the way to also becoming a day planner...

Code: QB64: [Select]

1. CONST ShowGrid = -1
2. CONST ShowYear = 0
3. CONST DesiredYear = 2021
4. CONST ShowDays = -1
5. $COLOR:32
6.  
7. SCREEN _NEWIMAGE(1600, 720, 32)
8. _PRINTMODE _KEEPBACKGROUND
9. RANDOMIZE TIMER
10.  
11.  
12. TYPE Sun_Data_type
13.     field AS STRING
14.     value AS STRING
15. END TYPE
16.  
17. REDIM SHARED Sun(0) AS Sun_Data_type
18. DIM SHARED f: f = _LOADFONT("OLDENGL.ttf", 72)
19. DIM SHARED f1: f1 = _LOADFONT("OLDENGL.ttf", 32)
20. DIM SHARED ThisMonth, Today, ThisYear
21. DIM SHARED BackGrounds(1 TO 12)
22. DIM Lat AS _FLOAT, Lon AS _FLOAT
23.  
24. ThisMonth = VAL(DATE$)
25. Today = VAL(MID$(DATE$, 4))
26. ThisYear = VAL(RIGHT$(DATE$, 4))
27.  
28. Lat_Long Lat, Lon, 0 'get latitude and longitude, but no need to force them to redownload over and over,
29. '                     if we already have them saved on the disk.
30.  
31. SunStuff Lat, Lon, ThisMonth, Today, ThisYear
32.  
33. TitleScreen
34.  
35. IF ShowYear THEN
36.     FOR i = 1 TO 12
37.         CLS , SkyBlue
38.         _PUTIMAGE (0, 0)-(1283, 720), BackGrounds(i)
39.         IF ShowGrid THEN DrawLines
40.         CenterMonth i, DesiredYear
41.         DrawDays i, DesiredYear
42.         ShowDailyStuff Lat, Lon
43.         SLEEP
44.     NEXT
45. ELSE
46.     CLS , SkyBlue
47.     _PUTIMAGE (0, 0)-(1283, 720), BackGrounds(1)
48.     IF ShowGrid THEN DrawLines
49.     CenterMonth ThisMonth, ThisYear
50.     DrawDays ThisMonth, ThisYear
51.     ShowDailyStuff Lat, Lon
52.     SLEEP
53. END IF
54. SYSTEM
55.  
56.  
57.  
58. SUB ShowDailyStuff (Lat AS _FLOAT, Lon AS _FLOAT)
59.     _FONT f1
60.     COLOR Black
61.     LINE (1320, 50)-(1560, 500), Gold, BF
62.  
63.     cp = 1280 + (1600 - 1280) \ 2 'center of our non-calendar area
64.     t$ = ConvertToDay(GetDay(ThisMonth, Today, ThisYear)): _PRINTSTRING (cp - _PRINTWIDTH(t$) \ 2, 60), t$
65.     t$ = DATE$: _PRINTSTRING (cp - _PRINTWIDTH(t$) \ 2, 95), t$
66.     _FONT 16
67.     t$ = "For Lat/Long:" + STR$(INT(100 * Lat) / 100) + "," + STR$(INT(100 * Lon) / 100)
68.     _PRINTSTRING (1325, 130), t$
69.     _PRINTSTRING (1325, 156), "Sun Rise  : " + Sun(1).value
70.     _PRINTSTRING (1325, 174), "Sun Set   : " + Sun(2).value
71.     _PRINTSTRING (1325, 192), "Solar Noon: " + Sun(3).value
72.     _PRINTSTRING (1325, 210), "Day Length: " + Sun(4).value
73.     _PRINTSTRING (1325, 228), "Moon Phase:" + MoonPhase$(month, day, year)
74.     COLOR White
75.     _FONT f
76.     EXIT SUB
77. END SUB
78.  
79.  
80.  
81.  
82.  
83. SUB TitleScreen
84.     _TITLE "Steve's Calendar"
85.     CLS , SkyBlue
86.     _FONT f
87.     text$ = "Steve's Calendar"
88.     pw = _PRINTWIDTH(text$) \ 2
89.     _PRINTSTRING (640 - pw, 200), text$
90.     IF ShowYear THEN
91.         text$ = _TRIM$(STR$(DesiredYear))
92.     ELSE
93.         text$ = _TRIM$(STR$(ThisYear))
94.     END IF
95.     pw = _PRINTWIDTH(text$) \ 2
96.     _PRINTSTRING (640 - pw, 300), text$
97.     GetBackgrounds
98.     _FONT 16
99.     COLOR Black
100.     text$ = "Press <ANY KEY> to continue."
101.     pw = _PRINTWIDTH(text$) \ 2
102.     _PRINTSTRING (640 - pw, 400), text$
103.     COLOR White
104.     _FONT f
105.     SLEEP 2
106. END SUB
107.  
108.  
109. SUB GetHolidays (month, day, holiday() AS STRING)
110.     REDIM holiday(0) AS STRING
111.     SELECT CASE month
112.         CASE 1
113.             SELECT CASE day
114.                 CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "New Years Day"
115.                 CASE 6: REDIM holiday(1) AS STRING: holiday(1) = "Epiphany"
116.             END SELECT
117.         CASE 2
118.             SELECT CASE day
119.                 CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "Black History Month"
120.                 CASE 2: REDIM holiday(1) AS STRING: holiday(1) = "Groundhog Day"
121.                 CASE 14: REDIM holiday(1) AS STRING: holiday(1) = "Valentine's Day"
122.             END SELECT
123.         CASE 3
124.             SELECT CASE day
125.                 CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "Women's History Month"
126.             END SELECT
127.         CASE 4
128.             SELECT CASE day
129.                 CASE 15: REDIM holiday(1) AS STRING: holiday(1) = "Tax Day"
130.             END SELECT
131.         CASE 5
132.             SELECT CASE day
133.             END SELECT
134.         CASE 6
135.             SELECT CASE day
136.             END SELECT
137.         CASE 7
138.             SELECT CASE day
139.                 CASE 4: REDIM holiday(1) AS STRING: holiday(1) = "Independence Day"
140.             END SELECT
141.         CASE 8
142.             SELECT CASE day
143.             END SELECT
144.         CASE 9
145.             SELECT CASE day
146.                 CASE 25: REDIM holiday(1) AS STRING: holiday(1) = "Steve's Birthday"
147.             END SELECT
148.         CASE 10
149.             SELECT CASE day
150.                 CASE 31: REDIM holiday(1) AS STRING: holiday(1) = "Halloween"
151.             END SELECT
152.         CASE 11
153.             SELECT CASE day
154.                 CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "All Saint's Day"
155.                 CASE 2: REDIM holiday(1) AS STRING: holiday(1) = "All Soul's Day"
156.                 CASE 11: REDIM holiday(1) AS STRING: holiday(1) = "Vetern's Day"
157.             END SELECT
158.         CASE 12
159.             SELECT CASE day
160.                 CASE 7: REDIM holiday(1) AS STRING: holiday(1) = "Pearl Harbor Remembrance"
161.                 CASE 24: REDIM holiday(1) AS STRING: holiday(1) = "Christmas Eve"
162.                 CASE 25: REDIM holiday(1) AS STRING: holiday(1) = "Christmas"
163.                 CASE ELSE: REDIM holiday(0) AS STRING
164.             END SELECT
165.     END SELECT
166. END SUB
167.  
168.  
169. SUB GetBackgrounds
170.     IF ShowYear THEN limit = 12 ELSE limit = 1
171.     FOR i = 1 TO limit
172.         redo:
173.         t = INT(RND * 1088) + 1
174.         FOR j = 1 TO i
175.             IF BackGrounds(j) = t GOTO redo
176.             t$ = ".\Backgrounds\" + _TRIM$(STR$(t)) + ".jpg"
177.             t1 = _LOADIMAGE(t$, 32)
178.             IF t1 = -1 THEN GOTO redo
179.         NEXT
180.         BackGrounds(i) = t1
181.     NEXT
182. END SUB
183.  
184. SUB CenterMonth (month, year)
185.     _FONT f
186.     SELECT CASE month
187.         CASE 1: text$ = "January"
188.         CASE 2: text$ = "February"
189.         CASE 3: text$ = "March"
190.         CASE 4: text$ = "April"
191.         CASE 5: text$ = "May"
192.         CASE 6: text$ = "June"
193.         CASE 7: text$ = "July"
194.         CASE 8: text$ = "August"
195.         CASE 9: text$ = "September"
196.         CASE 10: text$ = "October"
197.         CASE 11: text$ = "November"
198.         CASE 12: text$ = "December"
199.     END SELECT
200.     text$ = text$ + STR$(year)
201.     pw = _PRINTWIDTH(text$) / 2
202.     _PRINTSTRING (640 - pw, 0), text$
203. END SUB
204.  
205.  
206. SUB DrawLines
207.     TopOffset = 72
208.  
209.     IF ShowDays THEN
210.         LINE (0, TopOffset)-STEP(1280, 3), _RGBA(128, 128, 64, 160), BF
211.         FOR i = 0 TO 7
212.             LINE (i * 1280 / 7, 0 + TopOffset)-STEP(3, 40), _RGBA32(128, 128, 64, 160), BF
213.         NEXT
214.         TopOffset = TopOffset + 40
215.     END IF
216.     FOR i = 0 TO 6
217.         LINE (0, i * 90 + TopOffset)-STEP(1280, 3), _RGBA32(128, 128, 64, 160), BF
218.     NEXT
219.     FOR i = 0 TO 7
220.         LINE (i * 1280 / 7, 0 + TopOffset)-STEP(3, 540), _RGBA32(128, 128, 64, 160), BF
221.     NEXT
222. END SUB
223.  
224. FUNCTION ConvertToDay$ (day) 'Function to return a string for a day
225.     SELECT CASE day
226.         CASE 1: ConvertToDay$ = "Sunday"
227.         CASE 2: ConvertToDay$ = "Monday"
228.         CASE 3: ConvertToDay$ = "Tuesday"
229.         CASE 4: ConvertToDay$ = "Wednesday"
230.         CASE 5: ConvertToDay$ = "Thursday"
231.         CASE 6: ConvertToDay$ = "Friday"
232.         CASE 7: ConvertToDay$ = "Saturday"
233.     END SELECT
234. END FUNCTION
235.  
236. SUB DrawDays (month, year)
237.     SHARED highlightday
238.     REDIM Holidays(0) AS STRING
239.     TopOffset = 76
240.     IF ShowDays THEN
241.         _FONT f1
242.         bw = 1280 \ 7
243.         FOR i = 1 TO 7
244.             t$ = ConvertToDay(i)
245.             pw = _PRINTWIDTH(t$) \ 2
246.             _PRINTSTRING (bw * (i - 1) + bw \ 2 - pw, 80), t$
247.         NEXT
248.         TopOffset = TopOffset + 40
249.         _FONT f
250.     END IF
251.  
252.     nod = NumberOfDays(month, year)
253.     y = 0
254.     FOR i = 1 TO nod
255.         text$ = _TRIM$(STR$(i))
256.         pw = _PRINTWIDTH(text$)
257.         x = GetDay(month, i, year)
258.         IF month = ThisMonth AND i = Today AND ThisYear = year THEN LINE ((x - 1) * 1280 / 7 + 3, y * 90 + TopOffset)-STEP(1280 / 7 - 3, 86), _RGBA32(128, 128, 128, 128), BF
259.         _PRINTSTRING (x * 1280 / 7 - pw, y * 90 + TopOffset), text$
260.         GetHolidays month, i, Holidays()
261.         u = UBOUND(holidays)
262.         IF u > 0 THEN
263.             _FONT 8
264.             FOR j = 1 TO u
265.                 pw = _PRINTWIDTH(Holidays(j))
266.                 _PRINTSTRING ((x - 1) * 1280 / 7 + 4, (y + 1) * 90 + TopOffset - 5 - j * 8), Holidays(j)
267.             NEXT
268.             _FONT f
269.         END IF
270.  
271.         IF x = 7 THEN y = y + 1
272.     NEXT
273. END SUB
274.  
275.  
276. FUNCTION NumberOfDays (month, year)
277.     SELECT CASE month
278.         CASE 1, 3, 5, 7, 8, 10, 12: NumberOfDays = 31
279.         CASE 2: IF IsLeapYear(year) THEN NumberOfDays = 29 ELSE NumberOfDays = 28
280.         CASE 4, 6, 9, 11: NumberOfDays = 30
281.     END SELECT
282. END SUB
283.  
284.  
285. FUNCTION IsLeapYear (yyyy) 'use 4 digit year
286.     IF GetDay(2, 29, yyyy) <> GetDay(3, 1, yyyy) THEN IsLeapYear = -1
287. END FUNCTION
288.  
289. FUNCTION GetDay (m, d, y) 'use 4 digit year
290.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
291.     mm = m: dd = d: yyyy = y
292.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
293.     century = yyyy MOD 100
294.     zerocentury = yyyy \ 100
295.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
296.     IF result = 0 THEN
297.         GetDay = 7
298.     ELSE
299.         GetDay = result
300.     END IF
301.     'Function changed to return a numeric value instead of a string for this program
302.     '    SELECT CASE result
303.     '        CASE 7: GetDay$ = "Saturday"
304.     '        CASE 1: GetDay$ = "Sunday"
305.     '        CASE 2: GetDay$ = "Monday"
306.     '        CASE 3: GetDay$ = "Tuesday"
307.     '        CASE 4: GetDay$ = "Wednesday"
308.     '        CASE 5: GetDay$ = "Thursday"
309.     '        CASE 6: GetDay$ = "Friday"
310.     '    END SELECT
311. END FUNCTION
312.  
313.  
314. FUNCTION GetPublicIP$ (force)
315.     STATIC f
316.     IF force = -1 OR _FILEEXISTS("PIP.txt") = 0 THEN
317.         OPEN "PIP.txt" FOR OUTPUT AS #f: CLOSE f
318.         SHELL _HIDE "cmd /c nslookup myip.opendns.com resolver1.opendns.com>tempPIP.txt"
319.     END IF
320.     f = FREEFILE
321.     OPEN "tempPIP.txt" FOR INPUT AS #f
322.     IF LOF(f) THEN
323.         DO
324.             LINE INPUT #f, temp$
325.             IF temp$ <> "" THEN last$ = temp$ 'there's a blank line after the data we need.
326.             '                                 Ignore it.  What we want is the last line of info generated here.
327.         LOOP UNTIL EOF(1)
328.         l = _INSTRREV(last$, "Address:")
329.         IF l THEN GetPublicIP$ = MID$(last$, l + 10)
330.     END IF
331.     CLOSE f
332.  
333. END FUNCTION
334.  
335. SUB Lat_Long (lat AS _FLOAT, lon AS _FLOAT, force)
336.     STATIC f
337.     ip$ = GetPublicIP$(0)
338.     IF force = -1 OR _FILEEXISTS("LatAndLong.txt") = 0 THEN
339.         DownloadURL "ip-api.com/line/" + ip$ + "?fields=lat,lon", "LatAndLong.txt"
340.     END IF
341.     f = FREEFILE
342.     OPEN "LatAndLong.txt" FOR INPUT AS #f
343.     IF LOF(f) = 0 THEN CLOSE f: EXIT SUB 'something didn't download.  this info isn't available to parse.
344.     INPUT #f, lat
345.     INPUT #f, lon
346.     CLOSE f
347. END SUB
348.  
349. SUB DownloadURL (link$, file$)
350.     STATIC f
351.     f = FREEFILE
352.     OPEN file$ FOR OUTPUT AS #f: CLOSE #f 'erase any old file of the same name
353.     $IF WIN THEN
354.         out$ = "powershell.exe -c " + CHR$(34) + "Invoke-Webrequest '" + link$ + "' -OutFile '" + file$ + "'" + CHR$(34)
355.     $ELSE
356.         out$ = "wget " + chr$(34) + link$ + " -O " + file$ + chr$(34)
357.     $END IF
358.     SHELL _HIDE out$
359. END SUB
360.  
361. FUNCTION GetHour (fromTime$) 'time should be hh:mm:ss WhateverM
362.     l = INSTR(fromTime$, ":") '1st :
363.     GetHour = VAL(LEFT$(fromTime$, l))
364. END SUB
365.  
366. FUNCTION GetMinute (fromTime$) 'time should be hh:mm:ss WhateverM
367.     l = INSTR(fromTime$, ":") '1st :
368.     GetMinute = VAL(MID$(fromTime$, l + 1))
369. END SUB
370.  
371.  
372. FUNCTION GetSecond (fromTime$) 'time should be hh:mm:ss WhateverM
373.     l = INSTR(fromTime$, ":") '1st :
374.     l = INSTR(l + 1, fromTime$, ":") '2nd :
375.     GetSecond = VAL(MID$(fromTime$, l + 1))
376. END SUB
377.  
378.  
379. FUNCTION GetTimeOffset
380.     $IF WIN THEN
381.         TYPE SYSTEMTIME
382.             wYear AS _UNSIGNED INTEGER
383.             wMonth AS _UNSIGNED INTEGER
384.             wDayOfWeek AS _UNSIGNED INTEGER
385.             wDay AS _UNSIGNED INTEGER
386.             wHour AS _UNSIGNED INTEGER
387.             wMinute AS _UNSIGNED INTEGER
388.             wSecond AS _UNSIGNED INTEGER
389.             wMilliseconds AS _UNSIGNED INTEGER
390.         END TYPE
391.  
392.         TYPE TIME_ZONE_INFORMATION
393.             Bias AS LONG
394.             StandardName AS STRING * 64 'WCHAR      StandardName[32];
395.             StandardDate AS SYSTEMTIME
396.             StandardBias AS LONG
397.             DaylightName AS STRING * 64 'WCHAR      DaylightName[32];
398.             DaylightDate AS SYSTEMTIME
399.             DaylightBias AS LONG
400.         END TYPE
401.  
402.         DECLARE DYNAMIC LIBRARY "Kernel32"
403.             SUB GetTimeZoneInformation (t AS TIME_ZONE_INFORMATION)
404.         END DECLARE
405.  
406.         DIM t AS TIME_ZONE_INFORMATION
407.         GetTimeZoneInformation t
408.         GetTimeOffset = t.Bias
409.     $END IF
410. END SUB
411.  
412.  
413.  
414. SUB SunStuff (lat, lon, month, day, year)
415.     STATIC f
416.     d$ = _TRIM$(STR$(year)) + _TRIM$(STR$(month)) + _TRIM$(STR$(day))
417.     link$ = "https://api.sunrise-sunset.org/json?lat=" + _TRIM$(STR$(lat)) + "&lng="
418.     link$ = link$ + _TRIM$(STR$(lon)) + "&date=" + d$
419.     DownloadURL link$, "temp.txt"
420.     f = FREEFILE
421.     OPEN "temp.txt" FOR BINARY AS #f
422.  
423.     IF LOF(f) = 0 THEN CLOSE f: EXIT SUB 'something didn't download.  this info isn't available to parse.
424.  
425.     t$ = SPACE$(LOF(f))
426.     GET #1, 1, t$
427.     CLOSE f
428.  
429.     'strip off unwanted stuff
430.     l = INSTR(t$, ":{"): t$ = MID$(t$, l + 2) 'junk left of our initial data
431.     DO
432.         l = INSTR(t$, CHR$(34))
433.         t$ = LEFT$(t$, l - 1) + MID$(t$, l + 1) 'remove all quotes completely from this data
434.     LOOP UNTIL l = 0
435.     DO
436.         l = INSTR(t$, "_")
437.         t$ = LEFT$(t$, l - 1) + " " + MID$(t$, l + 1) 'change all underscores to spaces in this data
438.     LOOP UNTIL l = 0
439.     t$ = _TRIM$(t$)
440.     t$ = LEFT$(t$, LEN(t$) - 12) 'remove the last end of data }
441.     PRINT t$
442.  
443.     'parse it down to field, data
444.     DO
445.         l = INSTR(t$, ",")
446.         IF l = 0 THEN EXIT DO
447.         count = count + 1
448.         REDIM _PRESERVE Sun(count) AS Sun_Data_type
449.         whole$ = LEFT$(t$, l)
450.         Sun(count).field = LEFT$(whole$, INSTR(whole$, ":") - 1)
451.         r$ = MID$(whole$, INSTR(whole$, ":") + 1)
452.         r$ = LEFT$(r$, LEN(r$) - 1)
453.         IF RIGHT$(r$, 1) = "M" THEN m$ = RIGHT$(r$, 3) ELSE m$ = ""
454.         h = GetHour(r$): m = GetMinute(r$): s = GetSecond(r$)
455.         IF m$ = " PM" AND h <> 12 THEN h = h + 12
456.         IF count <> 4 THEN
457.             h = h - GetTimeOffset / 60
458.             IF h < 0 THEN h = 24 + h 'adjust for AM/PM difference, if ever necessary
459.             IF h > 23 THEN h = h - 24 'adjust for AM/PM difference, if ever necessary
460.             SELECT CASE h
461.                 CASE 0: h = 12: m$ = " AM"
462.                 CASE 12: m$ = " PM"
463.                 CASE IS > 12: h = h - 12: m$ = " PM"
464.                 CASE ELSE: m$ = " AM"
465.             END SELECT
466.         END IF
467.         hour$ = _TRIM$(STR$(h)): IF LEN(hour$) = 1 THEN hour$ = "0" + hour$
468.         min$ = _TRIM$(STR$(m)): IF LEN(min$) = 1 THEN min$ = "0" + min$
469.         sec$ = _TRIM$(STR$(s)): IF LEN(sec$) = 1 THEN sec$ = "0" + sec$
470.         Sun(count).value = hour$ + ":" + min$ + ":" + sec$ + m$
471.         t$ = MID$(t$, l + 1)
472.     LOOP
473. END SUB
474.  
475.  
476. FUNCTION MoonPhase$ (month, day, year)
477.     DIM mooncycle AS _FLOAT
478.     DIM fullmoon AS _FLOAT, dp AS _FLOAT, sod AS _FLOAT
479.     mooncycle = 29.5305882 'days between moon rotations
480.     sod = 24 * 60 * 60 'number of seconds in a day
481.  
482.     m$ = _TRIM$(STR$(month))
483.     d$ = _TRIM$(STR$(day))
484.     y$ = _TRIM$(STR$(year))
485.     dt$ = m$ + "-" + d$ + "-" + y$
486.     guessmoon = TimeStamp(dt$, 23 * 3600 + 59 * 60 + 59) 'what is the moon at 11:59:59 PM
487.     fullmoon = TimeStamp("1-3-2020", 4 * 3600 + 46 * 60) ' full moon on 1-3-2020 at 4:46 AM UTC
488.     dp = (guessmoon - fullmoon) / sod 'days past our full moon
489.     r1 = dp - INT(dp / mooncycle) * mooncycle 'how far we are in repeating our rotation
490.     SELECT CASE r1
491.         CASE IS <= mooncycle / 4: MoonPhase$ = "1st Quarter"
492.         CASE IS <= mooncycle / 2: MoonPhase$ = "Full moon"
493.         CASE IS <= mooncycle * 3 / 4: MoonPhase$ = "3rd Quarter"
494.         CASE ELSE: MoonPhase$ = "New Moon"
495.     END SELECT
496. END FUNCTION
497.  
498.  
499.  
500. FUNCTION TimeStamp## (d$, t##) 'date and timer
501.     'Based on Unix Epoch time, which starts at year 1970.
502.     DIM l AS _INTEGER64, l1 AS _INTEGER64, m AS _INTEGER64
503.     DIM d AS _INTEGER64, y AS _INTEGER64, i AS _INTEGER64
504.     DIM s AS _FLOAT
505.  
506.     l = INSTR(d$, "-")
507.     l1 = INSTR(l + 1, d$, "-")
508.     m = VAL(LEFT$(d$, l))
509.     d = VAL(MID$(d$, l + 1))
510.     y = VAL(MID$(d$, l1 + 1))
511.     IF y < 1970 THEN 'calculate shit backwards
512.         SELECT CASE m 'turn the day backwards for the month
513.             CASE 1, 3, 5, 7, 8, 10, 12: d = 31 - d '31 days
514.             CASE 2: d = 28 - d 'special 28 or 29.
515.             CASE 4, 6, 9, 11: d = 30 - d '30 days
516.         END SELECT
517.         IF y MOD 4 = 0 AND m < 3 THEN 'check for normal leap year, and we're before it...
518.             d = d + 1 'assume we had a leap year, subtract another day
519.             IF y MOD 100 = 0 AND y MOD 400 <> 0 THEN d = d - 1 'not a leap year if year is divisible by 100 and not 400
520.         END IF
521.  
522.         'then count the months that passed after the current month
523.         FOR i = m + 1 TO 12
524.             SELECT CASE i
525.                 CASE 2: d = d + 28
526.                 CASE 3, 5, 7, 8, 10, 12: d = d + 31
527.                 CASE 4, 6, 9, 11: d = d + 30
528.             END SELECT
529.         NEXT
530.  
531.         'we should now have the entered year calculated.  Now lets add in for each year from this point to 1970
532.         d = d + 365 * (1969 - y) '365 days per each standard year
533.         FOR i = 1968 TO y + 1 STEP -4 'from 1968 onwards,backwards, skipping the current year (which we handled previously in the FOR loop)
534.             d = d + 1 'subtract an extra day every leap year
535.             IF (i MOD 100) = 0 AND (i MOD 400) <> 0 THEN d = d - 1 'but skipping every year divisible by 100, but not 400
536.         NEXT
537.         s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
538.         TimeStamp## = -(s## + 24 * 60 * 60 - t##)
539.         EXIT FUNCTION
540.     ELSE
541.         y = y - 1970
542.     END IF
543.  
544.     FOR i = 1 TO m 'for this year,
545.         SELECT CASE i 'Add the number of days for each previous month passed
546.             CASE 1: d = d 'January doestn't have any carry over days.
547.             CASE 2, 4, 6, 8, 9, 11: d = d + 31
548.             CASE 3 'Feb might be a leap year
549.                 IF (y MOD 4) = 2 THEN 'if this year is divisible by 4 (starting in 1972)
550.                     d = d + 29 'its a leap year
551.                     IF (y MOD 100) = 30 AND (y MOD 400) <> 30 THEN 'unless..
552.                         d = d - 1 'the year is divisible by 100, and not divisible by 400
553.                     END IF
554.                 ELSE 'year not divisible by 4, no worries
555.                     d = d + 28
556.                 END IF
557.             CASE 5, 7, 10, 12: d = d + 30
558.         END SELECT
559.     NEXT
560.     d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
561.     FOR i = 2 TO y - 1 STEP 4 'from 1972 onwards, skipping the current year (which we handled previously in the FOR loopp)
562.         d = d + 1 'add an extra day every leap year
563.         IF (i MOD 100) = 30 AND (i MOD 400) <> 30 THEN d = d - 1 'but skiping every year divisible by 100, but not 400
564.     NEXT
565.     s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
566.     TimeStamp## = (s## + t##)
567. END FUNCTION
568.  

Use the same resource file above, and save this source in the Calendar directory before compiling it.  I can't see redoing the whole archive while this is still a definite work-in-progress, but I thought I'd go ahead and share what it looks like for now.

 

From this point, I'm going to externalize the holidays and also add events to the program, which the user can then add or edit with a few simple keystrokes or mouse clicks.  In the free space below our sun/moon information, there's room for me to display events such as:

Doctor's Appointment 2:45
Take dog to vet 4:25

I'm also thinking of scrolling daily news events to keep it vibrant and active, as well as possibly downloading the current weather conditions and forecast for the day from the web...

A project with a change from a simple calendar to print out and tack on the wall (though that will still be possible), to a full fledged scheduling tool.   

Title: Re: Calendar 2021
Post by: SMcNeill on December 26, 2020, 05:36:00 am

I've got my holiday list now, and it's format is finalized.  See if this seems simple enough to add to, and if there's anything obvious which I'm missing on here:

Code: [Select]

Holidays are stored in the format:   MONTH, Modifier, Day, Name
01, ON, 01, New Years Day
01, ON, 06, Epiphany
01, ON, 07, Orthodox Christmas Day
01, ON, 13, Stephen Foster Memorial Day
01, ON, 14, Orthodox New Year
01, THIRD, Monday, Martin Luther King Day
02, ON, 01, National Freedom Day
02, ON, 01, Start of Black History Month
02, ON, 02, Groundhog's Day
02, FIRST, Sunday, Super Bowl
02, ON, 12, Lincoln's Birthday
02, ON, 14, Valentine's Day
02, THIRD, Monday, President's Day
03, ON, 01, Start of Women's History Month
03, SECOND, Sunday, Start of Daylight Saving's Time
03, ON, 17, Saint Patrick's Day
03, ON, 29, National Vietnam War Vetern's Day
05, SECOND, Sunday, Mother's Day
05, LAST, Monday, Memorial Day
06, THIRD, Sunday, Father's Day
07, ON, 04, Independence Day
07, ON, 15, Tax Day
09, FIRST, Monday, Labor Day
09, ON, 25, Steve McNeill's Birthday
10, ON, 31, Halloween
11, ON, 01, All Saint's Day
11, FIRST, Sunday, End of Daylight Saving's Time
11, ON, 02, All Soul's Day
11, ON, 11, Vetern's Day
11, FOURTH, Thursday, Thanksgiving
12, ON, 07, Pearl Harbor Remembrance Day
12, ON, 24, Christmas Eve
12, ON, 25, Christmas Day
12, ON, 31, New Year's Eve
There's a few things which I know I missed, which are like Black Friday -- Friday after Thanksgiving...  Well, Thanksgiving is a moving target (fourth thursday in november), and Black Friday isn't necessarily the 4th friday in november.  (For example, Nov 1st is a friday, then the first thursday would be on the 7th, and thanksgiving on the 28th...  The 4th friday, in this case, would be on the 22nd...)

Days that are in relation to other days are something which are a little more complex to incorporate, and I'm not bothering with them at this time.  Holidays ON, on in relation to a month itself, are are I'm bothering with, at the moment.  ;)

Anyone see anything I missed?  Or something which seems wrong?  I'll be working this file into my little program for the next version, so if anyone has any thoughts or suggestions on it, now's the time to speak up and mention them.  :D

Title: Re: Calendar 2021
Post by: STxAxTIC on December 26, 2020, 05:56:16 am

Is it too soon to mention Easter?

I know, that one's a floater - but Kepler cracked it centuries ago... If the calculation is too tedious, I would just go grab a table.

Title: Re: Calendar 2021
Post by: SMcNeill on December 26, 2020, 06:16:25 am

Quote

Days that are in relation to other days are something which are a little more complex to incorporate, and I'm not bothering with them at this time.

Easter, Ash Wednesday, Good Friday, the seasons are all on this list.  Those are individual entries which will need some unique tweaking to work properly for us, but I'll probably end up sorting out some way to stick them in there before I'm all finished.  For now, it's one simple little alteration and addition at a time.  ;)

Title: Re: Calendar 2021
Post by: SMcNeill on December 26, 2020, 06:25:52 am

Here's a little test code to calculate and spit out the holidays from the list above for us.  Test it out and see if everything matches up like it should for us.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2.  
3. TYPE Holiday_type
4.     month AS INTEGER
5.     day AS INTEGER
6.     name AS STRING
7. END TYPE
8.  
9. REDIM SHARED HolidayList(0) AS Holiday_type
10.  
11.  
12. GetHolidays 2021
13. FOR i = 1 TO UBOUND(HolidayList)
14.     PRINT HolidayList(i).month, HolidayList(i).day, HolidayList(i).name
15. NEXT
16.  
17. SUB GetHolidays (year)
18.     f = FREEFILE
19.     IF _FILEEXISTS("Holidays.txt") = 0 THEN 'if the file doesn't exist, then create it with our default data
20.         OPEN "Holidays.txt" FOR OUTPUT AS #f
21.         PRINT #f, "Holidays are stored in the format:   MONTH, Modifier, Day, Name"
22.         PRINT #f, "01, ON, 01, New Years Day"
23.         PRINT #f, "01, ON, 06, Epiphany"
24.         PRINT #f, "01, ON, 07, Orthodox Christmas Day"
25.         PRINT #f, "01, ON, 13, Stephen Foster Memorial Day"
26.         PRINT #f, "01, ON, 14, Orthodox New Year"
27.         PRINT #f, "01, THIRD, Monday, Martin Luther King Day"
28.         PRINT #f, "02, ON, 01, National Freedom Day"
29.         PRINT #f, "02, ON, 01, Start of Black History Month"
30.         PRINT #f, "02, ON, 02, Groundhog's Day"
31.         PRINT #f, "02, FIRST, Sunday, Super Bowl"
32.         PRINT #f, "02, ON, 12, Lincoln's Birthday"
33.         PRINT #f, "02, ON, 14, Valentine's Day"
34.         PRINT #f, "02, THIRD, Monday, President's Day"
35.         PRINT #f, "03, ON, 01, Start of Women's History Month"
36.         PRINT #f, "03, SECOND, Sunday, Start of Daylight Saving's Time"
37.         PRINT #f, "03, ON, 17, Saint Patrick's Day"
38.         PRINT #f, "03, ON, 29, National Vietnam War Vetern's Day"
39.         PRINT #f, "05, SECOND, Sunday, Mother's Day"
40.         PRINT #f, "05, LAST, Monday, Memorial Day"
41.         PRINT #f, "06, THIRD, Sunday, Father's Day"
42.         PRINT #f, "07, ON, 04, Independence Day"
43.         PRINT #f, "07, ON, 15, Tax Day"
44.         PRINT #f, "09, FIRST, Monday, Labor Day"
45.         PRINT #f, "09, ON, 25, Steve McNeill's Birthday"
46.         PRINT #f, "10, ON, 31, Halloween"
47.         PRINT #f, "11, ON, 01, All Saint's Day"
48.         PRINT #f, "11, FIRST, Sunday, End of Daylight Saving's Time"
49.         PRINT #f, "11, ON, 02, All Soul's Day"
50.         PRINT #f, "11, ON, 11, Vetern's Day"
51.         PRINT #f, "11, FOURTH, Thursday, Thanksgiving"
52.         PRINT #f, "12, ON, 07, Pearl Harbor Remembrance Day"
53.         PRINT #f, "12, ON, 24, Christmas Eve"
54.         PRINT #f, "12, ON, 25, Christmas Day"
55.         PRINT #f, "12, ON, 31, New Year's Eve"
56.         CLOSE f
57.     END IF
58.     OPEN "Holidays.txt" FOR INPUT AS #f
59.     LINE INPUT #f, junk$ 'first line is file comment and not related to the data
60.     DO UNTIL EOF(f)
61.         INPUT #f, month
62.         INPUT #f, event$: event$ = UCASE$(event$)
63.         INPUT #f, day$
64.         INPUT #f, nam$
65.         '  PRINT month, event$, day$, nam$
66.         count = count + 1
67.         REDIM _PRESERVE HolidayList(count) AS Holiday_type
68.         HolidayList(count).month = month
69.         IF event$ = "ON" THEN
70.             HolidayList(count).day = VAL(day$)
71.         ELSEIF event$ = "LAST" THEN 'we need to count backwards to find the last target day
72.             d = ConvertDayToNum(day$)
73.             FOR i = NumberOfDays(month, year) TO 1 STEP -1
74.                 IF GetDay(month, i, year) = d THEN HolidayList(count).day = i: EXIT FOR
75.             NEXT
76.         ELSE 'we count forwards
77.             d = ConvertDayToNum(day$)
78.             FOR i = 1 TO NumberOfDays(month, year)
79.                 IF GetDay(month, i, year) = d THEN EXIT FOR
80.             NEXT
81.             SELECT CASE event$
82.                 CASE "FIRST": HolidayList(count).day = i
83.                 CASE "SECOND": HolidayList(count).day = i + 7
84.                 CASE "THIRD": HolidayList(count).day = i + 14
85.                 CASE "FOURTH": HolidayList(count).day = i + 21
86.                 CASE "FIFTH": HolidayList(count).day = i + 28
87.             END SELECT
88.         END IF
89.         HolidayList(count).name = nam$
90.     LOOP
91. END SUB
92.  
93. FUNCTION ConvertDayToNum (day$)
94.     SELECT CASE day$
95.         CASE "Sunday": ConvertDayToNum = 1
96.         CASE "Monday": ConvertDayToNum = 2
97.         CASE "Tuseday": ConvertDayToNum = 3
98.         CASE "Wednesday": ConvertDayToNum = 4
99.         CASE "Thursday": ConvertDayToNum = 5
100.         CASE "Friday": ConvertDayToNum = 6
101.         CASE "Saturday": ConvertDayToNum = 7
102.     END SELECT
103. END FUNCTION
104.  
105.  
106. FUNCTION GetDay (m, d, y) 'use 4 digit year
107.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
108.     mm = m: dd = d: yyyy = y
109.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
110.     century = yyyy MOD 100
111.     zerocentury = yyyy \ 100
112.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
113.     IF result = 0 THEN
114.         GetDay = 7
115.     ELSE
116.         GetDay = result
117.     END IF
118. END FUNCTION
119.  
120. FUNCTION IsLeapYear (yyyy) 'use 4 digit year
121.     IF GetDay(2, 29, yyyy) <> GetDay(3, 1, yyyy) THEN IsLeapYear = -1
122. END FUNCTION
123.  
124. FUNCTION NumberOfDays (month, year)
125.     SELECT CASE month
126.         CASE 1, 3, 5, 7, 8, 10, 12: NumberOfDays = 31
127.         CASE 2: IF IsLeapYear(year) THEN NumberOfDays = 29 ELSE NumberOfDays = 28
128.         CASE 4, 6, 9, 11: NumberOfDays = 30
129.     END SELECT
130. END SUB

Title: Re: Calendar 2021
Post by: SMcNeill on December 26, 2020, 08:46:24 pm

This whole calendar has now basically been reinvented in the way it operates.

Code: QB64: [Select]

1. CONST ShowGrid = -1
2. CONST ShowYear = 0
3. CONST DesiredYear = 2021
4. CONST ShowDays = -1
5. $COLOR:32
6.  
7. SCREEN _NEWIMAGE(1600, 720, 32)
8. _PRINTMODE _KEEPBACKGROUND
9. RANDOMIZE TIMER
10.  
11.  
12. TYPE Sun_Data_type
13.     field AS STRING
14.     value AS STRING
15. END TYPE
16.  
17.  
18. TYPE Holiday_type
19.     month AS INTEGER
20.     day AS INTEGER
21.     name AS STRING
22. END TYPE
23.  
24. REDIM SHARED Sun(0) AS Sun_Data_type
25. REDIM SHARED HolidayList(0) AS Holiday_type
26.  
27. DIM SHARED f72: f72 = _LOADFONT("OLDENGL.ttf", 72)
28. DIM SHARED f32: f32 = _LOADFONT("OLDENGL.ttf", 32)
29. DIM SHARED ThisMonth, Today, ThisYear
30. DIM SHARED BackGrounds(-12 TO 12)
31. DIM Lat AS _FLOAT, Lon AS _FLOAT
32.  
33. ThisMonth = VAL(DATE$)
34. Today = VAL(MID$(DATE$, 4))
35. ThisYear = VAL(RIGHT$(DATE$, 4))
36.  
37. Lat_Long Lat, Lon, 0 'get latitude and longitude, but no need to force them to redownload over and over,
38. '                     if we already have them saved on the disk.
39.  
40. SunStuff Lat, Lon, ThisMonth, Today, ThisYear
41. GetHolidays ThisYear
42.  
43. TitleScreen
44.  
45.  
46. update = -1
47.  
48.  
49. CurrentMonth = ThisMonth
50. CurrentDay = Today
51. Currentyear = ThisYear
52.  
53. DO
54.     IF update THEN
55.         CLS , SkyBlue
56.         reload: 'load our background
57.         IF bg >= -12 AND bg <= 12 THEN
58.             'We store 12 set backgrounds before and after our current month, which don't change.
59.             'But if we go any further than that, then we just use random backgrounds for extreme future events.
60.             'This is to give an impression of stability for most usage.
61.             'For example, I start up with an image of the moon on the screen for my current month.
62.             'I then scroll a few screens to see what is coming up in a few months, and then want to scroll back.
63.             'All I have to do is look for that visual cue of the image of the moon on my screen, as a quick reference guide.
64.  
65.             t$ = ".\Backgrounds\" + _TRIM$(STR$(BackGrounds(bg))) + ".jpg"
66.             t1 = _LOADIMAGE(t$, 32)
67.             IF t1 = -1 THEN 'if this is a bad background, then load a different one
68.                 redo:
69.                 t = INT(RND * 1088) + 1
70.                 FOR j = 1 TO i
71.                     IF BackGrounds(j) = t GOTO redo
72.                     IF t1 = -1 THEN GOTO redo
73.                 NEXT
74.                 BackGrounds(i) = t
75.                 GOTO reload
76.             END IF
77.         ELSE
78.             'But after a dozen months or so?  No need to keep those image handles in memory.  Just toss them,
79.             'as my poor memory couldn't store that much information anyway.  :P
80.  
81.             DO
82.                 t$ = ".\Backgrounds\" + _TRIM$(STR$(INT(RND * 1088) + 1)) + ".jpg"
83.                 t1 = _LOADIMAGE(t$, 32)
84.             LOOP UNTIL t1 < -1
85.         END IF
86.  
87.         _PUTIMAGE (0, 0)-(1283, 720), t1
88.         _FREEIMAGE t1
89.         IF ShowGrid THEN DrawLines
90.         CenterMonth CurrentMonth, Currentyear
91.         DrawDays CurrentMonth, Currentyear
92.         ShowDailyStuff Lat, Lon
93.         update = 0
94.     END IF
95.  
96.     k = _KEYHIT
97.     IF _KEYDOWN(100305) OR _KEYDOWN(100306) THEN
98.         SELECT CASE k
99.             CASE 19200 'left
100.                 CurrentMonth = CurrentMonth - 1
101.                 IF CurrentMonth < 1 THEN CurrentMonth = 12: Currentyear = Currentyear - 1
102.                 bg = bg - 1
103.                 update = -1
104.             CASE 19712 'right
105.                 CurrentMonth = CurrentMonth + 1
106.                 IF CurrentMonth > 12 THEN CurrentMonth = 1: Currentyear = Currentyear + 1
107.                 bg = bg + 1
108.                 update = -1
109.         END SELECT
110.     ELSE
111.         SELECT CASE k
112.             CASE 27 'ESC
113.                 SYSTEM
114.         END SELECT
115.     END IF
116.  
117.     _LIMIT 30
118.     _DISPLAY
119. LOOP
120.  
121.  
122.  
123.  
124. SUB ShowDailyStuff (Lat AS _FLOAT, Lon AS _FLOAT)
125.     _FONT f32
126.     COLOR Black
127.     LINE (1320, 50)-(1560, 500), Gold, BF
128.  
129.     cp = 1280 + (1600 - 1280) \ 2 'center of our non-calendar area
130.     t$ = ConvertToDay(GetDay(ThisMonth, Today, ThisYear)): _PRINTSTRING (cp - _PRINTWIDTH(t$) \ 2, 60), t$
131.     t$ = DATE$: _PRINTSTRING (cp - _PRINTWIDTH(t$) \ 2, 95), t$
132.     _FONT 16
133.     t$ = "For Lat/Long:" + STR$(INT(100 * Lat) / 100) + "," + STR$(INT(100 * Lon) / 100)
134.     _PRINTSTRING (1325, 130), t$
135.     _PRINTSTRING (1325, 156), "Sun Rise  : " + Sun(1).value
136.     _PRINTSTRING (1325, 174), "Sun Set   : " + Sun(2).value
137.     _PRINTSTRING (1325, 192), "Solar Noon: " + Sun(3).value
138.     _PRINTSTRING (1325, 210), "Day Length: " + Sun(4).value
139.     _PRINTSTRING (1325, 228), "Moon Phase: " + MoonPhase$(month, day, year)
140.     COLOR White
141.     _FONT f72
142.     EXIT SUB
143. END SUB
144.  
145.  
146.  
147.  
148.  
149. SUB TitleScreen
150.     _TITLE "Steve's Calendar"
151.     CLS , SkyBlue
152.     _FONT f72
153.     text$ = "Steve's Calendar"
154.     pw = _PRINTWIDTH(text$) \ 2
155.     _PRINTSTRING (800 - pw, 200), text$
156.     IF ShowYear THEN
157.         text$ = _TRIM$(STR$(DesiredYear))
158.     ELSE
159.         text$ = _TRIM$(STR$(ThisYear))
160.     END IF
161.     pw = _PRINTWIDTH(text$) \ 2
162.     _PRINTSTRING (800 - pw, 300), text$
163.     GetBackgrounds
164.     _FONT 16
165.     COLOR Black
166.     text$ = "Press <ANY KEY> to continue."
167.     pw = _PRINTWIDTH(text$) \ 2
168.     _PRINTSTRING (800 - pw, 400), text$
169.     COLOR White
170.     _FONT f72
171.     SLEEP 2
172. END SUB
173.  
174.  
175. SUB GetHolidays (year)
176.  
177.  
178.     f1 = FREEFILE
179.     IF _FILEEXISTS("Holidays.txt") = 0 THEN 'if the file doesn't exist, then create it with our default data
180.         OPEN "Holidays.txt" FOR OUTPUT AS #f1
181.         PRINT #f1, "Holidays are stored in the format:   MONTH, Modifier, Day, Name"
182.         PRINT #f1, "01, ON, 01, New Years Day"
183.         PRINT #f1, "01, ON, 06, Epiphany"
184.         PRINT #f1, "01, ON, 07, Orthodox Christmas Day"
185.         PRINT #f1, "01, ON, 13, Stephen Foster Memorial Day"
186.         PRINT #f1, "01, ON, 14, Orthodox New Year"
187.         PRINT #f1, "01, THIRD, Monday, Martin Luther King Day"
188.         PRINT #f1, "02, ON, 01, National Freedom Day"
189.         PRINT #f1, "02, ON, 01, Start of Black History Month"
190.         PRINT #f1, "02, ON, 02, Groundhog's Day"
191.         PRINT #f1, "02, FIRST, Sunday, Super Bowl"
192.         PRINT #f1, "02, ON, 12, Lincoln's Birthday"
193.         PRINT #f1, "02, ON, 14, Valentine's Day"
194.         PRINT #f1, "02, THIRD, Monday, President's Day"
195.         PRINT #f1, "03, ON, 01, Start of Women's History Month"
196.         PRINT #f1, "03, SECOND, Sunday, Start of Daylight Saving's Time"
197.         PRINT #f1, "03, ON, 17, Saint Patrick's Day"
198.         PRINT #f1, "03, ON, 29, National Vietnam War Vetern's Day"
199.         PRINT #f1, "05, SECOND, Sunday, Mother's Day"
200.         PRINT #f1, "05, LAST, Monday, Memorial Day"
201.         PRINT #f1, "06, THIRD, Sunday, Father's Day"
202.         PRINT #f1, "07, ON, 04, Independence Day"
203.         PRINT #f1, "07, ON, 15, Tax Day"
204.         PRINT #f1, "09, FIRST, Monday, Labor Day"
205.         PRINT #f1, "09, ON, 25, Steve McNeill's Birthday"
206.         PRINT #f1, "10, ON, 31, Halloween"
207.         PRINT #f1, "11, ON, 01, All Saint's Day"
208.         PRINT #f1, "11, FIRST, Sunday, End of Daylight Saving's Time"
209.         PRINT #f1, "11, ON, 02, All Soul's Day"
210.         PRINT #f1, "11, ON, 11, Vetern's Day"
211.         PRINT #f1, "11, FOURTH, Thursday, Thanksgiving"
212.         PRINT #f1, "12, ON, 07, Pearl Harbor Remembrance Day"
213.         PRINT #f1, "12, ON, 24, Christmas Eve"
214.         PRINT #f1, "12, ON, 25, Christmas Day"
215.         PRINT #f1, "12, ON, 31, New Year's Eve"
216.         CLOSE f1
217.     END IF
218.     OPEN "Holidays.txt" FOR INPUT AS #f1
219.     LINE INPUT #f1, junk$ 'first line is file comment and not related to the data
220.     DO UNTIL EOF(f1)
221.         INPUT #f1, month
222.         INPUT #f1, event$: event$ = UCASE$(event$)
223.         INPUT #f1, day$
224.         INPUT #f1, nam$
225.         '  PRINT month, event$, day$, nam$
226.         count = count + 1
227.         REDIM _PRESERVE HolidayList(count) AS Holiday_type
228.         HolidayList(count).month = month
229.         IF event$ = "ON" THEN
230.             HolidayList(count).day = VAL(day$)
231.         ELSEIF RIGHT$(event$, 4) = "LAST" THEN 'we need to count backwards to find the last target day
232.             d = ConvertDayToNum(day$)
233.             FOR i = NumberOfDays(month, year) TO 1 STEP -1
234.                 IF GetDay(month, i, year) = d THEN EXIT FOR
235.             NEXT
236.             SELECT CASE event$
237.                 CASE "LAST": HolidayList(count).day = i
238.                 CASE "SECOND TO LAST": HolidayList(count).day = i - 7
239.                 CASE "THIRD TO LAST": HolidayList(count).day = i - 14
240.                 CASE "FOURTH TO LAST": HolidayList(count).day = i - 21
241.                 CASE "FIFTH TO LAST": HolidayList(count).day = i - 28
242.             END SELECT
243.         ELSE 'we count forwards
244.             d = ConvertDayToNum(day$)
245.             FOR i = 1 TO NumberOfDays(month, year)
246.                 IF GetDay(month, i, year) = d THEN EXIT FOR
247.             NEXT
248.             SELECT CASE event$
249.                 CASE "FIRST": HolidayList(count).day = i
250.                 CASE "SECOND": HolidayList(count).day = i + 7
251.                 CASE "THIRD": HolidayList(count).day = i + 14
252.                 CASE "FOURTH": HolidayList(count).day = i + 21
253.                 CASE "FIFTH": HolidayList(count).day = i + 28
254.             END SELECT
255.         END IF
256.         HolidayList(count).name = nam$
257.  
258.  
259.         '*******************************************************************
260.         '**   Special Exceptions for days which are hard to calculate otherwise
261.         '*******************************************************************
262.  
263.         IF HolidayList(count).name = "Thanksgiving" THEN 'Add Black Friday and Cyber Monday
264.             d = HolidayList(count).day
265.             count = count + 2
266.             REDIM _PRESERVE HolidayList(count) AS Holiday_type
267.             HolidayList(count - 1).month = 11
268.             HolidayList(count - 1).day = d + 1
269.             HolidayList(count - 1).name = "Black Fridy"
270.             d = HolidayList(count - 1).day + 4
271.             HolidayList(count).month = 11
272.             IF d > 30 THEN d = d - 30: HolidayList(count).month = 12
273.             HolidayList(count).day = d
274.             HolidayList(count).name = "Cyber Monday"
275.         END IF
276.     LOOP
277.     CLOSE #f1
278.  
279.     '*******************************************************************
280.     '**   Seasons, which are on a simple look-up table
281.     '*******************************************************************
282.     IF _FILEEXISTS("Seasons.txt") = 0 THEN
283.         OPEN "Seasons.txt" FOR OUTPUT AS #f1
284.         PRINT #f1, "2016, 20, Mar, 04:30 GMT, 20, Jun, 23:34 BST, 22, Sep, 15:21 BST, 21, Dec, 10:44 GMT"
285.         PRINT #f1, "2017, 20, Mar, 10:29 GMT, 21, Jun, 05:24 BST, 22, Sep, 21:02 BST, 21, Dec, 16:28 GMT"
286.         PRINT #f1, "2018, 20, Mar, 16:15 GMT, 21, Jun, 11:07 BST, 23, Sep, 02:54 BST, 21, Dec, 22:23 GMT"
287.         PRINT #f1, "2019, 20, Mar, 21:59 GMT, 21, Jun, 16:54 BST, 23, Sep, 08:50 BST, 22, Dec, 04:19 GMT"
288.         PRINT #f1, "2020, 20, Mar, 03:50 GMT, 20, Jun, 22:44 BST, 22, Sep, 14:31 BST, 21, Dec, 10:02 GMT"
289.         PRINT #f1, "2021, 20, Mar, 09:37 GMT, 21, Jun, 04:32 BST, 22, Sep, 20:21 BST, 21, Dec, 15:59 GMT"
290.         PRINT #f1, "2022, 20, Mar, 15:33 GMT, 21, Jun, 10:14 BST, 23, Sep, 02:04 BST, 21, Dec, 21:48 GMT"
291.         PRINT #f1, "2023, 20, Mar, 21:24 GMT, 21, Jun, 15:58 BST, 23, Sep, 07:50 BST, 22, Dec, 03:27 GMT"
292.         PRINT #f1, "2024, 20, Mar, 03:06 GMT, 20, Jun, 21:51 BST, 22, Sep, 13:43 BST, 21, Dec, 09:20 GMT"
293.         PRINT #f1, "2025, 20, Mar, 09:01 GMT, 21, Jun, 03:42 BST, 22, Sep, 19:19 BST, 21, Dec, 15:03 GMT"
294.         PRINT #f1, "2026, 20, Mar, 14:46 GMT, 21, Jun, 09:24 BST, 23, Sep, 01:05 BST, 21, Dec, 20:50 GMT"
295.         PRINT #f1, "2027, 20, Mar, 20:25 GMT, 21, Jun, 15:11 BST, 23, Sep, 07:02 BST, 22, Dec, 02:42 GMT"
296.         PRINT #f1, "2028, 20, Mar, 02:17 GMT, 20, Jun, 21:02 BST, 22, Sep, 12:45 BST, 21, Dec, 08:20 GMT"
297.         PRINT #f1, "2029, 20, Mar, 08:02 GMT, 21, Jun, 02:48 BST, 22, Sep, 18:38 BST, 21, Dec, 14:14 GMT"
298.         PRINT #f1, "2030, 20, Mar, 13:52 GMT, 21, Jun, 08:31 BST, 23, Sep, 00:27 BST, 21, Dec, 20:09 GMT"
299.         PRINT #f1, "2031, 20, Mar, 19:41 GMT, 21, Jun, 14:17 BST, 23, Sep, 06:15 BST, 22, Dec, 01:55 GMT"
300.         PRINT #f1, "2032, 20, Mar, 01:22 GMT, 20, Jun, 20:09 BST, 22, Sep, 12:11 BST, 21, Dec, 07:56 GMT"
301.         PRINT #f1, "2033, 20, Mar, 07:23 GMT, 21, Jun, 02:01 BST, 22, Sep, 17:51 BST, 21, Dec, 13:46 GMT"
302.         PRINT #f1, "2034, 20, Mar, 13:17 GMT, 21, Jun, 07:44 BST, 22, Sep, 23:39 BST, 21, Dec, 19:34 GMT"
303.         PRINT #f1, "2035, 20, Mar, 19:02 GMT, 21, Jun, 13:33 BST, 23, Sep, 05:39 BST, 22, Dec, 01:31 GMT"
304.         PRINT #f1, "2036, 20, Mar, 01:03 GMT, 20, Jun, 19:32 BST, 22, Sep, 11:23 BST, 21, Dec, 07:13 GMT"
305.         PRINT #f1, "2037, 20, Mar, 06:50 GMT, 21, Jun, 01:22 BST, 22, Sep, 17:13 BST, 21, Dec, 13:08 GMT"
306.         PRINT #f1, "2038, 20, Mar, 12:41 GMT, 21, Jun, 07:09 BST, 22, Sep, 23:02 BST, 21, Dec, 19:02 GMT"
307.         PRINT #f1, "2039, 20, Mar, 18:32 GMT, 21, Jun, 12:57 BST, 23, Sep, 04:49 BST, 22, Dec, 00:40 GMT"
308.         PRINT #f1, "2040, 20, Mar, 00:11 GMT, 20, Jun, 18:46 BST, 22, Sep, 10:45 BST, 21, Dec, 06:33 GMT"
309.         PRINT #f1, "2041, 20, Mar, 06:07 GMT, 21, Jun, 00:36 BST, 22, Sep, 16:26 BST, 21, Dec, 12:18 GMT"
310.         PRINT #f1, "2042, 20, Mar, 11:53 GMT, 21, Jun, 06:16 BST, 22, Sep, 22:11 BST, 21, Dec, 18:04 GMT"
311.         PRINT #f1, "2043, 20, Mar, 17:28 GMT, 21, Jun, 11:58 BST, 23, Sep, 04:07 BST, 22, Dec, 00:01 GMT"
312.         PRINT #f1, "2044, 19, Mar, 23:20 GMT, 20, Jun, 17:51 BST, 22, Sep, 09:48 BST, 21, Dec, 05:43 GMT"
313.         PRINT #f1, "2045, 20, Mar, 05:07 GMT, 20, Jun, 23:34 BST, 22, Sep, 15:33 BST, 21, Dec, 11:35 GMT"
314.         PRINT #f1, "2046, 20, Mar, 10:58 GMT, 21, Jun, 05:14 BST, 22, Sep, 21:21 BST, 21, Dec, 17:28 GMT"
315.         PRINT #f1, "2047, 20, Mar, 16:52 GMT, 21, Jun, 11:03 BST, 23, Sep, 03:08 BST, 21, Dec, 23:07 GMT"
316.         PRINT #f1, "2048, 19, Mar, 22:34 GMT, 20, Jun, 16:54 BST, 22, Sep, 09:00 BST, 21, Dec, 05:02 GMT"
317.         PRINT #f1, "2049, 20, Mar, 04:28 GMT, 20, Jun, 22:47 BST, 22, Sep, 14:42 BST, 21, Dec, 10:52 GMT"
318.         PRINT #f1, "2050, 20, Mar, 10:19 GMT, 21, Jun, 04:33 BST, 22, Sep, 20:28 BST, 21, Dec, 16:38 GMT"
319.         PRINT #f1, "2051, 20, Mar, 15:59 GMT, 21, Jun, 10:18 BST, 23, Sep, 02:27 BST, 21, Dec, 22:34 GMT"
320.         PRINT #f1, "2052, 19, Mar, 21:56 GMT, 20, Jun, 16:16 BST, 22, Sep, 08:15 BST, 21, Dec, 04:17 GMT"
321.         PRINT #f1, "2053, 20, Mar, 03:47 GMT, 20, Jun, 22:04 BST, 22, Sep, 14:06 BST, 21, Dec, 10:10 GMT"
322.         PRINT #f1, "2054, 20, Mar, 09:34 GMT, 21, Jun, 03:47 BST, 22, Sep, 19:59 BST, 21, Dec, 16:10 GMT"
323.         PRINT #f1, "2055, 20, Mar, 15:28 GMT, 21, Jun, 09:40 BST, 23, Sep, 01:48 BST, 21, Dec, 21:55 GMT"
324.         PRINT #f1, "2056, 19, Mar, 21:11 GMT, 20, Jun, 15:28 BST, 22, Sep, 07:39 BST, 21, Dec, 03:51 GMT"
325.         PRINT #f1, "2057, 20, Mar, 03:08 GMT, 20, Jun, 21:19 BST, 22, Sep, 13:23 BST, 21, Dec, 09:43 GMT"
326.         PRINT #f1, "2058, 20, Mar, 09:05 GMT, 21, Jun, 03:04 BST, 22, Sep, 19:08 BST, 21, Dec, 15:25 GMT"
327.         PRINT #f1, "2059, 20, Mar, 14:44 GMT, 21, Jun, 08:47 BST, 23, Sep, 01:03 BST, 21, Dec, 21:18 GMT"
328.         PRINT #f1, "2060, 19, Mar, 20:38 GMT, 20, Jun, 14:45 BST, 22, Sep, 06:48 BST, 21, Dec, 03:01 GMT"
329.         PRINT #f1, "2061, 20, Mar, 02:26 GMT, 20, Jun, 20:32 BST, 22, Sep, 12:31 BST, 21, Dec, 08:49 GMT"
330.         PRINT #f1, "2062, 20, Mar, 08:07 GMT, 21, Jun, 02:11 BST, 22, Sep, 18:20 BST, 21, Dec, 14:42 GMT"
331.         PRINT #f1, "2063, 20, Mar, 13:59 GMT, 21, Jun, 08:02 BST, 23, Sep, 00:08 BST, 21, Dec, 20:21 GMT"
332.         PRINT #f1, "2064, 19, Mar, 19:38 GMT, 20, Jun, 13:45 BST, 22, Sep, 05:57 BST, 21, Dec, 02:09 GMT"
333.         PRINT #f1, "2065, 20, Mar, 01:28 GMT, 20, Jun, 19:32 BST, 22, Sep, 11:42 BST, 21, Dec, 08:00 GMT"
334.         PRINT #f1, "2066, 20, Mar, 07:20 GMT, 21, Jun, 01:16 BST, 22, Sep, 17:27 BST, 21, Dec, 13:45 GMT"
335.         PRINT #f1, "2067, 20, Mar, 12:53 GMT, 21, Jun, 06:56 BST, 22, Sep, 23:19 BST, 21, Dec, 19:43 GMT"
336.         PRINT #f1, "2068, 19, Mar, 18:49 GMT, 20, Jun, 12:53 BST, 22, Sep, 05:07 BST, 21, Dec, 01:32 GMT"
337.         PRINT #f1, "2069, 20, Mar, 00:45 GMT, 20, Jun, 18:41 BST, 22, Sep, 10:51 BST, 21, Dec, 07:22 GMT"
338.         PRINT #f1, "2070, 20, Mar, 06:34 GMT, 21, Jun, 00:22 BST, 22, Sep, 16:45 BST, 21, Dec, 13:19 GMT"
339.         PRINT #f1, "2071, 20, Mar, 12:34 GMT, 21, Jun, 06:21 BST, 22, Sep, 22:37 BST, 21, Dec, 19:04 GMT"
340.         PRINT #f1, "2072, 19, Mar, 18:21 GMT, 20, Jun, 12:13 BST, 22, Sep, 04:27 BST, 21, Dec, 00:56 GMT"
341.         PRINT #f1, "2073, 20, Mar, 00:13 GMT, 20, Jun, 18:07 BST, 22, Sep, 10:15 BST, 21, Dec, 06:50 GMT"
342.         PRINT #f1, "2074, 20, Mar, 06:09 GMT, 20, Jun, 23:58 BST, 22, Sep, 16:03 BST, 21, Dec, 12:35 GMT"
343.         PRINT #f1, "2075, 20, Mar, 11:46 GMT, 21, Jun, 05:40 BST, 22, Sep, 21:59 BST, 21, Dec, 18:27 GMT"
344.         PRINT #f1, "2076, 19, Mar, 17:39 GMT, 20, Jun, 11:36 BST, 22, Sep, 03:50 BST, 21, Dec, 00:13 GMT"
345.         PRINT #f1, "2077, 19, Mar, 23:31 GMT, 20, Jun, 17:23 BST, 22, Sep, 09:36 BST, 21, Dec, 06:01 GMT"
346.         PRINT #f1, "2078, 20, Mar, 05:11 GMT, 20, Jun, 22:58 BST, 22, Sep, 15:24 BST, 21, Dec, 11:58 GMT"
347.         PRINT #f1, "2079, 20, Mar, 11:00 GMT, 21, Jun, 04:49 BST, 22, Sep, 21:13 BST, 21, Dec, 17:44 GMT"
348.         PRINT #f1, "2080, 19, Mar, 16:44 GMT, 20, Jun, 10:34 BST, 22, Sep, 02:56 BST, 20, Dec, 23:33 GMT"
349.         PRINT #f1, "2081, 19, Mar, 22:34 GMT, 20, Jun, 16:16 BST, 22, Sep, 08:37 BST, 21, Dec, 05:22 GMT"
350.         PRINT #f1, "2082, 20, Mar, 04:30 GMT, 20, Jun, 22:03 BST, 22, Sep, 14:23 BST, 21, Dec, 11:04 GMT"
351.         PRINT #f1, "2083, 20, Mar, 10:10 GMT, 21, Jun, 03:44 BST, 22, Sep, 20:11 BST, 21, Dec, 16:53 GMT"
352.         PRINT #f1, "2084, 19, Mar, 15:59 GMT, 20, Jun, 09:40 BST, 22, Sep, 01:59 BST, 20, Dec, 22:41 GMT"
353.         PRINT #f1, "2085, 19, Mar, 21:53 GMT, 20, Jun, 15:33 BST, 22, Sep, 07:43 BST, 21, Dec, 04:28 GMT"
354.         PRINT #f1, "2086, 20, Mar, 03:35 GMT, 20, Jun, 21:09 BST, 22, Sep, 13:32 BST, 21, Dec, 10:22 GMT"
355.         PRINT #f1, "2087, 20, Mar, 09:28 GMT, 21, Jun, 03:06 BST, 22, Sep, 19:28 BST, 21, Dec, 16:08 GMT"
356.         PRINT #f1, "2088, 19, Mar, 15:17 GMT, 20, Jun, 08:56 BST, 22, Sep, 01:18 BST, 20, Dec, 21:56 GMT"
357.         PRINT #f1, "2089, 19, Mar, 21:06 GMT, 20, Jun, 14:43 BST, 22, Sep, 07:07 BST, 21, Dec, 03:52 GMT"
358.         PRINT #f1, "2090, 20, Mar, 03:02 GMT, 20, Jun, 20:36 BST, 22, Sep, 12:59 BST, 21, Dec, 09:43 GMT"
359.         PRINT #f1, "2091, 20, Mar, 08:42 GMT, 21, Jun, 02:19 BST, 22, Sep, 18:51 BST, 21, Dec, 15:38 GMT"
360.         PRINT #f1, "2092, 19, Mar, 14:33 GMT, 20, Jun, 08:15 BST, 22, Sep, 00:42 BST, 20, Dec, 21:32 GMT"
361.         PRINT #f1, "2093, 19, Mar, 20:34 GMT, 20, Jun, 14:07 BST, 22, Sep, 06:29 BST, 21, Dec, 03:21 GMT"
362.         PRINT #f1, "2094, 20, Mar, 02:21 GMT, 20, Jun, 19:42 BST, 22, Sep, 12:16 BST, 21, Dec, 09:13 GMT"
363.         PRINT #f1, "2095, 20, Mar, 08:15 GMT, 21, Jun, 01:39 BST, 22, Sep, 18:11 BST, 21, Dec, 15:01 GMT"
364.         PRINT #f1, "2096, 19, Mar, 14:03 GMT, 20, Jun, 07:31 BST, 21, Sep, 23:55 BST, 20, Dec, 20:46 GMT"
365.         PRINT #f1, "2097, 19, Mar, 19:48 GMT, 20, Jun, 13:13 BST, 22, Sep, 05:36 BST, 21, Dec, 02:37 GMT"
366.         PRINT #f1, "2098, 20, Mar, 01:40 GMT, 20, Jun, 19:03 BST, 22, Sep, 11:24 BST, 21, Dec, 08:21 GMT"
367.         PRINT #f1, "2099, 20, Mar, 07:17 GMT, 21, Jun, 00:41 BST, 22, Sep, 17:11 BST, 21, Dec, 14:04 GMT"
368.         CLOSE #f1
369.     END IF
370.     IF year > 2015 AND year < 2100 THEN
371.         count = count + 4
372.         REDIM _PRESERVE HolidayList(count) AS Holiday_type
373.         HolidayList(count - 3).month = 3: HolidayList(count - 3).name = "Spring Starts"
374.         HolidayList(count - 2).month = 6: HolidayList(count - 2).name = "Summer Starts"
375.         HolidayList(count - 1).month = 9: HolidayList(count - 1).name = "Autumn Starts"
376.         HolidayList(count).month = 12: HolidayList(count).name = "Winter Starts"
377.         HolidayList(count - 1).day = d + 1
378.         OPEN "Seasons.txt" FOR INPUT AS #f1
379.         DO UNTIL EOF(1)
380.             INPUT #f1, y
381.             INPUT #f1, HolidayList(count - 3).day
382.             INPUT #f1, junk$
383.             INPUT #f1, junk$
384.             INPUT #f1, HolidayList(count - 2).day
385.             INPUT #f1, junk$
386.             INPUT #f1, junk$
387.             INPUT #f1, HolidayList(count - 1).day
388.             INPUT #f1, junk$
389.             INPUT #f1, junk$
390.             INPUT #f1, HolidayList(count).day
391.             INPUT #f1, junk$
392.             INPUT #f1, junk$
393.             IF y = year THEN EXIT DO
394.         LOOP
395.         CLOSE #f1
396.     END IF
397. END SUB
398.  
399.  
400. SUB GetBackgrounds
401.     FOR i = -12 TO 12
402.         redo:
403.         t = INT(RND * 1088) + 1
404.         FOR j = -12 TO i
405.             IF BackGrounds(j) = t GOTO redo
406.         NEXT
407.         BackGrounds(i) = t
408.     NEXT
409. END SUB
410.  
411. SUB CenterMonth (month, year)
412.     _FONT f72
413.     SELECT CASE month
414.         CASE 1: text$ = "January"
415.         CASE 2: text$ = "February"
416.         CASE 3: text$ = "March"
417.         CASE 4: text$ = "April"
418.         CASE 5: text$ = "May"
419.         CASE 6: text$ = "June"
420.         CASE 7: text$ = "July"
421.         CASE 8: text$ = "August"
422.         CASE 9: text$ = "September"
423.         CASE 10: text$ = "October"
424.         CASE 11: text$ = "November"
425.         CASE 12: text$ = "December"
426.     END SELECT
427.     text$ = text$ + STR$(year)
428.     pw = _PRINTWIDTH(text$) / 2
429.     _PRINTSTRING (640 - pw, 0), text$
430. END SUB
431.  
432.  
433. SUB DrawLines
434.     TopOffset = 72
435.  
436.     IF ShowDays THEN
437.         LINE (0, TopOffset)-STEP(1280, 3), _RGBA(128, 128, 64, 160), BF
438.         FOR i = 0 TO 7
439.             LINE (i * 1280 / 7, 0 + TopOffset)-STEP(3, 40), _RGBA32(128, 128, 64, 160), BF
440.         NEXT
441.         TopOffset = TopOffset + 40
442.     END IF
443.     FOR i = 0 TO 6
444.         LINE (0, i * 90 + TopOffset)-STEP(1280, 3), _RGBA32(128, 128, 64, 160), BF
445.     NEXT
446.     FOR i = 0 TO 7
447.         LINE (i * 1280 / 7, 0 + TopOffset)-STEP(3, 540), _RGBA32(128, 128, 64, 160), BF
448.     NEXT
449. END SUB
450.  
451. FUNCTION ConvertToDay$ (day) 'Function to return a string for a day
452.     SELECT CASE day
453.         CASE 1: ConvertToDay$ = "Sunday"
454.         CASE 2: ConvertToDay$ = "Monday"
455.         CASE 3: ConvertToDay$ = "Tuesday"
456.         CASE 4: ConvertToDay$ = "Wednesday"
457.         CASE 5: ConvertToDay$ = "Thursday"
458.         CASE 6: ConvertToDay$ = "Friday"
459.         CASE 7: ConvertToDay$ = "Saturday"
460.     END SELECT
461. END FUNCTION
462.  
463. SUB DrawDays (month, year)
464.     SHARED highlightday
465.     REDIM Holidays(0) AS STRING
466.     TopOffset = 76
467.     IF ShowDays THEN
468.         _FONT f32
469.         bw = 1280 \ 7
470.         FOR i = 1 TO 7
471.             t$ = ConvertToDay(i)
472.             pw = _PRINTWIDTH(t$) \ 2
473.             _PRINTSTRING (bw * (i - 1) + bw \ 2 - pw, 80), t$
474.         NEXT
475.         TopOffset = TopOffset + 40
476.         _FONT f72
477.     END IF
478.  
479.     nod = NumberOfDays(month, year)
480.     y = 0
481.     FOR i = 1 TO nod
482.         text$ = _TRIM$(STR$(i))
483.         pw = _PRINTWIDTH(text$)
484.         x = GetDay(month, i, year)
485.         IF month = ThisMonth AND i = Today AND ThisYear = year THEN LINE ((x - 1) * 1280 / 7 + 3, y * 90 + TopOffset)-STEP(1280 / 7 - 3, 86), _RGBA32(128, 128, 128, 128), BF
486.         _PRINTSTRING (x * 1280 / 7 - pw, y * 90 + TopOffset), text$
487.  
488.         '
489.  
490.  
491.         u = UBOUND(HolidayList)
492.         IF u > 0 THEN
493.             _FONT 8
494.             count = 0
495.             FOR j = 1 TO u
496.                 IF month = HolidayList(j).month AND i = HolidayList(j).day THEN
497.                     count = count + 1
498.                     _PRINTSTRING ((x - 1) * 1280 / 7 + 4, (y + 1) * 90 + TopOffset - 5 - count * 8), LEFT$(HolidayList(j).name, 22)
499.                 END IF
500.             NEXT
501.             _FONT f72
502.         END IF
503.         IF x = 7 THEN y = y + 1
504.     NEXT
505. END SUB
506.  
507.  
508. FUNCTION NumberOfDays (month, year)
509.     SELECT CASE month
510.         CASE 1, 3, 5, 7, 8, 10, 12: NumberOfDays = 31
511.         CASE 2: IF IsLeapYear(year) THEN NumberOfDays = 29 ELSE NumberOfDays = 28
512.         CASE 4, 6, 9, 11: NumberOfDays = 30
513.     END SELECT
514. END SUB
515.  
516.  
517. FUNCTION IsLeapYear (yyyy) 'use 4 digit year
518.     IF GetDay(2, 29, yyyy) <> GetDay(3, 1, yyyy) THEN IsLeapYear = -1
519. END FUNCTION
520.  
521. FUNCTION GetDay (m, d, y) 'use 4 digit year
522.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
523.     mm = m: dd = d: yyyy = y
524.     IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
525.     century = yyyy MOD 100
526.     zerocentury = yyyy \ 100
527.     result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
528.     IF result = 0 THEN
529.         GetDay = 7
530.     ELSE
531.         GetDay = result
532.     END IF
533.     'Function changed to return a numeric value instead of a string for this program
534.     '    SELECT CASE result
535.     '        CASE 7: GetDay$ = "Saturday"
536.     '        CASE 1: GetDay$ = "Sunday"
537.     '        CASE 2: GetDay$ = "Monday"
538.     '        CASE 3: GetDay$ = "Tuesday"
539.     '        CASE 4: GetDay$ = "Wednesday"
540.     '        CASE 5: GetDay$ = "Thursday"
541.     '        CASE 6: GetDay$ = "Friday"
542.     '    END SELECT
543. END FUNCTION
544.  
545.  
546. FUNCTION GetPublicIP$ (force)
547.  
548.     f1 = FREEFILE
549.     IF force = -1 OR _FILEEXISTS("PIP.txt") = 0 THEN
550.         OPEN "PIP.txt" FOR OUTPUT AS #f1: CLOSE f1
551.         SHELL _HIDE "cmd /c nslookup myip.opendns.com resolver1.opendns.com>PIP.txt"
552.     END IF
553.  
554.     OPEN "PIP.txt" FOR INPUT AS #f1
555.     IF LOF(f1) THEN
556.         DO
557.             LINE INPUT #f1, temp$
558.             IF temp$ <> "" THEN last$ = temp$ 'there's a blank line after the data we need.
559.             '                                 Ignore it.  What we want is the last line of info generated here.
560.         LOOP UNTIL EOF(1)
561.         l = _INSTRREV(last$, "Address:")
562.         IF l THEN GetPublicIP$ = MID$(last$, l + 10)
563.     END IF
564.     CLOSE f1
565. END FUNCTION
566.  
567. SUB Lat_Long (lat AS _FLOAT, lon AS _FLOAT, force)
568.     ip$ = GetPublicIP$(0)
569.     IF force = -1 OR _FILEEXISTS("LatAndLong.txt") = 0 THEN
570.         DownloadURL "ip-api.com/line/" + ip$ + "?fields=lat,lon", "LatAndLong.txt"
571.     END IF
572.     f1 = FREEFILE
573.     OPEN "LatAndLong.txt" FOR INPUT AS #f1
574.     IF LOF(f1) = 0 THEN CLOSE f1: EXIT SUB 'something didn't download.  this info isn't available to parse.
575.     INPUT #f1, lat
576.     INPUT #f1, lon
577.     CLOSE f1
578. END SUB
579.  
580. SUB DownloadURL (link$, file$)
581.     f1 = FREEFILE
582.     OPEN file$ FOR OUTPUT AS #f1: CLOSE #f1 'erase any old file of the same name
583.     $IF WIN THEN
584.         out$ = "powershell.exe -c " + CHR$(34) + "Invoke-Webrequest '" + link$ + "' -OutFile '" + file$ + "'" + CHR$(34)
585.     $ELSE
586.         out$ = "wget " + chr$(34) + link$ + " -O " + file$ + chr$(34)
587.     $END IF
588.     SHELL _HIDE out$
589. END SUB
590.  
591. FUNCTION GetHour (fromTime$) 'time should be hh:mm:ss WhateverM
592.     l = INSTR(fromTime$, ":") '1st :
593.     GetHour = VAL(LEFT$(fromTime$, l))
594. END SUB
595.  
596. FUNCTION GetMinute (fromTime$) 'time should be hh:mm:ss WhateverM
597.     l = INSTR(fromTime$, ":") '1st :
598.     GetMinute = VAL(MID$(fromTime$, l + 1))
599. END SUB
600.  
601.  
602. FUNCTION GetSecond (fromTime$) 'time should be hh:mm:ss WhateverM
603.     l = INSTR(fromTime$, ":") '1st :
604.     l = INSTR(l + 1, fromTime$, ":") '2nd :
605.     GetSecond = VAL(MID$(fromTime$, l + 1))
606. END SUB
607.  
608.  
609. FUNCTION GetTimeOffset
610.     $IF WIN THEN
611.         TYPE SYSTEMTIME
612.             wYear AS _UNSIGNED INTEGER
613.             wMonth AS _UNSIGNED INTEGER
614.             wDayOfWeek AS _UNSIGNED INTEGER
615.             wDay AS _UNSIGNED INTEGER
616.             wHour AS _UNSIGNED INTEGER
617.             wMinute AS _UNSIGNED INTEGER
618.             wSecond AS _UNSIGNED INTEGER
619.             wMilliseconds AS _UNSIGNED INTEGER
620.         END TYPE
621.  
622.         TYPE TIME_ZONE_INFORMATION
623.             Bias AS LONG
624.             StandardName AS STRING * 64 'WCHAR      StandardName[32];
625.             StandardDate AS SYSTEMTIME
626.             StandardBias AS LONG
627.             DaylightName AS STRING * 64 'WCHAR      DaylightName[32];
628.             DaylightDate AS SYSTEMTIME
629.             DaylightBias AS LONG
630.         END TYPE
631.  
632.         DECLARE DYNAMIC LIBRARY "Kernel32"
633.             SUB GetTimeZoneInformation (t AS TIME_ZONE_INFORMATION)
634.         END DECLARE
635.  
636.         DIM t AS TIME_ZONE_INFORMATION
637.         GetTimeZoneInformation t
638.         GetTimeOffset = t.Bias
639.     $END IF
640. END SUB
641.  
642.  
643.  
644. SUB SunStuff (lat, lon, month, day, year)
645.     STATIC f
646.     d$ = _TRIM$(STR$(year)) + _TRIM$(STR$(month)) + _TRIM$(STR$(day))
647.     link$ = "https://api.sunrise-sunset.org/json?lat=" + _TRIM$(STR$(lat)) + "&lng="
648.     link$ = link$ + _TRIM$(STR$(lon)) + "&date=" + d$
649.     DownloadURL link$, "temp.txt"
650.     f = FREEFILE
651.     OPEN "temp.txt" FOR BINARY AS #f
652.  
653.     IF LOF(f) = 0 THEN CLOSE f: EXIT SUB 'something didn't download.  this info isn't available to parse.
654.  
655.     t$ = SPACE$(LOF(f))
656.     GET #1, 1, t$
657.     CLOSE f
658.  
659.     'strip off unwanted stuff
660.     l = INSTR(t$, ":{"): t$ = MID$(t$, l + 2) 'junk left of our initial data
661.     DO
662.         l = INSTR(t$, CHR$(34))
663.         t$ = LEFT$(t$, l - 1) + MID$(t$, l + 1) 'remove all quotes completely from this data
664.     LOOP UNTIL l = 0
665.     DO
666.         l = INSTR(t$, "_")
667.         t$ = LEFT$(t$, l - 1) + " " + MID$(t$, l + 1) 'change all underscores to spaces in this data
668.     LOOP UNTIL l = 0
669.     t$ = _TRIM$(t$)
670.     t$ = LEFT$(t$, LEN(t$) - 12) 'remove the last end of data }
671.     PRINT t$
672.  
673.     'parse it down to field, data
674.     DO
675.         l = INSTR(t$, ",")
676.         IF l = 0 THEN EXIT DO
677.         count = count + 1
678.         REDIM _PRESERVE Sun(count) AS Sun_Data_type
679.         whole$ = LEFT$(t$, l)
680.         Sun(count).field = LEFT$(whole$, INSTR(whole$, ":") - 1)
681.         r$ = MID$(whole$, INSTR(whole$, ":") + 1)
682.         r$ = LEFT$(r$, LEN(r$) - 1)
683.         IF RIGHT$(r$, 1) = "M" THEN m$ = RIGHT$(r$, 3) ELSE m$ = ""
684.         h = GetHour(r$): m = GetMinute(r$): s = GetSecond(r$)
685.         IF m$ = " PM" AND h <> 12 THEN h = h + 12
686.         IF count <> 4 THEN
687.             h = h - GetTimeOffset / 60
688.             IF h < 0 THEN h = 24 + h 'adjust for AM/PM difference, if ever necessary
689.             IF h > 23 THEN h = h - 24 'adjust for AM/PM difference, if ever necessary
690.             SELECT CASE h
691.                 CASE 0: h = 12: m$ = " AM"
692.                 CASE 12: m$ = " PM"
693.                 CASE IS > 12: h = h - 12: m$ = " PM"
694.                 CASE ELSE: m$ = " AM"
695.             END SELECT
696.         END IF
697.         hour$ = _TRIM$(STR$(h)): IF LEN(hour$) = 1 THEN hour$ = "0" + hour$
698.         min$ = _TRIM$(STR$(m)): IF LEN(min$) = 1 THEN min$ = "0" + min$
699.         sec$ = _TRIM$(STR$(s)): IF LEN(sec$) = 1 THEN sec$ = "0" + sec$
700.         Sun(count).value = hour$ + ":" + min$ + ":" + sec$ + m$
701.         t$ = MID$(t$, l + 1)
702.     LOOP
703. END SUB
704.  
705.  
706. FUNCTION MoonPhase$ (month, day, year)
707.     DIM mooncycle AS _FLOAT
708.     DIM fullmoon AS _FLOAT, dp AS _FLOAT, sod AS _FLOAT
709.     mooncycle = 29.5305882 'days between moon rotations
710.     sod = 24 * 60 * 60 'number of seconds in a day
711.  
712.     m$ = _TRIM$(STR$(month))
713.     d$ = _TRIM$(STR$(day))
714.     y$ = _TRIM$(STR$(year))
715.     dt$ = m$ + "-" + d$ + "-" + y$
716.     guessmoon = TimeStamp(dt$, 23 * 3600 + 59 * 60 + 59) 'what is the moon at 11:59:59 PM
717.     fullmoon = TimeStamp("1-3-2020", 4 * 3600 + 46 * 60) ' full moon on 1-3-2020 at 4:46 AM UTC
718.     dp = (guessmoon - fullmoon) / sod 'days past our full moon
719.     r1 = dp - INT(dp / mooncycle) * mooncycle 'how far we are in repeating our rotation
720.     SELECT CASE r1
721.         CASE IS <= mooncycle / 4: MoonPhase$ = "1st Quarter"
722.         CASE IS <= mooncycle / 2: MoonPhase$ = "Full moon"
723.         CASE IS <= mooncycle * 3 / 4: MoonPhase$ = "3rd Quarter"
724.         CASE ELSE: MoonPhase$ = "New Moon"
725.     END SELECT
726. END FUNCTION
727.  
728.  
729.  
730. FUNCTION TimeStamp## (d$, t##) 'date and timer
731.     'Based on Unix Epoch time, which starts at year 1970.
732.     DIM l AS _INTEGER64, l1 AS _INTEGER64, m AS _INTEGER64
733.     DIM d AS _INTEGER64, y AS _INTEGER64, i AS _INTEGER64
734.     DIM s AS _FLOAT
735.  
736.     l = INSTR(d$, "-")
737.     l1 = INSTR(l + 1, d$, "-")
738.     m = VAL(LEFT$(d$, l))
739.     d = VAL(MID$(d$, l + 1))
740.     y = VAL(MID$(d$, l1 + 1))
741.     IF y < 1970 THEN 'calculate shit backwards
742.         SELECT CASE m 'turn the day backwards for the month
743.             CASE 1, 3, 5, 7, 8, 10, 12: d = 31 - d '31 days
744.             CASE 2: d = 28 - d 'special 28 or 29.
745.             CASE 4, 6, 9, 11: d = 30 - d '30 days
746.         END SELECT
747.         IF y MOD 4 = 0 AND m < 3 THEN 'check for normal leap year, and we're before it...
748.             d = d + 1 'assume we had a leap year, subtract another day
749.             IF y MOD 100 = 0 AND y MOD 400 <> 0 THEN d = d - 1 'not a leap year if year is divisible by 100 and not 400
750.         END IF
751.  
752.         'then count the months that passed after the current month
753.         FOR i = m + 1 TO 12
754.             SELECT CASE i
755.                 CASE 2: d = d + 28
756.                 CASE 3, 5, 7, 8, 10, 12: d = d + 31
757.                 CASE 4, 6, 9, 11: d = d + 30
758.             END SELECT
759.         NEXT
760.  
761.         'we should now have the entered year calculated.  Now lets add in for each year from this point to 1970
762.         d = d + 365 * (1969 - y) '365 days per each standard year
763.         FOR i = 1968 TO y + 1 STEP -4 'from 1968 onwards,backwards, skipping the current year (which we handled previously in the FOR loop)
764.             d = d + 1 'subtract an extra day every leap year
765.             IF (i MOD 100) = 0 AND (i MOD 400) <> 0 THEN d = d - 1 'but skipping every year divisible by 100, but not 400
766.         NEXT
767.         s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
768.         TimeStamp## = -(s## + 24 * 60 * 60 - t##)
769.         EXIT FUNCTION
770.     ELSE
771.         y = y - 1970
772.     END IF
773.  
774.     FOR i = 1 TO m 'for this year,
775.         SELECT CASE i 'Add the number of days for each previous month passed
776.             CASE 1: d = d 'January doestn't have any carry over days.
777.             CASE 2, 4, 6, 8, 9, 11: d = d + 31
778.             CASE 3 'Feb might be a leap year
779.                 IF (y MOD 4) = 2 THEN 'if this year is divisible by 4 (starting in 1972)
780.                     d = d + 29 'its a leap year
781.                     IF (y MOD 100) = 30 AND (y MOD 400) <> 30 THEN 'unless..
782.                         d = d - 1 'the year is divisible by 100, and not divisible by 400
783.                     END IF
784.                 ELSE 'year not divisible by 4, no worries
785.                     d = d + 28
786.                 END IF
787.             CASE 5, 7, 10, 12: d = d + 30
788.         END SELECT
789.     NEXT
790.     d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
791.     FOR i = 2 TO y - 1 STEP 4 'from 1972 onwards, skipping the current year (which we handled previously in the FOR loopp)
792.         d = d + 1 'add an extra day every leap year
793.         IF (i MOD 100) = 30 AND (i MOD 400) <> 30 THEN d = d - 1 'but skiping every year divisible by 100, but not 400
794.     NEXT
795.     s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
796.     TimeStamp## = (s## + t##)
797. END FUNCTION
798.  
799. FUNCTION ConvertDayToNum (day$)
800.     SELECT CASE day$
801.         CASE "Sunday": ConvertDayToNum = 1
802.         CASE "Monday": ConvertDayToNum = 2
803.         CASE "Tuseday": ConvertDayToNum = 3
804.         CASE "Wednesday": ConvertDayToNum = 4
805.         CASE "Thursday": ConvertDayToNum = 5
806.         CASE "Friday": ConvertDayToNum = 6
807.         CASE "Saturday": ConvertDayToNum = 7
808.     END SELECT
809. END FUNCTION

I updated the resource files in the 7zip archive in my dropbox, so if you want, you can grab the latest complete package just by using the same link as before, at the bottom of the first post.

At this point, we're now using external holiday files, and they're smart enough to calculate days for us like Thanksgiving (Last Thursday in November).  We're no longer limited to exact days, but now find days in relation to when they fall inside a month.

I've added the sunrise, sunset, and moon cycles to our "Today" information.

The starting days for the seasons have been added for all the years from 2016 to 2099.

We can now manually move forward and backwards in the calendar with the arrow keys.  CTRL-LEFT moves us back a month, CTRL-RIGHT moves us forward a month.

**********************

Now that I can manually choose the month, I need to implement a method to manually choose a day, so we can add/edit/delete events on that day.  That'll be what my next version of this little project does.

I'm thinking basic input would be:
LEFT, RIGHT, UP, DOWN -- move a daily selector across the screen.
A -- Add an Event for the chosen day
D -- Delete an Event for the chosen day
E -- Edit an Event for the chosen day
P -- Print month
C -- Change month's background (some might look nice, but not be suitable for printing)
R -- Remove/Restore month's background (just turn it black to print a simple grid without using all the color ink in the printer)
ESC -- End program

Other functionality to be added/edited as inspiration hits and this little thing keeps growing.  It's readily on the way to go from just a simple "yearly printout" to becoming some sort of schedule organization tool. 

Is there anything I'm missing?  Anything which someone else would like to see added to this?  All comments, requests, and feedback are appreciated.  ;)

Title: Re: Calendar 2021
Post by: Adrian on December 29, 2020, 01:37:40 pm

Quote from: SMcNeill on December 26, 2020, 06:16:25 am

Easter, Ash Wednesday, Good Friday, the seasons are all on this list.  Those are individual entries which will need some unique tweaking to work properly for us, but I'll probably end up sorting out some way to stick them in there before I'm all finished.  For now, it's one simple little alteration and addition at a time.  ;)

Can try Ron Mallen's algorithm for calculating Easter. Adding Good Friday and Ash Wednesday should then be quite straightforward.

Code: QB64: [Select]

1. ' EASTER DATE CALCULATION FOR YEARS 1583 TO 4099
2.  
3. ' y is a 4 digit year 1583 to 4099
4. ' d returns the day of the month of Easter
5. ' m returns the month of Easter
6.  
7. ' Easter Sunday is the Sunday following the Paschal Full Moon
8. ' (PFM) date for the year
9.  
10. ' This algorithm is an arithmetic interpretation of the 3 step
11. ' Easter Dating Method developed by Ron Mallen
12.  
13. DIM FirstDig, Remain19, temp 'intermediate results
14. DIM tA, tB, tC, tD, tE 'table A to E results
15.  
16. INPUT "year "; y
17. FirstDig = y \ 100 'first 2 digits of year
18. Remain19 = y MOD 19 'remainder of year / 19
19.  
20. ' calculate PFM date
21. temp = (FirstDig - 15) \ 2 + 202 - 11 * Remain19
22.  
23. SELECT CASE FirstDig
24.     CASE 21, 24, 25, 27 TO 32, 34, 35, 38
25.         temp = temp - 1
26.     CASE 33, 36, 37, 39, 40
27.         temp = temp - 2
28. END SELECT
29. temp = temp MOD 30
30.  
31. tA = temp + 21
32. IF temp = 29 THEN tA = tA - 1
33. IF (temp = 28 AND Remain19 > 10) THEN tA = tA - 1
34.  
35. 'find the next Sunday
36. tB = (tA - 19) MOD 7
37.  
38. tC = (40 - FirstDig) MOD 4
39. IF tC = 3 THEN tC = tC + 1
40. IF tC > 1 THEN tC = tC + 1
41.  
42. temp = y MOD 100
43. tD = (temp + temp \ 4) MOD 7
44.  
45. tE = ((20 - tB - tC - tD) MOD 7) + 1
46. d = tA + tE
47.  
48. 'return the date
49. IF d > 31 THEN
50.     d = d - 31
51.     m = 4: m$ = "April"
52. ELSE
53.     m = 3: m$ = "March"
54. END IF
55.  
56. PRINT m$, d
57. END
58.  

Title: Re: Calendar 2021
Post by: SierraKen on December 29, 2020, 07:41:27 pm

Or you can dig out the code from my Calendar Maker from last year. I added Easter code to it. Feel free to use any of this code. The meat of the code starts at line 356.
I found this Easter code somewhere online but I can't remember where.

Code: QB64: [Select]

1. 'This is my very first calendar making program!
2. 'Thanks to the guys from the QB64.org forum for the help: bplus, SMcNeill, euklides, and TempodiBasic!
3. 'This is a freeware program like all my other programs and games, only free.
4. 'Feel free to use this code in your own programs.
5. 'This version has the ability to add info or holidays to dates.
6. 'Made on Thursday, September 19, 2019 by Ken G.
7.  
8. start:
9. _TITLE "Calendar Maker"
10. _LIMIT 1000
11. DIM newinfo$(50)
12. DIM dayinfo(50)
13. dd = 0
14. leap = 0
15. m = 0
16. mm = 0
17. y = 0
18. yy = 0
19. w = 0
20. weekday = 0
21. days = 0
22. holidays = 0
23. SCREEN _NEWIMAGE(800, 600, 32)
24. CLS
25. PRINT "                                  Monthly Calendar Maker"
26. PRINT: PRINT: PRINT
27. PRINT "                                        By Ken G."
28. PRINT
29. PRINT "                         With some help from the QB64.org Forum guys!"
30. PRINT: PRINT: PRINT
31. PRINT "          This program will make a calendar for the year and month you want."
32. PRINT "          It will also name some U.S. holidays on their dates if you choose that."
33. PRINT "          You also can add holidays or info to any day you wish with up to 12"
34. PRINT "          letters, numbers, symbols, or spaces."
35. PRINT "          This uses the Gregorian Calendar which became common practice in"
36. PRINT "          England in 1753 and we still use it today."
37. PRINT
38. PRINT "          First make a calendar, then if you want to save it as a .bmp file,"
39. PRINT "          press the 'S' key and it will save it as the month and year for its name."
40. PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
41. PRINT "          press the 'S' key and it will save it as 1-2020.bmp"
42. PRINT "          If you wish to print your calendar on your printer, press 'P' once."
43. PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
44. PRINT "          If you save the .bmp calendar, it will be put in the same directory as this program."
45. PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
46. PRINT "          Switching months with the arrow keys will not save your new date info if you come back."
47. PRINT "          To make a different calendar without saving, press the Space Bar."
48. PRINT "          Keyboard commands will be listed on the title bar of the window."
49. again1:
50. PRINT
51. INPUT "          Type the year here (1753-9999): ", y
52. IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
53. IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
54. again2:
55. PRINT
56. INPUT "          Type the month here (1-12): ", m
57. PRINT
58. IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
59. IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
60. INPUT "          Do you want U.S. holidays added (Y/N)?", hol$
61. IF LEFT$(hol$, 1) = "y" OR LEFT$(hol$, 1) = "Y" THEN holidays = 1
62. PRINT
63. INPUT "          Do you want to add your own holidays or info (Y/N)?", adding$
64. calculate:
65. info = 0
66. infos = 0
67. 'Get the month name.
68. IF m = 1 THEN month$ = " January"
69. IF m = 2 THEN month$ = "February"
70. IF m = 3 THEN month$ = "  March"
71. IF m = 4 THEN month$ = "  April"
72. IF m = 5 THEN month$ = "  May"
73. IF m = 6 THEN month$ = "  June"
74. IF m = 7 THEN month$ = "  July"
75. IF m = 8 THEN month$ = " August"
76. IF m = 9 THEN month$ = "September"
77. IF m = 10 THEN month$ = " October"
78. IF m = 11 THEN month$ = "November"
79. IF m = 12 THEN month$ = "December"
80.  
81. 'Calculate to see if it's a Leap Year.
82. IF m <> 2 THEN GOTO nex:
83. IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
84. IF y / 4 = INT(y / 4) THEN leap = 1
85. IF y / 100 = INT(y / 100) THEN leap = 0
86.  
87. 'Get the number of days for each month.
88. more:
89. IF leap = 1 THEN days = 29
90. IF leap = 0 THEN days = 28
91. GOTO weekday:
92. nex:
93. IF m = 1 THEN days = 31
94. IF m = 3 THEN days = 31
95. IF m = 4 THEN days = 30
96. IF m = 5 THEN days = 31
97. IF m = 6 THEN days = 30
98. IF m = 7 THEN days = 31
99. IF m = 8 THEN days = 31
100. IF m = 9 THEN days = 30
101. IF m = 10 THEN days = 31
102. IF m = 11 THEN days = 30
103. IF m = 12 THEN days = 31
104. weekday:
105.  
106. 'Set the month, year, and weekday variables to start with.
107. mm = m
108. yy = y
109. GetDay mm, dd, y, weekday
110.  
111.  
112. IF LEFT$(adding$, 1) = "y" OR LEFT$(adding$, 1) = "Y" THEN GOSUB adding:
113. adding$ = ""
114.  
115. 'This section makes the calendar graph.
116. make:
117. SCREEN _NEWIMAGE(800, 600, 32)
118. CLS
119. LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
120. _TITLE "Press 'S' to Save, 'P' to Print, Left and Right Arrow Keys To Switch Months, Space Bar For Different One, or 'Esc' to Quit."
121. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
122. LOCATE 3, 42: PRINT month$; "  "; yy
123.  
124. FOR x = 20 TO 780 STEP 108
125.     LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
126. NEXT x
127. FOR z = 100 TO 580 STEP 80
128.     LINE (16, z)-(780, z), _RGB32(0, 0, 0)
129. NEXT z
130.  
131. LOCATE 5, 8: PRINT "SUNDAY"
132. LOCATE 5, 21: PRINT "MONDAY"
133. LOCATE 5, 34: PRINT "TUESDAY"
134. LOCATE 5, 47: PRINT "WEDNESDAY"
135. LOCATE 5, 60: PRINT "THURSDAY"
136. LOCATE 5, 75: PRINT "FRIDAY"
137. LOCATE 5, 87: PRINT "SATURDAY"
138.  
139. 'Finding Date of Easter
140. PQA = yy
141. GOSUB PAQUES
142. 'month = PQM, day = PQJ, year = PQA
143.  
144. 'This section puts the right dates and holidays in the right squares for the calendar.
145. _FONT 16
146. w = (weekday * 108) + 25
147. FOR weeky = 110 TO 570 STEP 80
148.     FOR dayx = w TO 692 STEP 108
149.         _LIMIT 1000
150.         dd = dd + 1
151.         GetDay mm, dd, y, weekday
152.         IF weekday = 1 THEN GOSUB coloring:
153.         IF weekday <> 1 THEN COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
154.         dd$ = STR$(dd)
155.         _FONT 8
156.         IF dd = dayinfo(infos) THEN
157.             GOSUB coloring:
158.             i = LEN(newinfo$(infos))
159.             IF i < 8 THEN ii = 25
160.             IF i > 7 AND i < 12 THEN ii = 11
161.             IF i > 11 AND i < 14 THEN ii = 5
162.             IF i > 13 THEN ii = 2
163.             _PRINTSTRING (dayx + ii, weeky + 20), newinfo$(infos)
164.             infos = infos + 1
165.             ye = 1
166.         END IF
167.         IF holidays = 0 THEN GOTO skip:
168.         IF m = 1 AND dd = 1 THEN
169.             GOSUB coloring:
170.             _PRINTSTRING (dayx + 15, weeky + 60), "New Years"
171.         END IF
172.         IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
173.             GOSUB coloring:
174.             _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
175.         END IF
176.         IF m = 2 AND dd = 2 THEN
177.             GOSUB coloring:
178.             _PRINTSTRING (dayx + 13, weeky + 60), "Groundhog"
179.         END IF
180.         IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
181.             GOSUB coloring:
182.             _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
183.         END IF
184.         IF m = 2 AND dd = 14 THEN
185.             GOSUB coloring:
186.             _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
187.         END IF
188.         IF m = 3 AND dd = 17 THEN
189.             GOSUB coloring:
190.             _PRINTSTRING (dayx + 5, weeky + 60), "St. Patrick"
191.         END IF
192.         IF m = PQM AND dd = PQJ THEN
193.             GOSUB coloring:
194.             _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
195.         END IF
196.         IF m = 4 AND dd > 23 AND weekday = 7 THEN
197.             GOSUB coloring:
198.             _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
199.         END IF
200.         IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN
201.             GOSUB coloring:
202.             _PRINTSTRING (dayx + 2, weeky + 60), "Armed Forces"
203.         END IF
204.         IF m = 5 AND weekday = 2 AND dd > 24 THEN
205.             GOSUB coloring:
206.             _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
207.         END IF
208.         IF m = 5 AND weekday = 1 AND dd > 7 AND dd < 15 THEN
209.             GOSUB coloring:
210.             _PRINTSTRING (dayx + 2, weeky + 60), "Mother's Day"
211.         END IF
212.         IF m = 6 AND weekday = 1 AND dd > 14 AND dd < 22 THEN
213.             GOSUB coloring:
214.             _PRINTSTRING (dayx + 2, weeky + 60), "Father's Day"
215.         END IF
216.         IF m = 6 AND dd = 14 THEN
217.             GOSUB coloring:
218.             _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
219.         END IF
220.         IF m = 7 AND dd = 4 THEN
221.             GOSUB coloring:
222.             _PRINTSTRING (dayx + 2, weeky + 60), "Independence"
223.         END IF
224.         IF m = 9 AND weekday = 2 AND dd < 8 THEN
225.             GOSUB coloring:
226.             _PRINTSTRING (dayx + 27, weeky + 60), "Labor"
227.         END IF
228.         IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN
229.             GOSUB coloring:
230.             _PRINTSTRING (dayx + 17, weeky + 60), "Columbus"
231.         END IF
232.         IF m = 10 AND dd = 31 THEN
233.             GOSUB coloring:
234.             _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
235.         END IF
236.         IF m = 11 AND dd = 11 THEN
237.             GOSUB coloring:
238.             _PRINTSTRING (dayx + 19, weeky + 60), "Veterans"
239.         END IF
240.         IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN
241.             GOSUB coloring:
242.             _PRINTSTRING (dayx + 2, weeky + 60), "Thanksgiving"
243.         END IF
244.         IF m = 12 AND dd = 25 THEN
245.             GOSUB coloring:
246.             _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
247.         END IF
248.         skip:
249.         ye = 0
250.         _FONT 16
251.         _PRINTSTRING (dayx, weeky), dd$
252.         _FONT 8
253.         IF dd = days THEN _FONT 16: GOTO more2:
254.     NEXT dayx
255.     w = 25
256. NEXT weeky
257.  
258. more2:
259. _LIMIT 1000
260. a$ = INKEY$
261. IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
262. IF a$ = "s" OR a$ = "S" THEN GOTO saving:
263. IF a$ = " " THEN GOTO start:
264. IF a$ = "p" OR a$ = "P" THEN
265.     'printer prep (code copied and pasted from bplus Free Calendar Program)
266.     YMAX = _HEIGHT: XMAX = _WIDTH
267.     landscape& = _NEWIMAGE(YMAX, XMAX, 32)
268.     _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
269.     _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
270.     _PRINTIMAGE landscape&
271. END IF
272.  
273. IF a$ = CHR$(0) + CHR$(77) THEN
274.     m = m + 1
275.     IF m > 12 THEN
276.         m = 1
277.         yy = yy + 1
278.     END IF
279.     y = yy
280.     IF y > 9999 THEN y = 1753
281.     dd = 0
282.     leap = 0
283.     _DELAY .1
284.     CLS
285.     GOTO calculate:
286. END IF
287. IF a$ = CHR$(0) + CHR$(75) THEN
288.     m = m - 1
289.     IF m < 1 THEN
290.         m = 12
291.         yy = yy - 1
292.     END IF
293.     y = yy
294.     IF y < 1753 THEN y = 9999
295.     dd = 0
296.     leap = 0
297.     _DELAY .1
298.     CLS
299.     GOTO calculate:
300. END IF
301.  
302. GOTO more2:
303.  
304. adding:
305. CLS
306. PRINT: PRINT
307. add:
308. PRINT
309. olddayinfo = dayinfo(info)
310. info = info + 1
311. infos = 1
312. adding2:
313. IF info > days THEN PRINT "You have reached the maximum amount of holidays or info for this month.": INPUT "Press enter to create calendar.", pe$: RETURN
314. PRINT
315. PRINT "Your dates must go in order here."
316. PRINT "for example, you cannot put info for day 15 and then put info for day 1."
317. PRINT "They must all follow from smallest number to highest number or it will tell you to start over again."
318. PRINT "Also, you cannot change a day by doing it over again, so if you mess up, create a new month."
319. PRINT
320. PRINT info; ". ";
321. INPUT "Which day of the month for new holiday or information: ", dayinfo(info)
322. IF dayinfo(info) > days THEN PRINT "That day is not on this calendar, try again.": GOTO adding2:
323. IF dayinfo(info) < 1 THEN PRINT "You cannot type a date less than 1, try again.": GOTO adding2:
324. IF dayinfo(info) <> INT(dayinfo(info)) THEN PRINT "You cannot type a decimal for a date, try again.": GOTO adding2:
325. IF dayinfo(info) < olddayinfo THEN
326.     PRINT
327.     PRINT "You have put a date before your previous one which cannot work, start over from your first date."
328.     FOR dl = 1 TO info
329.         newinfo$(dl) = ""
330.         dayinfo(dl) = 0
331.     NEXT dl
332.     olddayinfo = 0
333.     info = 0
334.     GOTO add:
335. END IF
336. adding3:
337. PRINT
338. PRINT "Type up to 12 letters, numbers, or spaces that will be put for that day."
339. PRINT
340. INPUT "->", newinfo$(info)
341. infoamount = LEN(newinfo$(info))
342. IF infoamount > 12 THEN PRINT "Too long, try again.": GOTO adding3:
343. IF infoamount < 1 THEN PRINT "Nothing typed, try again.": GOTO adding3:
344. PRINT
345. INPUT "Do you want to add more (Y/N):", yn$
346. IF LEFT$(yn$, 1) = "y" OR LEFT$(yn$, 1) = "Y" THEN GOTO adding:
347. RETURN
348.  
349. 'Color all Sundays and holidays
350. coloring:
351. IF ye = 1 THEN RETURN
352. LINE (dayx - 4, weeky - 9)-(dayx + 102, weeky + 68), _RGB32(255, 255, 127), BF: COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 127)
353. RETURN
354.  
355.  
356. 'Find the right date for Easter.
357. PAQUES:
358. PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
359. PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
360. PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
361. PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
362. PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
363. PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
364. RETURN
365.  
366.  
367. 'This section saves the calendar to a BMP file along with the SUB at the end of this program.
368. saving:
369. mo$ = STR$(m)
370. mo$ = LTRIM$(RTRIM$(mo$))
371. year$ = STR$(yy)
372. year$ = LTRIM$(RTRIM$(year$))
373. nm$ = mo$ + "-"
374. nm$ = LTRIM$(RTRIM$(nm$))
375. nm$ = nm$ + year$
376. nm$ = LTRIM$(RTRIM$(nm$))
377. SaveImage 0, nm$ 'saves entire program screen,"
378. CLS
379. nm2$ = nm$ + ".bmp"
380. nm2$ = LTRIM$(RTRIM$(nm2$))
381. PRINT: PRINT: PRINT
382. PRINT "                                           Saving"
383. PRINT
384. PRINT "                          "; nm2$; " has been saved to your computer."
385. PRINT
386. PRINT
387. INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
388. IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
389. PRINT
390. PRINT
391. PRINT "                         Goodbye."
392. END
393.  
394. weekdays:
395.  
396. 'This section gets the right weekday.
397. SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
398.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
399.     IF mm < 3 THEN mm = mm + 12: y = y - 1
400.     century = y MOD 100
401.     zerocentury = y \ 100
402.     weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
403. END SUB
404.  
405. 'This section saves the .bmp picture file.
406. SUB SaveImage (image AS LONG, filename AS STRING)
407.     bytesperpixel& = _PIXELSIZE(image&)
408.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
409.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
410.     x& = _WIDTH(image&)
411.     y& = _HEIGHT(image&)
412.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
413.     IF bytesperpixel& = 1 THEN
414.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
415.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
416.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
417.         NEXT
418.     END IF
419.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
420.     lastsource& = _SOURCE
421.     _SOURCE image&
422.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
423.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
424.         r$ = ""
425.         FOR px& = 0 TO x& - 1
426.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
427.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
428.         NEXT px&
429.         d$ = d$ + r$ + padder$
430.     NEXT py&
431.     _SOURCE lastsource&
432.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
433.     b$ = b$ + d$ ' total file data bytes to create file
434.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
435.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
436.     f& = FREEFILE
437.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
438.     OPEN filename$ + ext$ FOR BINARY AS #f&
439.     PUT #f&, , b$
440.     CLOSE #f&
441. END SUB
442.  

Here is how I use the variables. m = month, dd = day. coloring: is just where I fill in the holidays and Sundays with a color. 

Code: QB64: [Select]

1.         IF m = PQM AND dd = PQJ THEN
2.             GOSUB coloring:
3.             _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
4.         END IF
5.  

Title: Re: Calendar 2021
Post by: SMcNeill on January 05, 2021, 11:09:19 pm

Now that I'm back home, I've managed to work on this little project once again, and it now allows us to add up to 10 custom events to our days.

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Project is being uploaded to my public OneDrive folder, and should be available for download in a few moments, if anyone wants to test it out at:  https://1drv.ms/u/s!AknUrv8RXVYMkIMiwSDNKinhlbfuHg?e=6eumhM

Title: Re: Calendar 2021
Post by: Ryster on January 07, 2021, 01:38:44 pm

Feel free to download my calendar (calculator), which I have been working on for 15 years and is constantly being expanded. I can say with full responsibility that there is no other such calendar with such computing capabilities anywhere in the world (who would like to write). The program includes several dozen calculation subroutines (58). The calculation range is 1 - 9999. The exe file weighs over 21.1 MB. The program is only in the 64-bit version, because the 32-bit version cannot cope with the code due to the size of the file. Due to the fact that I was directly ridiculed not only on this Forum, but also on N54 once, when I reported irregularities, please find the link to the website on your own, if someone is interested in this topic.
If someone was offended by this entry - sorry. Program language - Polish.
Regards - Ryster

Title: Re: Calendar 2021
Post by: STxAxTIC on January 07, 2021, 03:12:44 pm

Ryster I could not find what you're talking about. Link plz.

Title: Re: Calendar 2021
Post by: bplus on January 07, 2021, 03:25:06 pm

Edit: sorry this distracted from lovely thread Steve started.

Title: Re: Calendar 2021
Post by: Adrian on January 07, 2021, 03:33:21 pm

all i can see in this thread is that Steve's done a great job with his program.

Title: Re: Calendar 2021
Post by: SMcNeill on January 08, 2021, 05:17:52 am

Quote from: Ryster on January 07, 2021, 01:38:44 pm

Feel free to download my calendar (calculator), which I have been working on for 15 years and is constantly being expanded. I can say with full responsibility that there is no other such calendar with such computing capabilities anywhere in the world (who would like to write). The program includes several dozen calculation subroutines (58). The calculation range is 1 - 9999...

What is it calculating?  Days?  Math formulas?  It's a calendar (calculator)?   Such as calculating 30 * SIN(30) ^ 2)  Exactly what the heck are you calculating?

Title: Re: Calendar 2021
Post by: STxAxTIC on January 08, 2021, 02:32:36 pm

I tried a few links in Google after searching "ryster qbasic calendar" and .... didn't find it...

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Title: Re: Calendar 2021
Post by: Pete on January 08, 2021, 07:34:54 pm

Thanks to Bill's link, I'm a working "porstar" again.

Title: Re: Calendar 2021
Post by: SMcNeill on January 09, 2021, 11:05:49 pm

Several people have been nice and donated code which illustrates how to find the date for Easter, and I want to thank them all.  Here's the quick little version which I'm going to end up popping into my Calendar for the next version:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2.  
3. FOR y = 2000 TO 2099
4.     FindEaster y, m, d
5.     PRINT m; "-"; d; "-"; y,
6. NEXT
7.  
8. SUB FindEaster (y, m, d) 'for the 21st century
9.     m = 3
10.     temp = (204.5 - 11 * (y MOD 19)) MOD 30 + 21
11.     IF (temp = 49 AND y MOD 19 > 10) OR (temp = 50) THEN temp = temp - 1
12.     d = temp + ((20 - (temp - 19) MOD 7 - INT((y MOD 100) * 1.25) MOD 7) MOD 7) + 1
13.     IF d > 31 THEN d = d - 31: m = m + 1
14. END SUB

Note that this only assumes to calculate the date for the 21st century (2000 to 2099), but I really don't think anyone is going to be using my little Calendar program 80+ years from now.  I know I certainly won't be!  If someone is, then they can have the fun challenge of correcting it, much like others had to fix the Y2K bug before the world ended back on Dec 31st, 1999.  :D

Honestly, it's not complicated to go beyond the 21st century, but I figured since my seasons are calculated via a chart with only those years, I really don't need to calculate for more than that, so I can simplify the math somewhat and take out several steps in the work flow.  If anyone wants, they can call it "planned obsolescence", so that I can sell the updated version when this one doesn't work anymore for folks...  ;D

Title: Re: Calendar 2021
Post by: SMcNeill on January 10, 2021, 05:16:45 am

Calendar has been updated and expanded once again.

We now find ALL of the following holidays, from the following lists:

41 Simple Calculations from Holiday.txt

Code: QB64: [Select]

1. 01, ON, 01, New Years Day
2. 01, ON, 06, Epiphany
3. 01, ON, 07, Orthodox Christmas Day
4. 01, ON, 13, Stephen Foster Memorial Day
5. 01, ON, 14, Orthodox New Year
6. 01, THIRD, Monday, Martin Luther King Day
7. 02, ON, 01, National Freedom Day
8. 02, ON, 01, Start of Black History Month
9. 02, ON, 02, Groundhog's Day
10. 02, FIRST, Sunday, Super Bowl
11. 02, ON, 12, Lincoln's Birthday
12. 02, ON, 14, Valentine's Day
13. 02, THIRD, Monday, President's Day
14. 02, ON, 22, Washington's Birthday
15. 03, ON, 01, Start of Women's History Month
16. 03, SECOND, Sunday, Start of Daylight Saving's Time
17. 03, ON, 17, Saint Patrick's Day
18. 03, ON, 29, National Vietnam War Vetern's Day
19. 04, ON, 01, April Fool's Day
20. 05, ON, 05, Cinco de Mayo
21. 05, SECOND, Sunday, Mother's Day
22. 05, LAST, Monday, Memorial Day
23. 06, ON, 14, Flag Day
24. 06, THIRD, Sunday, Father's Day
25. 07, ON, 04, Independence Day
26. 07, ON, 15, Tax Day
27. 09, FIRST, Monday, Labor Day
28. 09, ON, 25, Steve McNeill's Birthday
29. 10, SECOND, 02, Columbus Day
30. 10, SECOND, 02, Thanksgiving Day (Canada)
31. 10, ON, 31, Halloween
32. 11, ON, 01, All Saint's Day
33. 11, FIRST, Sunday, End of Daylight Saving's Time
34. 11, ON, 02, All Soul's Day
35. 11, ON, 11, Veteran's Day
36. 11, Fourth, Thursday, Thanksgiving
37. 12, ON, 07, Pearl Harbor Remembrance Day
38. 12, ON, 24, Christmas Eve
39. 12, ON, 25, Christmas Day
40. 12, ON, 26, Boxing Day (Canada)
41. 12, ON, 31, New Year's Eve

The date of the 4 seasons:
Spring
Summer
Autumn
Winter

All of the Easter-related holidays, that I knew of.  (If I missed one, simply speak up now and let me know.):
Easter
Good Friday
Holy Thursday
Palm Sunday
Lent Begins
Ash Wednesday
Shrove Tuesday

Election Day, US (First Tuesday after first Monday in November)

Friday the 13th, when it occurs.

Thanksgiving Related Days:
Black Friday
Cyber Monday

Each day we get:
Sunrise
Sunset
Noontime
Day Length
Moon Phase

And, of course, users can add and edit their own events into the calendar, to suit their own needs.

---

Updated version is available via my onedrive link here: https://1drv.ms/u/s!AknUrv8RXVYMkIMiwSDNKinhlbfuHg?e=ndJtkc

Looks like I have quite a ways to go yet, to catch up to Ryster's calendar which calculates 58 things and generates a 21.1 mb EXE file.  So far, I'm only calculating 61 things (not counting custom events), with an EXE which comes in at about 3 mb in size.  I really wish he'd share his code with us, so I could see what I'm missing out on.  ;)

Title: Re: Calendar 2021
Post by: SMcNeill on January 10, 2021, 09:19:23 am

Added birthstones and zodiac to the calendar, as the screenshot of the corner shows below:

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Title: Re: Calendar 2021
Post by: SMcNeill on January 10, 2021, 10:41:56 am

Quote from: Anthony.R.Brown on January 10, 2021, 09:37:02 am

Can you put (Effect of time of day on grazing behaviour by lactating dairy cows...)  just a bit of fun! :)

I don't think I'll be adding lactating cattle schedules into the project anytime soon, as I don't farm anymore and have absolutely no use for the information.  Feel free to go in and add it yourself, if you want to, it's why I'm including the source code so that everyone can customize things however the heck they want, for their own personal needs and use!  :D

Just for fun though, I did go in and add a clock and a news ticker into the project, which now grabs the daily news and scrolls it across the bottom of the calendar for you, so you can keep up with the very latest happenings when the app is up and going.  Screenshot is below, and you can grab the latest version from my onedrive, using any of the links I've shared numerous times previously.

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Title: Re: Calendar 2021
Post by: STxAxTIC on January 12, 2021, 08:47:41 pm

Just downloaded the updated version and quickly moved it to a different drive so OneDrive wouldn't start backing the whole project up. This thing is huge.

Bro, is there a way you can release the code with limited backgrounds as a separate archive, or do you insist on shipping the calendar with your softcore porn stash?

Among the many things this calculates, is it sure that all the subjects are over 18?

Title: Re: Calendar 2021
Post by: Pete on January 12, 2021, 08:56:16 pm

Screw what Bill wrote. Is there a way you can release the backgrounds, without all that calendar crap?

Pete :D

Title: Re: Calendar 2021
Post by: SMcNeill on January 12, 2021, 09:26:57 pm

To answer both:  Nope and nope.

I tend to download collections of free images from the net, and archive them for future use.  As I said earlier, if there's something that offends you, then feel free to remove it.  Honestly, I'm surprised that Stx is such a puritan that he'd find such an image to be "softcore porn".  What he's seeing here isn't anything that he wouldn't be able to see just by looking at the magazine covers at the checkout of his local grocery store. 


It's got to be hard to live in our current world, with such a strict standard of morality -- it reminds me of the Jehovah Witnesses who kick Michael out of their church because he admitted to enjoying looking at the Sports Illustrated Swimsuit issue...  My respect goes out to those that are that strive to live up to such a standard, but I'm afraid I don't hold to that same belief system.  I support freedom of speech, freedom of expression, and certainly don't condone censorship in any form.  I won't be editing or deleting anything from the free art bundles which I download and make use of. 

---

And Pete, if you're seriously interested in various art packs, let me know and I'll send you a torrent link to a couple TB worth of them.  There's no reason to strip them out of the calendar, if they're all you're interested in.

Title: Re: Calendar 2021
Post by: Pete on January 12, 2021, 09:40:16 pm

Now that's what I'm talking about. Who needs a damn calendar with images like that. Hell, every day is hump day!

Get your every day is Wednesday non-calendar app at AmazingSteve.com(tm)

Pete

Title: Re: Calendar 2021
Post by: DANILIN on January 17, 2021, 04:00:02 pm

may be interested in Russian folk font

picture 45 kB

 

Text Only | Text with Attachments