Calendar Maker 2

[SierraKen]

I made Calendar Maker back in 2019 here with the help of you guys. So today I decided to update it with a version 2 that lets people print out an entire year at one time. I've tested it and it works fine. There's no pictures for the calendar but you can always draw on it or put them back in the printer the right way and print something on the backs using a different program. I just figured that it's that time of year and some of you might want a printed out calendar for next year. After printed, add one blank piece of paper on top of it so you can hold up January if you put it on the wall. Stapling and punching the hole can be a bit tricky, so take your time on that if you do it. With this program you can also print one month at a time. It has most of the U.S. holidays. I didn't add a way to add any text to it when you print the whole year at once, but it does add some usual holidays. If you want to add text to a day, or even save a month as a BMP file, then you will have to do each month individually. Enjoy, and Happy New Years!

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

[bplus]

Thanks Ken, my own calendar maker has been nicely improved from our discussion back then.

[SierraKen]

That's great! It was a bit tricky doing this today. The old calendar weeks code would mess up the variables for some reason so I added the year variable to switch it back when the old code's SUB was finished. Now it works fine. I tried other ways too inside the SUB but nothing worked that way. I know learning why things don't work is the best way, but sometimes that just can't be done. So I find work-arounds. :)

[SierraKen]

I forgot to say that you can also look at any year, or print any year, or save any month of any year as a BMP picture file, from the start of the Gregorian Calendar (1753 A.D.) to 9999 A.D. When you look at months, you can use the right and left arrow keys to flip through the different months and years.

Also, if anyone wishes to see the conversations we had making the first version, go here: https://qb64forum.alephc.xyz/index.php?topic=1569.0