Author Topic: Calendar Maker  (Read 13723 times)

0 Members and 1 Guest are viewing this topic.

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: Calendar Maker
« Reply #30 on: September 15, 2019, 12:15:57 pm »
Great program, this will be useful. I've officially awarded you a subdirectory in my 'programs' folder. ;)

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Calendar Maker
« Reply #31 on: September 15, 2019, 07:39:53 pm »
Wow thanks OldMoses! :)

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Calendar Maker
« Reply #32 on: September 17, 2019, 06:42:07 pm »
Fine again...

Thanks to share and thanks to improve

but

1) no Sunday color and not holiday color
3) no customizable names of months and of days... it can be done using a keyboard / file input
2) it is just right for American recurrences...and it is ok... but a great improvement should be to become customizable by user just by clicking on the day to activate as Holiday or to take input the list of holidays or recurrences at the beginning of the choice of the year or from a file ...

Programming isn't difficult, only it's  consuming time and coffee

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Calendar Maker
« Reply #33 on: September 18, 2019, 06:47:02 pm »
Sunday or Holidays color change are possible. But removing or adding holidays might be impossible because holidays don't just come the same day every year. Many U.S. holidays happen on certain weekdays of certain months and the dates of them are changed every year. But I'll look into the Sunday and holidays changes, thanks. I doubt I will add a data file to this program because personally, I have no need for one. I thought about making it a calendar to put any info you want on any day of the year, but I use a paper day-to-day calendar myself and I wouldn't want people to rely on a computer program for important appointments they need to go to, especially medical appointments. Although Windows already has something like this built-in anyway. But thanks for the suggestions, I'll look into some color changes a little bit I think, when I have time.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Calendar Maker
« Reply #34 on: September 18, 2019, 08:06:16 pm »
OK I got the Sundays and holidays colored yellow. :) Thanks again Tempodi for the idea! They look awesome this way. I can't test the colors with my printer though because I have a b/w printer but I'm guessing it does print yellow just like everything else. I will print out a b/w version of it soon. But on the computer I really like it.
Oh, and I won't let people change colors for the entire calendar because it takes up too much ink or toner.
Here is the updated version:

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 colored Sundays and holidays.
  6. 'Made on Wednesday, September 18, 2019 by Ken G.
  7.  
  8.  
  9. start:
  10. _TITLE "Calendar Maker"
  11. _LIMIT 1000
  12. dd = 0
  13. leap = 0
  14. m = 0
  15. mm = 0
  16. y = 0
  17. yy = 0
  18. w = 0
  19. weekday = 0
  20. days = 0
  21. SCREEN _NEWIMAGE(800, 600, 32)
  22. PRINT "                                  Monthly Calendar Maker"
  23. PRINT "                                        By Ken G."
  24. PRINT "                         With some help from the QB64.org Forum guys!"
  25. PRINT "          This program will make a calendar for the year and month you want."
  26. PRINT "          It will also name some holidays on their days."
  27. PRINT "          This uses the Gregorian Calendar which became common practice in"
  28. PRINT "          England in 1753 and we still use it today."
  29. PRINT "          First make a calendar, then if you want to save it as a .bmp file,"
  30. PRINT "          press the 'S' key and it will save it as the month and year for its name."
  31. PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
  32. PRINT "          press the 'S' key and it will save it as 1-2020.bmp"
  33. PRINT "          If you wish to print your calendar on your printer, press 'P' once."
  34. PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
  35. PRINT "          If you save the .bmp calendar, it will be put in the same directory as this program."
  36. PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
  37. PRINT "          To make a different calendar without saving, press the Space Bar."
  38. PRINT "          Keyboard commands will be listed on the title bar of the window."
  39. again1:
  40. INPUT "          Type the year here (1753-9999): ", y
  41. IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
  42. IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
  43. again2:
  44. INPUT "          Type the month here (1-12): ", m
  45. IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
  46. IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
  47.  
  48. calculate:
  49. 'Get the month name.
  50. IF m = 1 THEN month$ = " January"
  51. IF m = 2 THEN month$ = "February"
  52. IF m = 3 THEN month$ = "  March"
  53. IF m = 4 THEN month$ = "  April"
  54. IF m = 5 THEN month$ = "  May"
  55. IF m = 6 THEN month$ = "  June"
  56. IF m = 7 THEN month$ = "  July"
  57. IF m = 8 THEN month$ = " August"
  58. IF m = 9 THEN month$ = "September"
  59. IF m = 10 THEN month$ = " October"
  60. IF m = 11 THEN month$ = "November"
  61. IF m = 12 THEN month$ = "December"
  62.  
  63. 'Calculate to see if it's a Leap Year.
  64. IF m <> 2 THEN GOTO nex:
  65. IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
  66. IF y / 4 = INT(y / 4) THEN leap = 1
  67. IF y / 100 = INT(y / 100) THEN leap = 0
  68.  
  69. 'Get the number of days for each month.
  70. more:
  71. IF leap = 1 THEN days = 29
  72. IF leap = 0 THEN days = 28
  73. GOTO weekday:
  74. nex:
  75. IF m = 1 THEN days = 31
  76. IF m = 3 THEN days = 31
  77. IF m = 4 THEN days = 30
  78. IF m = 5 THEN days = 31
  79. IF m = 6 THEN days = 30
  80. IF m = 7 THEN days = 31
  81. IF m = 8 THEN days = 31
  82. IF m = 9 THEN days = 30
  83. IF m = 10 THEN days = 31
  84. IF m = 11 THEN days = 30
  85. IF m = 12 THEN days = 31
  86. weekday:
  87.  
  88. 'Set the month, year, and weekday variables to start with.
  89. mm = m
  90. yy = y
  91. GetDay mm, dd, y, weekday
  92.  
  93. 'This section makes the calendar graph.
  94. make:
  95. SCREEN _NEWIMAGE(800, 600, 32)
  96. LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
  97. _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."
  98. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
  99. LOCATE 3, 42: PRINT month$; "  "; yy
  100.  
  101. FOR x = 20 TO 780 STEP 108
  102.     LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
  103. FOR z = 100 TO 580 STEP 80
  104.     LINE (16, z)-(780, z), _RGB32(0, 0, 0)
  105.  
  106. LOCATE 5, 8: PRINT "SUNDAY"
  107. LOCATE 5, 21: PRINT "MONDAY"
  108. LOCATE 5, 34: PRINT "TUESDAY"
  109. LOCATE 5, 47: PRINT "WEDNESDAY"
  110. LOCATE 5, 60: PRINT "THURSDAY"
  111. LOCATE 5, 75: PRINT "FRIDAY"
  112. LOCATE 5, 87: PRINT "SATURDAY"
  113.  
  114. 'Finding Date of Easter
  115. PQA = yy
  116. GOSUB PAQUES
  117. 'month = PQM, day = PQJ, year = PQA
  118.  
  119. 'This section puts the right dates and holidays in the right squares for the calendar.
  120. w = (weekday * 108) + 25
  121. FOR weeky = 110 TO 570 STEP 80
  122.     FOR dayx = w TO 692 STEP 108
  123.         _LIMIT 1000
  124.         dd = dd + 1
  125.         GetDay mm, dd, y, weekday
  126.         IF weekday = 1 THEN GOSUB coloring:
  127.         IF weekday <> 1 THEN COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
  128.         dd$ = STR$(dd)
  129.         _FONT 8
  130.         IF m = 1 AND dd = 1 THEN
  131.             GOSUB coloring:
  132.             _PRINTSTRING (dayx + 10, weeky + 60), "New Years"
  133.         END IF
  134.  
  135.         IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
  136.             GOSUB coloring:
  137.             _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
  138.         END IF
  139.         IF m = 2 AND dd = 2 THEN
  140.             GOSUB coloring:
  141.             _PRINTSTRING (dayx + 10, weeky + 60), "Groundhog"
  142.         END IF
  143.         IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
  144.             GOSUB coloring:
  145.             _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
  146.         END IF
  147.         IF m = 2 AND dd = 14 THEN
  148.             GOSUB coloring:
  149.             _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
  150.         END IF
  151.         IF m = 3 AND dd = 17 THEN
  152.             GOSUB coloring:
  153.             _PRINTSTRING (dayx + 10, weeky + 60), "St. Patrick"
  154.         END IF
  155.         IF m = PQM AND dd = PQJ THEN
  156.             GOSUB coloring:
  157.             _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
  158.         END IF
  159.         IF m = 4 AND dd > 23 AND weekday = 7 THEN
  160.             GOSUB coloring:
  161.             _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
  162.         END IF
  163.         IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN
  164.             GOSUB coloring:
  165.             _PRINTSTRING (dayx, weeky + 60), "Armed Forces"
  166.         END IF
  167.         IF m = 5 AND weekday = 2 AND dd > 24 THEN
  168.             GOSUB coloring:
  169.             _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
  170.         END IF
  171.         IF m = 5 AND weekday = 1 AND dd > 7 AND dd < 15 THEN
  172.             GOSUB coloring:
  173.             _PRINTSTRING (dayx, weeky + 60), "Mother's Day"
  174.         END IF
  175.         IF m = 6 AND weekday = 1 AND dd > 14 AND dd < 22 THEN
  176.             GOSUB coloring:
  177.             _PRINTSTRING (dayx, weeky + 60), "Father's Day"
  178.         END IF
  179.         IF m = 6 AND dd = 14 THEN
  180.             GOSUB coloring:
  181.             _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
  182.         END IF
  183.         IF m = 7 AND dd = 4 THEN
  184.             GOSUB coloring:
  185.             _PRINTSTRING (dayx, weeky + 60), "Independence"
  186.         END IF
  187.         IF m = 9 AND weekday = 2 AND dd < 8 THEN
  188.             GOSUB coloring:
  189.             _PRINTSTRING (dayx + 25, weeky + 60), "Labor"
  190.         END IF
  191.         IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN
  192.             GOSUB coloring:
  193.             _PRINTSTRING (dayx + 15, weeky + 60), "Columbus"
  194.         END IF
  195.         IF m = 10 AND dd = 31 THEN
  196.             GOSUB coloring:
  197.             _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
  198.         END IF
  199.         IF m = 11 AND dd = 11 THEN
  200.             GOSUB coloring:
  201.             _PRINTSTRING (dayx + 15, weeky + 60), "Veterans"
  202.         END IF
  203.         IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN
  204.             GOSUB coloring:
  205.             _PRINTSTRING (dayx, weeky + 60), "Thanksgiving"
  206.         END IF
  207.         IF m = 12 AND dd = 25 THEN
  208.             GOSUB coloring:
  209.             _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
  210.         END IF
  211.         _FONT 16
  212.         _PRINTSTRING (dayx, weeky), dd$
  213.         _FONT 8
  214.         IF dd = days THEN _FONT 16: GOTO more2:
  215.     NEXT dayx
  216.     w = 25
  217. NEXT weeky
  218.  
  219. more2:
  220. _LIMIT 1000
  221. a$ = INKEY$
  222. IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
  223. IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  224. IF a$ = " " THEN GOTO start:
  225. IF a$ = "p" OR a$ = "P" THEN
  226.     'printer prep (code copied and pasted from bplus Free Calendar Program)
  227.     YMAX = _HEIGHT: XMAX = _WIDTH
  228.     landscape& = _NEWIMAGE(YMAX, XMAX, 32)
  229.     _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
  230.     _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
  231.     _PRINTIMAGE landscape&
  232.  
  233. IF a$ = CHR$(0) + CHR$(77) THEN
  234.     m = m + 1
  235.     IF m > 12 THEN
  236.         m = 1
  237.         yy = yy + 1
  238.     END IF
  239.     y = yy
  240.     IF y > 9999 THEN y = 1753
  241.     dd = 0
  242.     leap = 0
  243.     _DELAY .1
  244.     CLS
  245.     GOTO calculate:
  246. IF a$ = CHR$(0) + CHR$(75) THEN
  247.     m = m - 1
  248.     IF m < 1 THEN
  249.         m = 12
  250.         yy = yy - 1
  251.     END IF
  252.     y = yy
  253.     IF y < 1753 THEN y = 9999
  254.     dd = 0
  255.     leap = 0
  256.     _DELAY .1
  257.     CLS
  258.     GOTO calculate:
  259.  
  260. GOTO more2:
  261.  
  262. 'Color all Sundays and holidays
  263. coloring:
  264. LINE (dayx - 4, weeky - 9)-(dayx + 102, weeky + 68), _RGB32(255, 255, 127), BF: COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 127)
  265.  
  266.  
  267. 'Find the right date for Easter.
  268. PAQUES:
  269. PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
  270. PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
  271. PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
  272. PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
  273. PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
  274. PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
  275.  
  276.  
  277. 'This section saves the calendar to a BMP file along with the SUB at the end of this program.
  278. saving:
  279. mo$ = STR$(m)
  280. mo$ = LTRIM$(RTRIM$(mo$))
  281. year$ = STR$(yy)
  282. year$ = LTRIM$(RTRIM$(year$))
  283. nm$ = mo$ + "-"
  284. nm$ = LTRIM$(RTRIM$(nm$))
  285. nm$ = nm$ + year$
  286. nm$ = LTRIM$(RTRIM$(nm$))
  287. SaveImage 0, nm$ 'saves entire program screen,"
  288. nm2$ = nm$ + ".bmp"
  289. nm2$ = LTRIM$(RTRIM$(nm2$))
  290. PRINT "                                           Saving"
  291. PRINT "                          "; nm2$; " has been saved to your computer."
  292. INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
  293. IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
  294. PRINT "                         Goodbye."
  295.  
  296. weekdays:
  297.  
  298. 'This section gets the right weekday.
  299. SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
  300.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
  301.     IF mm < 3 THEN mm = mm + 12: y = y - 1
  302.     century = y MOD 100
  303.     zerocentury = y \ 100
  304.     weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
  305.  
  306. 'This section saves the .bmp picture file.
  307. SUB SaveImage (image AS LONG, filename AS STRING)
  308.     bytesperpixel& = _PIXELSIZE(image&)
  309.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  310.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  311.     x& = _WIDTH(image&)
  312.     y& = _HEIGHT(image&)
  313.     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)
  314.     IF bytesperpixel& = 1 THEN
  315.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  316.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  317.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  318.         NEXT
  319.     END IF
  320.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  321.     lastsource& = _SOURCE
  322.     _SOURCE image&
  323.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  324.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
  325.         r$ = ""
  326.         FOR px& = 0 TO x& - 1
  327.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  328.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  329.         NEXT px&
  330.         d$ = d$ + r$ + padder$
  331.     NEXT py&
  332.     _SOURCE lastsource&
  333.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  334.     b$ = b$ + d$ ' total file data bytes to create file
  335.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  336.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  337.     f& = FREEFILE
  338.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  339.     OPEN filename$ + ext$ FOR BINARY AS #f&
  340.     PUT #f&, , b$
  341.     CLOSE #f&
  342.  
« Last Edit: September 18, 2019, 08:18:27 pm by SierraKen »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Calendar Maker
« Reply #35 on: September 18, 2019, 08:52:46 pm »
I also just centered the holiday names a lot better in each square. So, here is the best version, with the colored Sundays and holidays as well:

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 colored Sundays and holidays.
  6. 'Made on Wednesday, September 18, 2019 by Ken G.
  7.  
  8. start:
  9. _TITLE "Calendar Maker"
  10. _LIMIT 1000
  11. dd = 0
  12. leap = 0
  13. m = 0
  14. mm = 0
  15. y = 0
  16. yy = 0
  17. w = 0
  18. weekday = 0
  19. days = 0
  20. SCREEN _NEWIMAGE(800, 600, 32)
  21. PRINT "                                  Monthly Calendar Maker"
  22. PRINT "                                        By Ken G."
  23. PRINT "                         With some help from the QB64.org Forum guys!"
  24. PRINT "          This program will make a calendar for the year and month you want."
  25. PRINT "          It will also name some holidays on their days."
  26. PRINT "          This uses the Gregorian Calendar which became common practice in"
  27. PRINT "          England in 1753 and we still use it today."
  28. PRINT "          First make a calendar, then if you want to save it as a .bmp file,"
  29. PRINT "          press the 'S' key and it will save it as the month and year for its name."
  30. PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
  31. PRINT "          press the 'S' key and it will save it as 1-2020.bmp"
  32. PRINT "          If you wish to print your calendar on your printer, press 'P' once."
  33. PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
  34. PRINT "          If you save the .bmp calendar, it will be put in the same directory as this program."
  35. PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
  36. PRINT "          To make a different calendar without saving, press the Space Bar."
  37. PRINT "          Keyboard commands will be listed on the title bar of the window."
  38. again1:
  39. INPUT "          Type the year here (1753-9999): ", y
  40. IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
  41. IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
  42. again2:
  43. INPUT "          Type the month here (1-12): ", m
  44. IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
  45. IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
  46.  
  47. calculate:
  48. 'Get the month name.
  49. IF m = 1 THEN month$ = " January"
  50. IF m = 2 THEN month$ = "February"
  51. IF m = 3 THEN month$ = "  March"
  52. IF m = 4 THEN month$ = "  April"
  53. IF m = 5 THEN month$ = "  May"
  54. IF m = 6 THEN month$ = "  June"
  55. IF m = 7 THEN month$ = "  July"
  56. IF m = 8 THEN month$ = " August"
  57. IF m = 9 THEN month$ = "September"
  58. IF m = 10 THEN month$ = " October"
  59. IF m = 11 THEN month$ = "November"
  60. IF m = 12 THEN month$ = "December"
  61.  
  62. 'Calculate to see if it's a Leap Year.
  63. IF m <> 2 THEN GOTO nex:
  64. IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
  65. IF y / 4 = INT(y / 4) THEN leap = 1
  66. IF y / 100 = INT(y / 100) THEN leap = 0
  67.  
  68. 'Get the number of days for each month.
  69. more:
  70. IF leap = 1 THEN days = 29
  71. IF leap = 0 THEN days = 28
  72. GOTO weekday:
  73. nex:
  74. IF m = 1 THEN days = 31
  75. IF m = 3 THEN days = 31
  76. IF m = 4 THEN days = 30
  77. IF m = 5 THEN days = 31
  78. IF m = 6 THEN days = 30
  79. IF m = 7 THEN days = 31
  80. IF m = 8 THEN days = 31
  81. IF m = 9 THEN days = 30
  82. IF m = 10 THEN days = 31
  83. IF m = 11 THEN days = 30
  84. IF m = 12 THEN days = 31
  85. weekday:
  86.  
  87. 'Set the month, year, and weekday variables to start with.
  88. mm = m
  89. yy = y
  90. GetDay mm, dd, y, weekday
  91.  
  92. 'This section makes the calendar graph.
  93. make:
  94. SCREEN _NEWIMAGE(800, 600, 32)
  95. LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
  96. _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."
  97. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
  98. LOCATE 3, 42: PRINT month$; "  "; yy
  99.  
  100. FOR x = 20 TO 780 STEP 108
  101.     LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
  102. FOR z = 100 TO 580 STEP 80
  103.     LINE (16, z)-(780, z), _RGB32(0, 0, 0)
  104.  
  105. LOCATE 5, 8: PRINT "SUNDAY"
  106. LOCATE 5, 21: PRINT "MONDAY"
  107. LOCATE 5, 34: PRINT "TUESDAY"
  108. LOCATE 5, 47: PRINT "WEDNESDAY"
  109. LOCATE 5, 60: PRINT "THURSDAY"
  110. LOCATE 5, 75: PRINT "FRIDAY"
  111. LOCATE 5, 87: PRINT "SATURDAY"
  112.  
  113. 'Finding Date of Easter
  114. PQA = yy
  115. GOSUB PAQUES
  116. 'month = PQM, day = PQJ, year = PQA
  117.  
  118. 'This section puts the right dates and holidays in the right squares for the calendar.
  119. w = (weekday * 108) + 25
  120. FOR weeky = 110 TO 570 STEP 80
  121.     FOR dayx = w TO 692 STEP 108
  122.         _LIMIT 1000
  123.         dd = dd + 1
  124.         GetDay mm, dd, y, weekday
  125.         IF weekday = 1 THEN GOSUB coloring:
  126.         IF weekday <> 1 THEN COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
  127.         dd$ = STR$(dd)
  128.         _FONT 8
  129.         IF m = 1 AND dd = 1 THEN
  130.             GOSUB coloring:
  131.             _PRINTSTRING (dayx + 15, weeky + 60), "New Years"
  132.         END IF
  133.         IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
  134.             GOSUB coloring:
  135.             _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
  136.         END IF
  137.         IF m = 2 AND dd = 2 THEN
  138.             GOSUB coloring:
  139.             _PRINTSTRING (dayx + 13, weeky + 60), "Groundhog"
  140.         END IF
  141.         IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
  142.             GOSUB coloring:
  143.             _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
  144.         END IF
  145.         IF m = 2 AND dd = 14 THEN
  146.             GOSUB coloring:
  147.             _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
  148.         END IF
  149.         IF m = 3 AND dd = 17 THEN
  150.             GOSUB coloring:
  151.             _PRINTSTRING (dayx + 5, weeky + 60), "St. Patrick"
  152.         END IF
  153.         IF m = PQM AND dd = PQJ THEN
  154.             GOSUB coloring:
  155.             _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
  156.         END IF
  157.         IF m = 4 AND dd > 23 AND weekday = 7 THEN
  158.             GOSUB coloring:
  159.             _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
  160.         END IF
  161.         IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN
  162.             GOSUB coloring:
  163.             _PRINTSTRING (dayx + 2, weeky + 60), "Armed Forces"
  164.         END IF
  165.         IF m = 5 AND weekday = 2 AND dd > 24 THEN
  166.             GOSUB coloring:
  167.             _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
  168.         END IF
  169.         IF m = 5 AND weekday = 1 AND dd > 7 AND dd < 15 THEN
  170.             GOSUB coloring:
  171.             _PRINTSTRING (dayx + 2, weeky + 60), "Mother's Day"
  172.         END IF
  173.         IF m = 6 AND weekday = 1 AND dd > 14 AND dd < 22 THEN
  174.             GOSUB coloring:
  175.             _PRINTSTRING (dayx + 2, weeky + 60), "Father's Day"
  176.         END IF
  177.         IF m = 6 AND dd = 14 THEN
  178.             GOSUB coloring:
  179.             _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
  180.         END IF
  181.         IF m = 7 AND dd = 4 THEN
  182.             GOSUB coloring:
  183.             _PRINTSTRING (dayx + 2, weeky + 60), "Independence"
  184.         END IF
  185.         IF m = 9 AND weekday = 2 AND dd < 8 THEN
  186.             GOSUB coloring:
  187.             _PRINTSTRING (dayx + 27, weeky + 60), "Labor"
  188.         END IF
  189.         IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN
  190.             GOSUB coloring:
  191.             _PRINTSTRING (dayx + 17, weeky + 60), "Columbus"
  192.         END IF
  193.         IF m = 10 AND dd = 31 THEN
  194.             GOSUB coloring:
  195.             _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
  196.         END IF
  197.         IF m = 11 AND dd = 11 THEN
  198.             GOSUB coloring:
  199.             _PRINTSTRING (dayx + 19, weeky + 60), "Veterans"
  200.         END IF
  201.         IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN
  202.             GOSUB coloring:
  203.             _PRINTSTRING (dayx + 2, weeky + 60), "Thanksgiving"
  204.         END IF
  205.         IF m = 12 AND dd = 25 THEN
  206.             GOSUB coloring:
  207.             _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
  208.         END IF
  209.         _FONT 16
  210.         _PRINTSTRING (dayx, weeky), dd$
  211.         _FONT 8
  212.         IF dd = days THEN _FONT 16: GOTO more2:
  213.     NEXT dayx
  214.     w = 25
  215. NEXT weeky
  216.  
  217. more2:
  218. _LIMIT 1000
  219. a$ = INKEY$
  220. IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
  221. IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  222. IF a$ = " " THEN GOTO start:
  223. IF a$ = "p" OR a$ = "P" THEN
  224.     'printer prep (code copied and pasted from bplus Free Calendar Program)
  225.     YMAX = _HEIGHT: XMAX = _WIDTH
  226.     landscape& = _NEWIMAGE(YMAX, XMAX, 32)
  227.     _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
  228.     _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
  229.     _PRINTIMAGE landscape&
  230.  
  231. IF a$ = CHR$(0) + CHR$(77) THEN
  232.     m = m + 1
  233.     IF m > 12 THEN
  234.         m = 1
  235.         yy = yy + 1
  236.     END IF
  237.     y = yy
  238.     IF y > 9999 THEN y = 1753
  239.     dd = 0
  240.     leap = 0
  241.     _DELAY .1
  242.     CLS
  243.     GOTO calculate:
  244. IF a$ = CHR$(0) + CHR$(75) THEN
  245.     m = m - 1
  246.     IF m < 1 THEN
  247.         m = 12
  248.         yy = yy - 1
  249.     END IF
  250.     y = yy
  251.     IF y < 1753 THEN y = 9999
  252.     dd = 0
  253.     leap = 0
  254.     _DELAY .1
  255.     CLS
  256.     GOTO calculate:
  257.  
  258. GOTO more2:
  259.  
  260. 'Color all Sundays and holidays
  261. coloring:
  262. LINE (dayx - 4, weeky - 9)-(dayx + 102, weeky + 68), _RGB32(255, 255, 127), BF: COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 127)
  263.  
  264.  
  265. 'Find the right date for Easter.
  266. PAQUES:
  267. PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
  268. PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
  269. PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
  270. PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
  271. PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
  272. PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
  273.  
  274.  
  275. 'This section saves the calendar to a BMP file along with the SUB at the end of this program.
  276. saving:
  277. mo$ = STR$(m)
  278. mo$ = LTRIM$(RTRIM$(mo$))
  279. year$ = STR$(yy)
  280. year$ = LTRIM$(RTRIM$(year$))
  281. nm$ = mo$ + "-"
  282. nm$ = LTRIM$(RTRIM$(nm$))
  283. nm$ = nm$ + year$
  284. nm$ = LTRIM$(RTRIM$(nm$))
  285. SaveImage 0, nm$ 'saves entire program screen,"
  286. nm2$ = nm$ + ".bmp"
  287. nm2$ = LTRIM$(RTRIM$(nm2$))
  288. PRINT "                                           Saving"
  289. PRINT "                          "; nm2$; " has been saved to your computer."
  290. INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
  291. IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
  292. PRINT "                         Goodbye."
  293.  
  294. weekdays:
  295.  
  296. 'This section gets the right weekday.
  297. SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
  298.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
  299.     IF mm < 3 THEN mm = mm + 12: y = y - 1
  300.     century = y MOD 100
  301.     zerocentury = y \ 100
  302.     weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
  303.  
  304. 'This section saves the .bmp picture file.
  305. SUB SaveImage (image AS LONG, filename AS STRING)
  306.     bytesperpixel& = _PIXELSIZE(image&)
  307.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  308.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  309.     x& = _WIDTH(image&)
  310.     y& = _HEIGHT(image&)
  311.     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)
  312.     IF bytesperpixel& = 1 THEN
  313.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  314.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  315.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  316.         NEXT
  317.     END IF
  318.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  319.     lastsource& = _SOURCE
  320.     _SOURCE image&
  321.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  322.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
  323.         r$ = ""
  324.         FOR px& = 0 TO x& - 1
  325.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  326.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  327.         NEXT px&
  328.         d$ = d$ + r$ + padder$
  329.     NEXT py&
  330.     _SOURCE lastsource&
  331.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  332.     b$ = b$ + d$ ' total file data bytes to create file
  333.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  334.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  335.     f& = FREEFILE
  336.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  337.     OPEN filename$ + ext$ FOR BINARY AS #f&
  338.     PUT #f&, , b$
  339.     CLOSE #f&
  340.  
  341.  

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Calendar Maker
« Reply #36 on: September 19, 2019, 02:12:35 pm »
I just added the option of creating a calendar without holidays so people of other countries can write-in ones of their own after they print them on paper. It still has all the Sundays as yellow.

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 colored Sundays and holidays and the option of not having U.S. holidays.
  6. 'Made on Thursday, September 19, 2019 by Ken G.
  7.  
  8. start:
  9. _TITLE "Calendar Maker"
  10. _LIMIT 1000
  11. dd = 0
  12. leap = 0
  13. m = 0
  14. mm = 0
  15. y = 0
  16. yy = 0
  17. w = 0
  18. weekday = 0
  19. days = 0
  20. holidays = 0
  21. SCREEN _NEWIMAGE(800, 600, 32)
  22. PRINT "                                  Monthly Calendar Maker"
  23. PRINT "                                        By Ken G."
  24. PRINT "                         With some help from the QB64.org Forum guys!"
  25. PRINT "          This program will make a calendar for the year and month you want."
  26. PRINT "          It will also name some U.S. holidays on their dates if you choose that."
  27. PRINT "          This uses the Gregorian Calendar which became common practice in"
  28. PRINT "          England in 1753 and we still use it today."
  29. PRINT "          First make a calendar, then if you want to save it as a .bmp file,"
  30. PRINT "          press the 'S' key and it will save it as the month and year for its name."
  31. PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
  32. PRINT "          press the 'S' key and it will save it as 1-2020.bmp"
  33. PRINT "          If you wish to print your calendar on your printer, press 'P' once."
  34. PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
  35. PRINT "          If you save the .bmp calendar, it will be put in the same directory as this program."
  36. PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
  37. PRINT "          To make a different calendar without saving, press the Space Bar."
  38. PRINT "          Keyboard commands will be listed on the title bar of the window."
  39. again1:
  40. INPUT "          Type the year here (1753-9999): ", y
  41. IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
  42. IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
  43. again2:
  44. INPUT "          Type the month here (1-12): ", m
  45. IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
  46. IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
  47. INPUT "          Do you want U.S. holidays added (Y/N)?", hol$
  48. IF LEFT$(hol$, 1) = "y" OR LEFT$(hol$, 1) = "Y" THEN holidays = 1
  49. calculate:
  50. 'Get the month name.
  51. IF m = 1 THEN month$ = " January"
  52. IF m = 2 THEN month$ = "February"
  53. IF m = 3 THEN month$ = "  March"
  54. IF m = 4 THEN month$ = "  April"
  55. IF m = 5 THEN month$ = "  May"
  56. IF m = 6 THEN month$ = "  June"
  57. IF m = 7 THEN month$ = "  July"
  58. IF m = 8 THEN month$ = " August"
  59. IF m = 9 THEN month$ = "September"
  60. IF m = 10 THEN month$ = " October"
  61. IF m = 11 THEN month$ = "November"
  62. IF m = 12 THEN month$ = "December"
  63.  
  64. 'Calculate to see if it's a Leap Year.
  65. IF m <> 2 THEN GOTO nex:
  66. IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
  67. IF y / 4 = INT(y / 4) THEN leap = 1
  68. IF y / 100 = INT(y / 100) THEN leap = 0
  69.  
  70. 'Get the number of days for each month.
  71. more:
  72. IF leap = 1 THEN days = 29
  73. IF leap = 0 THEN days = 28
  74. GOTO weekday:
  75. nex:
  76. IF m = 1 THEN days = 31
  77. IF m = 3 THEN days = 31
  78. IF m = 4 THEN days = 30
  79. IF m = 5 THEN days = 31
  80. IF m = 6 THEN days = 30
  81. IF m = 7 THEN days = 31
  82. IF m = 8 THEN days = 31
  83. IF m = 9 THEN days = 30
  84. IF m = 10 THEN days = 31
  85. IF m = 11 THEN days = 30
  86. IF m = 12 THEN days = 31
  87. weekday:
  88.  
  89. 'Set the month, year, and weekday variables to start with.
  90. mm = m
  91. yy = y
  92. GetDay mm, dd, y, weekday
  93.  
  94. 'This section makes the calendar graph.
  95. make:
  96. SCREEN _NEWIMAGE(800, 600, 32)
  97. LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
  98. _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."
  99. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
  100. LOCATE 3, 42: PRINT month$; "  "; yy
  101.  
  102. FOR x = 20 TO 780 STEP 108
  103.     LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
  104. FOR z = 100 TO 580 STEP 80
  105.     LINE (16, z)-(780, z), _RGB32(0, 0, 0)
  106.  
  107. LOCATE 5, 8: PRINT "SUNDAY"
  108. LOCATE 5, 21: PRINT "MONDAY"
  109. LOCATE 5, 34: PRINT "TUESDAY"
  110. LOCATE 5, 47: PRINT "WEDNESDAY"
  111. LOCATE 5, 60: PRINT "THURSDAY"
  112. LOCATE 5, 75: PRINT "FRIDAY"
  113. LOCATE 5, 87: PRINT "SATURDAY"
  114.  
  115. 'Finding Date of Easter
  116. PQA = yy
  117. GOSUB PAQUES
  118. 'month = PQM, day = PQJ, year = PQA
  119.  
  120. 'This section puts the right dates and holidays in the right squares for the calendar.
  121. w = (weekday * 108) + 25
  122. FOR weeky = 110 TO 570 STEP 80
  123.     FOR dayx = w TO 692 STEP 108
  124.         _LIMIT 1000
  125.         dd = dd + 1
  126.         GetDay mm, dd, y, weekday
  127.         IF weekday = 1 THEN GOSUB coloring:
  128.         IF weekday <> 1 THEN COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
  129.         dd$ = STR$(dd)
  130.         IF holidays = 0 THEN GOTO skip:
  131.         _FONT 8
  132.         IF m = 1 AND dd = 1 THEN
  133.             GOSUB coloring:
  134.             _PRINTSTRING (dayx + 15, weeky + 60), "New Years"
  135.         END IF
  136.         IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
  137.             GOSUB coloring:
  138.             _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
  139.         END IF
  140.         IF m = 2 AND dd = 2 THEN
  141.             GOSUB coloring:
  142.             _PRINTSTRING (dayx + 13, weeky + 60), "Groundhog"
  143.         END IF
  144.         IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
  145.             GOSUB coloring:
  146.             _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
  147.         END IF
  148.         IF m = 2 AND dd = 14 THEN
  149.             GOSUB coloring:
  150.             _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
  151.         END IF
  152.         IF m = 3 AND dd = 17 THEN
  153.             GOSUB coloring:
  154.             _PRINTSTRING (dayx + 5, weeky + 60), "St. Patrick"
  155.         END IF
  156.         IF m = PQM AND dd = PQJ THEN
  157.             GOSUB coloring:
  158.             _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
  159.         END IF
  160.         IF m = 4 AND dd > 23 AND weekday = 7 THEN
  161.             GOSUB coloring:
  162.             _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
  163.         END IF
  164.         IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN
  165.             GOSUB coloring:
  166.             _PRINTSTRING (dayx + 2, weeky + 60), "Armed Forces"
  167.         END IF
  168.         IF m = 5 AND weekday = 2 AND dd > 24 THEN
  169.             GOSUB coloring:
  170.             _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
  171.         END IF
  172.         IF m = 5 AND weekday = 1 AND dd > 7 AND dd < 15 THEN
  173.             GOSUB coloring:
  174.             _PRINTSTRING (dayx + 2, weeky + 60), "Mother's Day"
  175.         END IF
  176.         IF m = 6 AND weekday = 1 AND dd > 14 AND dd < 22 THEN
  177.             GOSUB coloring:
  178.             _PRINTSTRING (dayx + 2, weeky + 60), "Father's Day"
  179.         END IF
  180.         IF m = 6 AND dd = 14 THEN
  181.             GOSUB coloring:
  182.             _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
  183.         END IF
  184.         IF m = 7 AND dd = 4 THEN
  185.             GOSUB coloring:
  186.             _PRINTSTRING (dayx + 2, weeky + 60), "Independence"
  187.         END IF
  188.         IF m = 9 AND weekday = 2 AND dd < 8 THEN
  189.             GOSUB coloring:
  190.             _PRINTSTRING (dayx + 27, weeky + 60), "Labor"
  191.         END IF
  192.         IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN
  193.             GOSUB coloring:
  194.             _PRINTSTRING (dayx + 17, weeky + 60), "Columbus"
  195.         END IF
  196.         IF m = 10 AND dd = 31 THEN
  197.             GOSUB coloring:
  198.             _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
  199.         END IF
  200.         IF m = 11 AND dd = 11 THEN
  201.             GOSUB coloring:
  202.             _PRINTSTRING (dayx + 19, weeky + 60), "Veterans"
  203.         END IF
  204.         IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN
  205.             GOSUB coloring:
  206.             _PRINTSTRING (dayx + 2, weeky + 60), "Thanksgiving"
  207.         END IF
  208.         IF m = 12 AND dd = 25 THEN
  209.             GOSUB coloring:
  210.             _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
  211.         END IF
  212.         skip:
  213.         _FONT 16
  214.         _PRINTSTRING (dayx, weeky), dd$
  215.         _FONT 8
  216.         IF dd = days THEN _FONT 16: GOTO more2:
  217.     NEXT dayx
  218.     w = 25
  219. NEXT weeky
  220.  
  221. more2:
  222. _LIMIT 1000
  223. a$ = INKEY$
  224. IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
  225. IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  226. IF a$ = " " THEN GOTO start:
  227. IF a$ = "p" OR a$ = "P" THEN
  228.     'printer prep (code copied and pasted from bplus Free Calendar Program)
  229.     YMAX = _HEIGHT: XMAX = _WIDTH
  230.     landscape& = _NEWIMAGE(YMAX, XMAX, 32)
  231.     _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
  232.     _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
  233.     _PRINTIMAGE landscape&
  234.  
  235. IF a$ = CHR$(0) + CHR$(77) THEN
  236.     m = m + 1
  237.     IF m > 12 THEN
  238.         m = 1
  239.         yy = yy + 1
  240.     END IF
  241.     y = yy
  242.     IF y > 9999 THEN y = 1753
  243.     dd = 0
  244.     leap = 0
  245.     _DELAY .1
  246.     CLS
  247.     GOTO calculate:
  248. IF a$ = CHR$(0) + CHR$(75) THEN
  249.     m = m - 1
  250.     IF m < 1 THEN
  251.         m = 12
  252.         yy = yy - 1
  253.     END IF
  254.     y = yy
  255.     IF y < 1753 THEN y = 9999
  256.     dd = 0
  257.     leap = 0
  258.     _DELAY .1
  259.     CLS
  260.     GOTO calculate:
  261.  
  262. GOTO more2:
  263.  
  264. 'Color all Sundays and holidays
  265. coloring:
  266. LINE (dayx - 4, weeky - 9)-(dayx + 102, weeky + 68), _RGB32(255, 255, 127), BF: COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 127)
  267.  
  268.  
  269. 'Find the right date for Easter.
  270. PAQUES:
  271. PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
  272. PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
  273. PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
  274. PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
  275. PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
  276. PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
  277.  
  278.  
  279. 'This section saves the calendar to a BMP file along with the SUB at the end of this program.
  280. saving:
  281. mo$ = STR$(m)
  282. mo$ = LTRIM$(RTRIM$(mo$))
  283. year$ = STR$(yy)
  284. year$ = LTRIM$(RTRIM$(year$))
  285. nm$ = mo$ + "-"
  286. nm$ = LTRIM$(RTRIM$(nm$))
  287. nm$ = nm$ + year$
  288. nm$ = LTRIM$(RTRIM$(nm$))
  289. SaveImage 0, nm$ 'saves entire program screen,"
  290. nm2$ = nm$ + ".bmp"
  291. nm2$ = LTRIM$(RTRIM$(nm2$))
  292. PRINT "                                           Saving"
  293. PRINT "                          "; nm2$; " has been saved to your computer."
  294. INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
  295. IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
  296. PRINT "                         Goodbye."
  297.  
  298. weekdays:
  299.  
  300. 'This section gets the right weekday.
  301. SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
  302.     'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
  303.     IF mm < 3 THEN mm = mm + 12: y = y - 1
  304.     century = y MOD 100
  305.     zerocentury = y \ 100
  306.     weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
  307.  
  308. 'This section saves the .bmp picture file.
  309. SUB SaveImage (image AS LONG, filename AS STRING)
  310.     bytesperpixel& = _PIXELSIZE(image&)
  311.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  312.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  313.     x& = _WIDTH(image&)
  314.     y& = _HEIGHT(image&)
  315.     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)
  316.     IF bytesperpixel& = 1 THEN
  317.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  318.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  319.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  320.         NEXT
  321.     END IF
  322.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  323.     lastsource& = _SOURCE
  324.     _SOURCE image&
  325.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  326.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
  327.         r$ = ""
  328.         FOR px& = 0 TO x& - 1
  329.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  330.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  331.         NEXT px&
  332.         d$ = d$ + r$ + padder$
  333.     NEXT py&
  334.     _SOURCE lastsource&
  335.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  336.     b$ = b$ + d$ ' total file data bytes to create file
  337.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  338.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  339.     f& = FREEFILE
  340.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  341.     OPEN filename$ + ext$ FOR BINARY AS #f&
  342.     PUT #f&, , b$
  343.     CLOSE #f&
  344.  
« Last Edit: September 20, 2019, 01:12:16 am by SierraKen »

Offline Jack002

  • Forum Regular
  • Posts: 123
  • Boss, l wanna talk about arrays
    • View Profile
Re: Calendar Maker
« Reply #37 on: September 19, 2019, 05:26:44 pm »
I like the one on post #35 best. Very nice work. Bravo.
QB64 is the best!

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Calendar Maker
« Reply #38 on: September 19, 2019, 09:43:36 pm »
Thanks Jack. I'm working on letting people add up to 12 characters and spaces to any day of the month with the computer. But it won't save any info.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Calendar Maker
« Reply #39 on: September 20, 2019, 01:11:38 am »
Awesome I completed what I wanted! Now people can make a calendar with their own words on any date using their computer. You can also add info on the same days as holidays because it puts the text above the holiday names. And as before, you have the option of removing all the U.S. holidays as well. The holidays and any info you make also makes that day filled with yellow too so it's easy to see. Yesterday I printed one out with the new yellow on my b/w printer and it just makes a light shade of gray, which is perfect on a b/w printer. I tried for awhile to make it where people don't have to go from smallest date to highest date when they add stuff to the calendar, but with the loops I use for finding the certain days, it just wasn't compatible, as far as I know anyway. I'm sure someone might be able to change it someday, but this is good. I did though make the computer catch you if you did try to put info for like the 1st after the 15th and it tells you to start over again for that calendar. Everything is self-explanatory. The limit on info per-date is 12 letters, numbers, characters, or spaces.  Now everyone can make their own personal, typed out, monthly calendars any way they want to with their own information. Also, as I said earlier, there are no data files created or needed using this program, unless you wish to save one with it as a BMP picture. To save one, press the S key as it says above on the program. And to print one on the printer, press the P key once. Switching months with the arrow keys will not save your new added information if you come back to that month. This program can be used around the house or at a business. Enjoy.

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


Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Calendar Maker
« Reply #40 on: September 20, 2019, 07:35:27 am »
Oh Thanks SierraKen

It seems cooler than first one

 
calendarMaler3.jpg


but remember to print o save as image before change mounth by keyboard!
Programming isn't difficult, only it's  consuming time and coffee

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Calendar Maker
« Reply #41 on: September 20, 2019, 09:48:17 am »
Great work Ken - after this thread cools down for a minute, this prog will end up in Samples.
You're not done when it works, you're done when it's right.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Calendar Maker
« Reply #42 on: September 20, 2019, 01:23:18 pm »
Thanks you 2!!! Would love it in the Samples area. I strongly believe this is the best program I've ever made out of programming in BASIC since the 80's.

Marked as best answer by SierraKen on September 20, 2019, 12:14:54 pm

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Calendar Maker
« Reply #43 on: September 20, 2019, 04:14:40 pm »
I just tried to see if people can remake a day's info after making the same day's info and it just keeps the first one. Probably because I used an array on the days and the day of the edit has to match the day it numbers, etc. so since it was already done, it went to the next day instead of backtracking to edit again. So I just added one line of text saying if you messed up, just make a new calendar.

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