Print Page - Calendar Maker

Active Forums => Programs => Topic started by: SierraKen on August 05, 2019, 01:55:20 am

Title: Calendar Maker
Post by: SierraKen on August 05, 2019, 01:55:20 am

Here is the Calendar Maker program I've worked on in the last couple days. I'm 99.9% sure it is finished. I know I could have done it differently and not used LOCATE on my numbers and holidays, but with the math I used and the loops, and all the hard work I did to make things fit in the boxes, I'm just going to leave it like this. If you use it enough, you might come across holiday names that don't look centered at all, but I'm just going to leave it like this. This is the first calendar program I've ever made. Thank you to B+, SMcNeill, and euklides for your help. I added your names to the code at the top. I find it pretty neat how you can use this program to go from the mid-1700's to 9999. You can also make one of the month you were born. You also can save the calendars as JPG pictures, with a different name for every month and year. I say in the welcome screen that you can use Windows Paint or any other graphics program to print it out. I printed out the month I was born. :) You also can use this program to use it as a tool to print them out and write tiny reminders for certain days. I thought about adding that to the program, but I don't know enough about making data files to do that. I would end up making a separate data file for every single reminder and that would be a mess. Plus I feel pretty confident that this is complete for me and I finally made a neat calendar maker. Of course anyone can use the code and expand on it from here if they wish. But please try it out. I suggest putting it in a separate directory so you can find your calendar JPG files easy. For example, the picture file for January 2000 would be made like this: 1-2000.jpg. I did it that way so they would line up in the Windows directory in order. Have fun with it!
P..S. Also, I know there's ways to print out pictures, and probably even rotate them first before you print them, but I haven't looked too much into that and I'm very cautious about printing graphics with my programs because twice so far I've printed 2 of them where it made the entire papers black, which is so much toner wasted in the printer.

(Note: As usual, this first paste isn't the best, so scroll down, thanks.)

Code: QB64: [Select]

'This is my very first calendar making program!
'Thanks to the guys from the QB64.org forum for the help, B+, SMcNeill, and euklides!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'Made on Sunday, August 4, 2019 by Ken G.
'
_TITLE "Calendar Maker"
start:
dd = 0
leap = 0
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PRINT "                                     Monthly Calendar Maker"
PRINT: PRINT: PRINT
PRINT "                                           By Ken G."
PRINT: PRINT: PRINT
PRINT "             This program will make a calendar for the year and month you want."
PRINT "             It will also name some holidays on their days."
PRINT "             This uses the Gregorian Calendar which became common practice in"
PRINT "             England in 1753."
PRINT "             First make a calender, then if you want to save it as a .jpg file,"
PRINT "             press the 'S' key and it will save it as the month and year for its name."
PRINT "             For example, if you made a calendar for January 2020 and wish to save it,"
PRINT "             press the 'S' key and it will save it as 1-2020.jpg"
PRINT "             Feel free to use a different program to change the picture as you wish and"
PRINT "             also print it with a printer, with Windows Paint or something else."
PRINT "             The .jpg calendar picture will be saved in the same directory as this program."
PRINT "             To make a new calendar without saving, press the Space Bar."
PRINT "             Keyboard commands will be listed on the title bar of the window."
again1:
PRINT
INPUT "             Type the year here (1753-9999): ", y
IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
again2:
PRINT
INPUT "             Type the month here (1-12): ", m
PRINT
IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
 
'Get the month name.
IF m = 1 THEN month$ = " January"
IF m = 2 THEN month$ = "February"
IF m = 3 THEN month$ = "  March"
IF m = 4 THEN month$ = "  April"
IF m = 5 THEN month$ = "  May"
IF m = 6 THEN month$ = "  June"
IF m = 7 THEN month$ = "  July"
IF m = 8 THEN month$ = " August"
IF m = 9 THEN month$ = "September"
IF m = 10 THEN month$ = " October"
IF m = 11 THEN month$ = "November"
IF m = 12 THEN month$ = "December"
 
'Calculate to see if it's a Leap Year.
IF m <> 2 THEN GOTO nex:
IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
IF y / 4 = INT(y / 4) THEN leap = 1
IF y / 100 = INT(y / 100) THEN leap = 0
 
'Get the number of days for each month.
more:
IF leap = 1 THEN days = 29
IF leap = 0 THEN days = 28
GOTO weekday:
nex:
IF m = 1 THEN days = 31
IF m = 3 THEN days = 31
IF m = 4 THEN days = 30
IF m = 5 THEN days = 31
IF m = 6 THEN days = 30
IF m = 7 THEN days = 31
IF m = 8 THEN days = 31
IF m = 9 THEN days = 30
IF m = 10 THEN days = 31
IF m = 11 THEN days = 30
IF m = 12 THEN days = 31
weekday:
 
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, y, weekday
 
'This section makes the calendar graph.
make:
CLS
_TITLE "Press 'S' to Save, Space Bar to make another calendar, or 'Esc' to quit."
LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
COLOR _RGB(0, 0, 0), _RGB(255, 255, 255)
LOCATE 3, 42: PRINT month$; "  "; yy
 
FOR x = 20 TO 780 STEP 108
    LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
NEXT x
FOR z = 100 TO 580 STEP 80
    LINE (16, z)-(780, z), _RGB32(0, 0, 0)
NEXT z
 
LOCATE 5, 8: PRINT "SUNDAY"
LOCATE 5, 21: PRINT "MONDAY"
LOCATE 5, 34: PRINT "TUESDAY"
LOCATE 5, 47: PRINT "WEDNESDAY"
LOCATE 5, 60: PRINT "THURSDAY"
LOCATE 5, 75: PRINT "FRIDAY"
LOCATE 5, 87: PRINT "SATURDAY"
 
'Finding Date of Easter
PQA = yy
GOSUB PAQUES
'month = PQM, day = PQJ, year = PQA
 
'This section puts the right dates and holidays in the right squares for the calendar.
_FONT 16
w = (weekday * 13) + 8
FOR week = 8 TO 59 STEP 5
    FOR day = w TO 91 STEP 13
        dd = dd + 1
        GetDay mm, dd, y, weekday
        IF weekday = 0 THEN LOCATE week, day + 2: PRINT dd
        IF weekday = 1 THEN LOCATE week, day - 2: PRINT dd
        IF weekday = 2 THEN LOCATE week, day - 2: PRINT dd
        IF weekday = 3 THEN LOCATE week, day - 1: PRINT dd
        IF weekday = 4 THEN LOCATE week, day: PRINT dd
        IF weekday > 4 THEN LOCATE week, day + 2: PRINT dd
        IF m = 1 AND dd = 1 THEN LOCATE week + 2, day - 1: PRINT "New Years": LOCATE week + 3, day: PRINT "Day"
        IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN LOCATE week + 2, day - 1: PRINT "MLK Jr.": LOCATE week + 3, day: PRINT "Day"
        IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN LOCATE week + 2, day + 3: PRINT "Pres.": LOCATE week + 3, day + 3: PRINT "Day"
        IF m = 2 AND dd = 14 THEN LOCATE week + 2, day + 3: PRINT "Val.": LOCATE week + 3, day + 3: PRINT "Day"
        IF m = PQM AND dd = PQJ THEN LOCATE week + 2, day - 1: PRINT "Easter"
        IF m = 5 AND weekday = 2 AND dd > 24 THEN LOCATE week + 2, day - 1: PRINT "Mem.": LOCATE week + 3, day - 1: PRINT "Day"
        IF m = 7 AND dd = 4 THEN LOCATE week + 2, day - 1: PRINT "Independ.": LOCATE week + 3, day + 2: PRINT "Day"
        IF m = 9 AND weekday = 2 AND dd < 8 THEN LOCATE week + 2, day - 2: PRINT "Labor Day"
        IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN LOCATE week + 2, day - 1: PRINT "Columbus": LOCATE week + 3, day: PRINT "Day"
        IF m = 10 AND dd = 31 THEN LOCATE week + 2, day: PRINT "Halloween"
        IF m = 11 AND dd = 11 THEN LOCATE week + 2, day: PRINT "Veterans": LOCATE week + 3, day: PRINT "Day"
        IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN LOCATE week + 2, day - 1: PRINT "Thanksgiving"
        IF m = 12 AND dd = 25 THEN LOCATE week + 2, day + 1: PRINT "Christmas"
        IF dd = days THEN GOTO more2:
    NEXT day
    w = 7
NEXT week
more2:
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
GOTO more2:
 
 
'Find the right date for Easter.
PAQUES:
PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
RETURN
 
 
'This section saves the calendar to a JPG file along with the SUB at the end of this program.
saving:
mo$ = STR$(m)
mo$ = LTRIM$(RTRIM$(mo$))
year$ = STR$(yy)
year$ = LTRIM$(RTRIM$(year$))
nm$ = mo$ + "-"
nm$ = LTRIM$(RTRIM$(nm$))
nm$ = nm$ + year$
nm$ = LTRIM$(RTRIM$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
CLS
nm2$ = nm$ + ".jpg"
nm2$ = LTRIM$(RTRIM$(nm2$))
PRINT: PRINT: PRINT
PRINT "          "; nm2$; " has been saved to your computer."
PRINT
INPUT "          Do you wish to make another calendar (Yes/No)"; ag$
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "          Goodbye."
END
 
weekdays:
 
'This section gets the right weekday.
SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: y = y - 1
    century = y MOD 100
    zerocentury = y \ 100
    weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
END SUB
 
'This section saves the .jpg picture file.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".jpg" THEN ext$ = ".jpg"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
 

Title: Re: Calendar Maker
Post by: euklides on August 05, 2019, 04:13:05 am

Of course only available in the States for the holidays and national holidays.

Well done, and now the next steps would be :
- moon phase (% %)
- spring, summer autumn & winter days...
- day number 1... 365 (356)
- week number 1... 52 (53)
- julian date

In fact, when you work with making a calendar, there are a lot of complications !

Title: Re: Calendar Maker
Post by: johnno56 on August 05, 2019, 10:14:39 am

Cool. Nicely done!

Title: Re: Calendar Maker
Post by: Jack002 on August 05, 2019, 10:31:24 am

Very cool. I once made a program that makes a calendar in HTML with tables. I was lazy and asked the user the number of days and what day the calendar starts on. I never put that in to automate that. This and mine would be an interesting combo.
[I have had a need for an html cal for years, its for a website I'm on]

Title: Re: Calendar Maker
Post by: SMcNeill on August 05, 2019, 10:48:02 am

Clippy’s “Calendos” Program from 1988. I think it still works in QB64, but I haven’t tested it yet to be certain.

Code: [Select]

CALENDOS.BAS
'
' COMPUTER GENERATED CALENDER
'
' FILE records all holidays and weekends
' for accurate business days in year
'
DEFINT A-Z
'_FULLSCREEN 'QB64
DECLARE SUB GetDay (strday$, daynm%)
DECLARE SUB LeapYear (yr%, Lpy$, fday%)
DECLARE SUB Easter (yrn%, EM%, ED%)
OPTION BASE 1
DIM Day%(7, 6)
DIM Hol%(4)
DIM Rel%(4)
CLS
10
CLS
SCREEN 13
OUT &H3C8, 0 'assign color number 1 TO 15 in Screen 12
OUT &H3C9, 0 'red value
OUT &H3C9, 0 'green value
OUT &H3C9, 15 'blue value

SOUND 300, 4
'SOUND 700, 3 'Opening screen
COLOR 9
LOCATE 5, 13: PRINT "CALENDOS PROGRAM"
LOCATE 20, 3: PRINT "Year number or enter for present year:"
in$ = ""
DO: _LIMIT 100 'Get Input from User QB64
a$ = INKEY$
IF a$ <> "" AND a$ > CHR$(47) AND a$ < CHR$(58) THEN 'filter for numbers only
in$ = in$ + a$
ELSEIF a$ <> "" THEN EXIT DO
END IF
LOCATE 10, 15: PRINT "Year = "; in$
LOOP UNTIL LEN(in$) = 4
SLEEP 1
IF LEN(in$) = 4 THEN
Year$ = in$ 'Get year from user 4 digit
ELSE: Year$ = MID$(DATE$, 7, 4) 'get year from the actual date
END IF

yrn% = VAL(Year$) ' Check for number of year for leap year calculate
yrnum% = yrn% 'yrnum% is for adding year in second January and display
LeapYear yrn%, Lpy$, frstday%
Easter yrn%, EM%, ED%


num% = frstday% ' set first month 1st day position for calendar
37
'_______________READ NUM OF DAYS _____________ INKEY LOOP for months
FOR month% = 1 TO 13 'includes January of next year 13 months
ERASE Day%
fst% = num% 'get first day number(day) from num% for other months

SELECT CASE month% 'DAYS OF MONTH
CASE 2
IF Lpy$ = "N" THEN days% = 28
IF Lpy$ = "Y" THEN days% = 29
CASE 4, 6, 9, 11
days% = 30
CASE ELSE ' all other months have 31 days
days% = 31
END SELECT
week% = 1
FOR d% = 1 TO days% 'ASSIGN NUMBERS TO DAYS ARRAY
Day%(num%, week%) = d%
IF num% = 7 THEN
num% = 0
week% = 1 + week%
END IF
num% = 1 + num% 'SET NUMBER FOR NEXT MONTH
NEXT d%

'>>>>>>>>>>>>>>>>>>>>>>>> SELECT HOLIDAYS

ERASE Hol%, Rel% 'for each month
mond% = 0
tue% = 0
thu% = 0
'ADJUST FOR MONTHS WITHOUT DAY IN 1ST WEEK
IF Day%(2, 1) = 0 THEN mond% = 1
IF Day%(5, 1) = 0 THEN thu% = 1
IF Day%(3, 1) = 0 THEN tue% = 1

SELECT CASE month% 'holiday 2nd monday = Day%(2, 3)
CASE 1
mon$ = "JANUARY"
Hol%(1) = 1
Hol%(2) = Day%(2, 3 + mond%)
CASE 2
mon$ = "FEBRUARY"
Hol%(1) = Day%(2, 3 + mond%)
CASE 3
mon$ = "MARCH"
IF EM% = 3 THEN Rel%(1) = ED%
CASE 4
mon$ = "APRIL"
IF EM% = 4 THEN Rel%(1) = ED%
CASE 5
mon$ = "MAY"
Hol%(1) = Day%(2, 4 + mond%)
IF Day%(2, 5 + mond%) > 0 THEN Hol%(1) = Day%(2, 5 + mond%) 'last monday of month
CASE 6
mon$ = "JUNE"
CASE 7
mon$ = "JULY"
Hol%(1) = 4
CASE 8
mon$ = "AUGUST"
CASE 9
mon$ = "SEPTEMBER"
Hol%(1) = Day%(2, 1 + mond%)
CASE 10
mon$ = "OCTOBER"
Hol%(1) = Day%(2, 2 + mond%)
CASE 11
mon$ = "NOVEMBER"
Hol%(1) = Day%(3, 1 + tue%)
Hol%(2) = 11
Hol%(3) = Day%(5, 4 + thu%)
CASE 12
mon$ = "DECEMBER"
Hol%(1) = 25
CASE 13
mon$ = "JANUARY"
Hol%(1) = 1
Hol%(2) = Day%(2, 3 + mond%)
END SELECT
tomonth$ = MID$(DATE$, 1, 2) 'Get todays month in time line
IF MID$(tomonth$, 1, 1) = "0" THEN tomonth$ = MID$(DATE$, 2, 1)
SELECT CASE tomonth$ 'get month name
CASE "1": moon$ = "Jan."
CASE "2": moon$ = "Feb."
CASE "3": moon$ = "Mar."
CASE "4": moon$ = "Apr."
CASE "5": moon$ = "May "
CASE "6": moon$ = "June"
CASE "7": moon$ = "July"
CASE "8": moon$ = "Aug."
CASE "9": moon$ = "Sep."
CASE "10": moon$ = "Oct."
CASE "11": moon$ = "Nov."
CASE "12": moon$ = "Dec."
END SELECT
today$ = MID$(DATE$, 4, 2) 'Get todays date
yr$ = MID$(DATE$, 7, 4)
'Figure name of the day of week near clock using actual date
IF month% = 1 THEN
datenum% = VAL(today$) 'find date number
monthnum% = VAL(tomonth$) 'find month number
yrno% = VAL(yr$) ' find year number
LeapYear yrno%, Lp$, fstday% 'check if leap Get first day position number
mon1st% = fstday%
FOR i% = 1 TO monthnum% - 1
SELECT CASE i%
CASE 2
IF Lp$ = "N" THEN mon1st% = mon1st% + 28 'Feb
IF Lp$ = "Y" THEN mon1st% = mon1st% + 29
CASE 4, 6, 9, 11
mon1st% = mon1st% + 30 'April, June, Sept, Nov
CASE ELSE
mon1st% = mon1st% + 31 ' all others have 31 days
END SELECT
NEXT i%
IF Lp$ = "N" THEN lpno% = 365
IF Lp$ = "Y" THEN lpno% = 366
dayofyear% = mon1st% + datenum% - fstday%
IF Lp$ = "Y" AND dayofyear% >= 60 THEN dayofyear% = dayofyear% + 1
fstofmo% = mon1st% MOD 7 'finds day value of 1st day of month
daynum% = (datenum% + fstofmo% - 1) MOD 7 'finds value of actual day

SELECT CASE daynum% 'assign week day name
CASE 0: wd$ = "Sat"
CASE 1: wd$ = "Sun"
CASE 2: wd$ = "Mon"
CASE 3: wd$ = "Tue"
CASE 4: wd$ = "Wed"
CASE 5: wd$ = "Thu"
CASE 6: wd$ = "Fri"
END SELECT
END IF
COLOR 8
CLS

'*********************** PRINT CALENDER
COLOR 8
LOCATE 23, 7: PRINT "Any key for next month! "
IF month% = 13 THEN
SOUND 500, 3
'SOUND 700, 4
yrnum% = yrnum% + 1 ' add 1 for next year
LOCATE 23, 7: PRINT " Any key ends program! "
END IF
COLOR 13
LOCATE 2, 8: PRINT mon$
LOCATE 2, 24: PRINT yrnum%
COLOR 1
LOCATE 4, 8: PRINT "S M T W T F S "
COLOR 7
LOCATE 21, 7: PRINT "Day Num"; dayofyear%; " Left"; lpno% - dayofyear%
'LOCATE and PRINT day numbers............. from Day%() Array
FOR r% = 1 TO 6 'week loop r% begin
FOR c% = 1 TO 7 'day loop and colors
COLOR 14 'normal day color
IF c% = 1 OR c% = 7 THEN COLOR 5 'color weekends
FOR i% = 1 TO 3
IF Day%(c%, r%) = Hol%(i%) THEN COLOR 4 ' color holidays
IF Day%(c%, r%) = Rel%(i%) THEN COLOR 3 ' color Easter day
NEXT i%
LOCATE (2 * r%) + 4, (3 * c%) + 4: PRINT Day%(c%, r%)
IF Day%(c%, r%) = 0 THEN LOCATE (2 * r%) + 4, (3 * c%) + 4: PRINT SPACE$(2)
NEXT c%
NEXT r% 'r% week loop end
'**********************BOX around Calendar
COLOR 6
'LOCATE 3, 6: PRINT STRING$(23, CHR$(223))
LINE (48, 16)-(225, 20), 6, BF 'TOP
'LOCATE 17, 6: PRINT STRING$(23, CHR$(220))
LINE (48, 130)-(225, 134), 6, BF 'BOTTOM
LINE (44, 16)-(48, 134), 6, BF 'left side
LINE (225, 16)-(229, 134), 6, BF 'right side
'FOR i% = 3 TO 17
'LOCATE i%, 6: PRINT STRING$(1, CHR$(176)) 'Sides
'LOCATE i%, 29: PRINT STRING$(1, CHR$(176))
' NEXT i%
'*******************************

LOCATE 18, 20: COLOR 4: PRINT "Holidays"
IF month% = EM% THEN COLOR 3: LOCATE 18, 8: PRINT "Easter"
COLOR 9
LOCATE 20, 7: PRINT wd$; ", "; moon$; datenum%

DO: _LIMIT 1 'continuous time loop NEXT MONTH LOOP INKEY
hour$ = LEFT$(TIME$, 2)
SELECT CASE hour$
CASE "00"
hr$ = "12"
CASE "01", "13"
hr$ = " 1"
CASE "02", "14"
hr$ = " 2"
CASE "03", "15"
hr$ = " 3"
CASE "04", "16"
hr$ = " 4"
CASE "05", "17"
hr$ = " 5"
CASE "06", "18"
hr$ = " 6"
CASE "07", "19"
hr$ = " 7"
CASE "08", "20"
hr$ = " 8"
CASE "09", "21"
hr$ = " 9"
CASE "10", "22"
hr$ = "10"
CASE "11", "23"
hr$ = "11"
CASE "12", "24"
hr$ = "12"
END SELECT
IF hour$ < "12" THEN aft$ = " AM" 'set AM PM
IF hour$ >= "12" THEN aft$ = " PM"
minu$ = MID$(TIME$, 3, 3)
sec$ = RIGHT$(TIME$, 3) 'minutes & seconds
COLOR 9
LOCATE 20, 20: PRINT hr$; minu$;
COLOR 2
COLOR 9
PRINT aft$
LOOP UNTIL INKEY$ <> ""
NEXT month%
60 CLOSE #1
100 CLS

LOCATE 4, 4: PRINT " CALENDOS "
LOCATE 7, 4: PRINT " Written by Ted Weissgerber"
LOCATE 10, 4: PRINT " burger2227@Gmail.com"
LOCATE 14, 4: PRINT " 2010"
LOCATE 18, 4: PRINT " Qbasic and DOS Rule!"

SLEEP 3
SYSTEM

SUB Easter (yrn, EM, ED)
c = yrn \ 100 'Century
G = yrn MOD 19
K = (c - 17) \ 25
i = (c - (c \ 4) - (c - K) \ 3 + (19 * G) + 15) MOD 30
i = i - (i \ 28) * (1 - (i \ 28) * (29 \ (i + 1)) * ((21 - G) \ 11))
J = (yrn + yrn \ 4 + i + 2 - c + c \ 4) MOD 7
L = i - J
EM = 3 + (L + 40) \ 44 'Month of Easter.
ED = L + 28 - 31 * (EM \ 4) 'Day of Easter.
END SUB

SUB LeapYear (yrn%, Leap$, firstday%)
'my LEAP YEAR and the First Day of Year routine based on year 2000
LpYear% = 2000
firstday% = 7 ' the first day of 2000 was a saturday, the 7th day
IF yrn% >= 2000 THEN ' ** yrn% INPUT
'FORWARD LOOP 2000 up
yrnm% = 1999 'start in 1999
DO
yrnm% = yrnm% + 1 ' start in 2000 (1999 + 1)
IF yrnm% > 2000 THEN firstday% = firstday% + 1 'add one day every year to first day (52 weeks + 1
IF firstday% > 7 THEN firstday% = firstday% - 7 ' ** firstday% OUTPUT

IF yrnm% = LpYear% THEN Leap$ = "Y" ' ** Lp$ for print only
IF yrnm% MOD 100 = 0 THEN nly% = LpYear% MOD 400 'test century leap 400
IF nly% <> 0 THEN Leap$ = "N" ' if not divisible by 400

IF yrnm% - 1 = LpYear% THEN ' add day AFTER leap year
IF nly% = 0 THEN firstday% = firstday% + 1 ' add a leap day
IF firstday% > 7 THEN firstday% = firstday% - 7
Leap$ = "N"
LpYear% = LpYear% + 4 ' find next leap year by adding 4
END IF
nly% = 0 ' reset MOD value
LOOP UNTIL yrnm% = yrn%
END IF 'end forward loop

IF yrn% < 2000 THEN 'REVERSE LOOP 2000 down
yrnm% = 2001 'start in 2001
DO
yrnm% = yrnm% - 1 ' start in 2000 (2001 - 1)
IF yrnm% < 2000 THEN firstday% = firstday% - 1 'subt one day every year to first day (52 weeks + 1
IF firstday% = 0 THEN firstday% = 7
IF yrnm% MOD 100 = 0 THEN nly% = LpYear% MOD 400 ' test century every 100
Leap$ = "N"

IF yrnm% = LpYear% THEN ' BEFORE leap year
IF nly% = 0 AND LpYear% <> 2000 THEN firstday% = firstday% - 1 ' subt a leap day
IF firstday% = 0 THEN firstday% = 7
LpYear% = LpYear% - 4 ' find next leap year
Leap$ = "Y"
IF nly% <> 0 THEN Leap$ = "N" ' if not divisible by 400
END IF
nly% = 0 ' reset MOD value
LOOP UNTIL yrnm% = yrn%
END IF
END SUB

Title: Re: Calendar Maker
Post by: bplus on August 05, 2019, 12:08:04 pm

Wow SAM never saw OUT before, watch OUT!

Looks like Ted Weissgerber code good for thumbnail sketches on screen, has complex Leap Year Calc and another Easter Calc.

Title: Re: Calendar Maker
Post by: SierraKen on August 05, 2019, 12:20:12 pm

LOL that's a cute little program. But it's not from 1988, it has a gmail address in the code and it mentions QBasic with the year 2010.

Title: Re: Calendar Maker
Post by: SMcNeill on August 05, 2019, 12:23:57 pm

Quote from: SierraKen on August 05, 2019, 12:20:12 pm

LOL that's a cute little program. But it's not from 1988, it has a gmail address in the code and it mentions QBasic with the year 2010.

It’s from 88, but has been translated a few times over the years. Clippy even has an Android version of it, somewhere, where it was translated to run on it. ;)

(Here’s a link to where he was talking about it back in 2008, over at the QBASIC forums: https://www.tapatalk.com/groups/qbasic/how-calculate-week-number-t29545-s20.html)

The QBASIC forums go back 30 years, or so, but a lot of the older stuff is archived for historical preservation and disk storage, so it’s not exactly search friendly. 2008 is the oldest non-archived post I can find on his Calendos program, but he mentions it originated back in 88, and I have no real reason to doubt it. ;)

Title: Re: Calendar Maker
Post by: SierraKen on August 05, 2019, 07:56:18 pm

Well, I am (hopefully) minutes away from making this a GREAT calendar program. But I need help from you guys badly. It could be minutes from being completed, but the problem I ran into is that the program freezes after you print it out using the program (Yes, I added printing to it!). It saves and prints the first one fine. But then it asks you if you want to make another calendar, so it goes back to the first screen to do that and after you add both the year and month, it just sits there... does nothing... And I have no idea why. I've looked through the code and I'm tried testing it in a few places, etc. but can't figure it out. Have you guys ran into problems before where a printer freezes a program? If we can't fix this, I'll just remove the part where it asks if you want to make a new calendar after printing, and just make the program end. I added a lot to it. In order to make it print good calendars, I got code from the Wiki pages where an example shows how to flip a picture certain degrees, it originally says 360 degrees but I changed it to 90 so it would fit good on paper. If you have a printer, please try it out. You can watch the calendar being turned 90 degrees, is really cool. Anyway, any help is appreciated, and I want to thank B+ for telling me about PRINTSTRING, which I also changed to so now the numbers line up perfectly and the holidays fit a lot better. Tell me what you think, thanks. Remember, it makes them, saves them, and prints them fine the first time, but you can't even make one the second time. Oh, I also tried _FREEIMAGE on p& which is the screen the printer prints, but it won't let me do that for some reason, but it will let me do _FREEIMAGE on the picture itself. Could that be a problem? Having a SCREEN _NEWIMAGE(800, 900), p& overlapping the _SOURCE img& ? It's lines between 205 and 235. It might not be the problem though because it lets you go back to the front screen though to setup a new calendar. Although, could there be a conflict when you press enter and it makes another SCREEN _NEWIMAGE(800,600,32) for the new calendar? Also notice that the printer image doesn't use the last 32 number because it prints black all around the calendar, which looks neat but is too costly for toner. I wonder if that's a conflict though? Sorry for so many questions, this program just means a lot to me.

(Note: This version has an error in it, so please keep scrolling to my next one, thanks.)

Code: QB64: [Select]

'This is my very first calendar making program!
'Thanks to the guys from the QB64.org forum for the help, B+, SMcNeill, and euklides!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'Made on Sunday, August 4, 2019 by Ken G.
'
_TITLE "Calendar Maker"
start:
_LIMIT 1000
dd = 0
leap = 0
m = 0
mm = 0
y = 0
yy = 0
w = 0
weekday = 0
days = 0
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PRINT "                                     Monthly Calendar Maker"
PRINT: PRINT: PRINT
PRINT "                                           By Ken G."
PRINT: PRINT: PRINT
PRINT "             This program will make a calendar for the year and month you want."
PRINT "             It will also name some holidays on their days."
PRINT "             This uses the Gregorian Calendar which became common practice in"
PRINT "             England in 1753."
PRINT "             First make a calender, then if you want to save it as a .jpg file,"
PRINT "             press the 'S' key and it will save it as the month and year for its name."
PRINT "             For example, if you made a calendar for January 2020 and wish to save it,"
PRINT "             press the 'S' key and it will save it as 1-2020.jpg"
PRINT "             If you wish to print your calendar on your printer, first press 'S' to save"
PRINT "             it and it will then ask you if you wish to print it on paper."
PRINT "             The .jpg calendar picture will be saved in the same directory as this program."
PRINT "             To make a new calendar without saving, press the Space Bar."
PRINT "             Keyboard commands will be listed on the title bar of the window."
again1:
PRINT
INPUT "             Type the year here (1753-9999): ", y
IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
again2:
PRINT
INPUT "             Type the month here (1-12): ", m
PRINT
IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
 
'Get the month name.
IF m = 1 THEN month$ = " January"
IF m = 2 THEN month$ = "February"
IF m = 3 THEN month$ = "  March"
IF m = 4 THEN month$ = "  April"
IF m = 5 THEN month$ = "  May"
IF m = 6 THEN month$ = "  June"
IF m = 7 THEN month$ = "  July"
IF m = 8 THEN month$ = " August"
IF m = 9 THEN month$ = "September"
IF m = 10 THEN month$ = " October"
IF m = 11 THEN month$ = "November"
IF m = 12 THEN month$ = "December"
 
'Calculate to see if it's a Leap Year.
IF m <> 2 THEN GOTO nex:
IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
IF y / 4 = INT(y / 4) THEN leap = 1
IF y / 100 = INT(y / 100) THEN leap = 0
 
'Get the number of days for each month.
more:
IF leap = 1 THEN days = 29
IF leap = 0 THEN days = 28
GOTO weekday:
nex:
IF m = 1 THEN days = 31
IF m = 3 THEN days = 31
IF m = 4 THEN days = 30
IF m = 5 THEN days = 31
IF m = 6 THEN days = 30
IF m = 7 THEN days = 31
IF m = 8 THEN days = 31
IF m = 9 THEN days = 30
IF m = 10 THEN days = 31
IF m = 11 THEN days = 30
IF m = 12 THEN days = 31
weekday:
 
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, y, weekday
 
'This section makes the calendar graph.
make:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
_TITLE "Press 'S' to Save and/or Print, Space Bar to make another calendar, or 'Esc' to quit."
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
LOCATE 3, 42: PRINT month$; "  "; yy
 
FOR x = 20 TO 780 STEP 108
    LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
NEXT x
FOR z = 100 TO 580 STEP 80
    LINE (16, z)-(780, z), _RGB32(0, 0, 0)
NEXT z
 
LOCATE 5, 8: PRINT "SUNDAY"
LOCATE 5, 21: PRINT "MONDAY"
LOCATE 5, 34: PRINT "TUESDAY"
LOCATE 5, 47: PRINT "WEDNESDAY"
LOCATE 5, 60: PRINT "THURSDAY"
LOCATE 5, 75: PRINT "FRIDAY"
LOCATE 5, 87: PRINT "SATURDAY"
 
'Finding Date of Easter
PQA = yy
GOSUB PAQUES
'month = PQM, day = PQJ, year = PQA
 
'This section puts the right dates and holidays in the right squares for the calendar.
_FONT 16
w = (weekday * 108) + 25
FOR weeky = 110 TO 570 STEP 80
    FOR dayx = w TO 692 STEP 108
        _LIMIT 1000
        dd = dd + 1
        GetDay mm, dd, y, weekday
        dd$ = STR$(dd)
        _FONT 16
        _PRINTSTRING (dayx, weeky), dd$
        _FONT 8
        IF m = 1 AND dd = 1 THEN _PRINTSTRING (dayx + 10, weeky + 60), "New Years":
        IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
        IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
        IF m = 2 AND dd = 14 THEN _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
        IF m = PQM AND dd = PQJ THEN _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
        IF m = 5 AND weekday = 2 AND dd > 24 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
        IF m = 7 AND dd = 4 THEN _PRINTSTRING (dayx, weeky + 60), "Independence"
        IF m = 9 AND weekday = 2 AND dd < 8 THEN _PRINTSTRING (dayx + 25, weeky + 60), "Labor"
        IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Columbus"
        IF m = 10 AND dd = 31 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
        IF m = 11 AND dd = 11 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Veterans"
        IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN _PRINTSTRING (dayx, weeky + 60), "Thanksgiving"
        IF m = 12 AND dd = 25 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
 
        IF dd = days THEN _FONT 16: GOTO more2:
    NEXT dayx
    w = 25
NEXT weeky
 
more2:
_LIMIT 1000
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
IF a$ = "p" OR a$ = "P" THEN GOTO saving:
GOTO more2:
 
 
'Find the right date for Easter.
PAQUES:
PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
RETURN
 
 
'This section saves the calendar to a JPG file along with the SUB at the end of this program.
saving:
mo$ = STR$(m)
mo$ = LTRIM$(RTRIM$(mo$))
year$ = STR$(yy)
year$ = LTRIM$(RTRIM$(year$))
nm$ = mo$ + "-"
nm$ = LTRIM$(RTRIM$(nm$))
nm$ = nm$ + year$
nm$ = LTRIM$(RTRIM$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
CLS
nm2$ = nm$ + ".jpg"
nm2$ = LTRIM$(RTRIM$(nm2$))
PRINT: PRINT: PRINT
PRINT "                                        Saving and Printing"
PRINT
PRINT "                          "; nm2$; " has been saved to your computer."
PRINT
INPUT "                         Do you wish to print this to your printer (Y/N)"; p$
IF LEFT$(p$, 1) = "y" OR LEFT$(p$, 1) = "Y" THEN GOTO printing:
INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "                        Goodbye."
END
 
printing:
CLS
SCREEN _NEWIMAGE(800, 900), p&
img& = _LOADIMAGE(nm2$) 'load the image file to be drawn
 
wide% = _WIDTH(img&): deep% = _HEIGHT(img&)
TLC$ = "BL" + STR$(wide% \ 2) + "BU" + STR$(deep% \ 2) 'start draw at top left corner
RET$ = "BD BL" + STR$(wide%) 'return to left side of image
_SOURCE img&
_DEST 0
FOR angle% = 0 TO 90 STEP 15
    _LIMIT 2000
    CLS
    DRAW "BM400, 450" + "TA=" + VARPTR$(angle%) + TLC$
    FOR y = 0 TO deep% - 1
        FOR x = 0 TO wide% - 1
            DRAW "C" + STR$(POINT(x, y)) + "R1" 'color and DRAW each pixel
        NEXT
        DRAW RET$
    NEXT
    _DISPLAY 'NOTE: CPU usage will be HIGH!
NEXT
_PRINTIMAGE p&
_DELAY 4
_FREEIMAGE img&
PRINT
INPUT "               Do you wish to make another calendar (Y/N)"; ag$
CLS
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "               Goodbye."
END
 
weekdays:
 
'This section gets the right weekday.
SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: y = y - 1
    century = y MOD 100
    zerocentury = y \ 100
    weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
END SUB
 
'This section saves the .jpg picture file.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".jpg" THEN ext$ = ".jpg"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
 

Title: Re: Calendar Maker
Post by: bplus on August 05, 2019, 10:04:17 pm

Hi Ken,

I modified a small portion of your code to print calendar displayed directly without need to save image:

Code: QB64: [Select]

more2:
_LIMIT 1000
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
IF a$ = "p" OR a$ = "P" THEN
    'see title change  copy here:
    _TITLE "Press 'S' to Save, 'P' to Print (can do again for copy) , Space Bar to make another calendar, or 'Esc' to quit."
    'printer prep (code copied and pasted from bplus Free Calendar Program)
    YMAX = _HEIGHT: XMAX = _WIDTH
    landscape& = _NEWIMAGE(YMAX, XMAX, 32)
    _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
    _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
    _PRINTIMAGE landscape& '<<<<<<<<<<<<<<<<<<<<<<<<< debug first before wasting paper and ink
END IF
GOTO more2:
 

You can press p for as many copies as you want then press space to go back and do another month.

Title: Re: Calendar Maker
Post by: bplus on August 05, 2019, 10:36:11 pm

Code: QB64: [Select]

printing:
CLS
SCREEN _NEWIMAGE(800, 900), p&
 

I don't understand this line (with _NEWIMAGE). Nothing in Wiki Syntax line says anything about parameters after the ), but there is an example that shows a setup for page flipping that uses parameters after the ).

So Wiki needs a fix?

Title: Re: Calendar Maker
Post by: SMcNeill on August 05, 2019, 10:49:39 pm

Quote from: bplus on August 05, 2019, 10:36:11 pm

Code: QB64: [Select]
printing:
CLS
SCREEN _NEWIMAGE(800, 900), p&

I don't understand this line (with _NEWIMAGE). Nothing in Wiki Syntax line says anything about parameters after the ), but there is an example that shows a setup for page flipping that uses parameters after the ).

So Wiki needs a fix?

Nope. It’s part of the SCREEN syntax.

SCREEN imagehandle& [, , active_page, visual_page]

Though I’m not exactly certain what the ,p& parameter represents.

https://www.qbasic.net/en/reference/qb11/Statement/SCREEN.htm

Color setting?

Doesn’t look like QB64 supports that parameter, which is why it lists the command as: SCREEN {mode%|imagehandle&} , , active_page, visual_page]

(See the comma comma with nothing between it?

Title: Re: Calendar Maker
Post by: SierraKen on August 05, 2019, 10:58:37 pm

Back when I made my Paint Pixels program, I took that has a variable that stores the entire screen to it so you can use it later. But I could be wrong.

Title: Re: Calendar Maker
Post by: SierraKen on August 05, 2019, 11:07:07 pm

Well, thanks to B+ I did it!!!!! I deleted the old printing code and used B+'s instead and it works great! Thank you and also to Euklides and SmMcNeill for the help in making this. On the start page, under "By Ken G." I added "With some help from the QB64.org forum guys!". Maybe it will attract programmers here sometime.
Now I got a fully-working Calendar Maker that makes any month from the mid 1700's to 9999. It labels some of the holidays, can save it as a .jpg file to your computer, and can print it to the printer! I'll put this on my website very soon, which is http://www.KensPrograms.com/
Save this program to its own directory so you can find all of your saved calendars easily. I hope some of you enjoy this and use it sometimes.

(Note: On the next page of this forum topic, I posted an even better version adding some more holidays and also the ability to use arrow keys to change months.)

Code: QB64: [Select]

'This is my very first calendar making program!
'Thanks to the guys from the QB64.org forum for the help: bplus, SMcNeill, and euklides!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'Made on Monday, August 5, 2019 by Ken G.
'
 
start:
_TITLE "Calendar Maker"
_LIMIT 1000
dd = 0
leap = 0
m = 0
mm = 0
y = 0
yy = 0
w = 0
weekday = 0
days = 0
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PRINT "                                     Monthly Calendar Maker"
PRINT: PRINT: PRINT
PRINT "                                           By Ken G."
PRINT
PRINT "                            With some help from the QB64.org Forum guys!"
PRINT: PRINT: PRINT
PRINT "             This program will make a calendar for the year and month you want."
PRINT "             It will also name some holidays on their days."
PRINT "             This uses the Gregorian Calendar which became common practice in"
PRINT "             England in 1753 and we still use it today."
PRINT
PRINT "             First make a calender, then if you want to save it as a .jpg file,"
PRINT "             press the 'S' key and it will save it as the month and year for its name."
PRINT "             For example, if you made a calendar for January 2020 and wish to save it,"
PRINT "             press the 'S' key and it will save it as 1-2020.jpg"
PRINT "             If you wish to print your calendar on your printer, press 'P' once."
PRINT "             Feel free to print as many times as you wish. They take up 1 page each."
PRINT "             If you save the .jpg calendar, it will be put in the same directory as this program."
PRINT "             To make a new calendar without saving, press the Space Bar."
PRINT "             Keyboard commands will be listed on the title bar of the window."
again1:
PRINT
INPUT "             Type the year here (1753-9999): ", y
IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
again2:
PRINT
INPUT "             Type the month here (1-12): ", m
PRINT
IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
 
'Get the month name.
IF m = 1 THEN month$ = " January"
IF m = 2 THEN month$ = "February"
IF m = 3 THEN month$ = "  March"
IF m = 4 THEN month$ = "  April"
IF m = 5 THEN month$ = "  May"
IF m = 6 THEN month$ = "  June"
IF m = 7 THEN month$ = "  July"
IF m = 8 THEN month$ = " August"
IF m = 9 THEN month$ = "September"
IF m = 10 THEN month$ = " October"
IF m = 11 THEN month$ = "November"
IF m = 12 THEN month$ = "December"
 
'Calculate to see if it's a Leap Year.
IF m <> 2 THEN GOTO nex:
IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
IF y / 4 = INT(y / 4) THEN leap = 1
IF y / 100 = INT(y / 100) THEN leap = 0
 
'Get the number of days for each month.
more:
IF leap = 1 THEN days = 29
IF leap = 0 THEN days = 28
GOTO weekday:
nex:
IF m = 1 THEN days = 31
IF m = 3 THEN days = 31
IF m = 4 THEN days = 30
IF m = 5 THEN days = 31
IF m = 6 THEN days = 30
IF m = 7 THEN days = 31
IF m = 8 THEN days = 31
IF m = 9 THEN days = 30
IF m = 10 THEN days = 31
IF m = 11 THEN days = 30
IF m = 12 THEN days = 31
weekday:
 
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, y, weekday
 
'This section makes the calendar graph.
make:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
_TITLE "Press 'S' to Save, 'P' to Print (can do again for copy), Space Bar to make another calendar, or 'Esc' to quit."
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
LOCATE 3, 42: PRINT month$; "  "; yy
 
FOR x = 20 TO 780 STEP 108
    LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
NEXT x
FOR z = 100 TO 580 STEP 80
    LINE (16, z)-(780, z), _RGB32(0, 0, 0)
NEXT z
 
LOCATE 5, 8: PRINT "SUNDAY"
LOCATE 5, 21: PRINT "MONDAY"
LOCATE 5, 34: PRINT "TUESDAY"
LOCATE 5, 47: PRINT "WEDNESDAY"
LOCATE 5, 60: PRINT "THURSDAY"
LOCATE 5, 75: PRINT "FRIDAY"
LOCATE 5, 87: PRINT "SATURDAY"
 
'Finding Date of Easter
PQA = yy
GOSUB PAQUES
'month = PQM, day = PQJ, year = PQA
 
'This section puts the right dates and holidays in the right squares for the calendar.
_FONT 16
w = (weekday * 108) + 25
FOR weeky = 110 TO 570 STEP 80
    FOR dayx = w TO 692 STEP 108
        _LIMIT 1000
        dd = dd + 1
        GetDay mm, dd, y, weekday
        dd$ = STR$(dd)
        _FONT 16
        _PRINTSTRING (dayx, weeky), dd$
        _FONT 8
        IF m = 1 AND dd = 1 THEN _PRINTSTRING (dayx + 10, weeky + 60), "New Years":
        IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
        IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
        IF m = 2 AND dd = 14 THEN _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
        IF m = PQM AND dd = PQJ THEN _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
        IF m = 5 AND weekday = 2 AND dd > 24 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
        IF m = 7 AND dd = 4 THEN _PRINTSTRING (dayx, weeky + 60), "Independence"
        IF m = 9 AND weekday = 2 AND dd < 8 THEN _PRINTSTRING (dayx + 25, weeky + 60), "Labor"
        IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Columbus"
        IF m = 10 AND dd = 31 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
        IF m = 11 AND dd = 11 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Veterans"
        IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN _PRINTSTRING (dayx, weeky + 60), "Thanksgiving"
        IF m = 12 AND dd = 25 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
 
        IF dd = days THEN _FONT 16: GOTO more2:
    NEXT dayx
    w = 25
NEXT weeky
 
more2:
_LIMIT 1000
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
IF a$ = "p" OR a$ = "P" THEN
    'printer prep (code copied and pasted from bplus Free Calendar Program)
    YMAX = _HEIGHT: XMAX = _WIDTH
    landscape& = _NEWIMAGE(YMAX, XMAX, 32)
    _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
    _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
    _PRINTIMAGE landscape&
END IF
 
GOTO more2:
 
 
'Find the right date for Easter.
PAQUES:
PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
RETURN
 
 
'This section saves the calendar to a JPG file along with the SUB at the end of this program.
saving:
mo$ = STR$(m)
mo$ = LTRIM$(RTRIM$(mo$))
year$ = STR$(yy)
year$ = LTRIM$(RTRIM$(year$))
nm$ = mo$ + "-"
nm$ = LTRIM$(RTRIM$(nm$))
nm$ = nm$ + year$
nm$ = LTRIM$(RTRIM$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
CLS
nm2$ = nm$ + ".jpg"
nm2$ = LTRIM$(RTRIM$(nm2$))
PRINT: PRINT: PRINT
PRINT "                                           Saving"
PRINT
PRINT "                          "; nm2$; " has been saved to your computer."
PRINT
PRINT
INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "                         Goodbye."
END
 
weekdays:
 
'This section gets the right weekday.
SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: y = y - 1
    century = y MOD 100
    zerocentury = y \ 100
    weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
END SUB
 
'This section saves the .jpg picture file.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".jpg" THEN ext$ = ".jpg"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
 

Title: Re: Calendar Maker
Post by: bplus on August 05, 2019, 11:34:05 pm

Quote from: SMcNeill on August 05, 2019, 10:49:39 pm

Nope. It’s part of the SCREEN syntax.

SCREEN imagehandle& [, , active_page, visual_page]

Though I’m not exactly certain what the ,p& parameter represents.

https://www.qbasic.net/en/reference/qb11/Statement/SCREEN.htm

Color setting?

Doesn’t look like QB64 supports that parameter, which is why it lists the command as: SCREEN {mode%|imagehandle&} , , active_page, visual_page]

(See the comma comma with nothing between it?

Aha! now I get it, it's a part of SCREEN sub call, actually that line I have always been using makes more sense to me now. Thanks Steve.

Hi, Ken,

I thought you might like that change. :)

Title: Re: Calendar Maker
Post by: SierraKen on August 06, 2019, 03:37:28 pm

Today I made the Calendar Maker even better! I added around 4 holidays and also made it so the user can use the right and left arrow keys to go back and forward in months as you see them. That way if someone needs to know a date on the next month or the last month, they can just use the arrow keys. Or if they are wanting to easily print a few months in a row. :)

(Note: Because I was accidentally using code that masked bmp files to jpg, I changed the program to just save as .bmp and posted it on this forum below this post, so please scroll down, thank you.)

Code: QB64: [Select]

'This is my very first calendar making program!
'Thanks to the guys from the QB64.org forum for the help: bplus, SMcNeill, and euklides!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'Made on Tuesday, August 6, 2019 by Ken G.
 
 
start:
_TITLE "Calendar Maker"
_LIMIT 1000
dd = 0
leap = 0
m = 0
mm = 0
y = 0
yy = 0
w = 0
weekday = 0
days = 0
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PRINT "                                  Monthly Calendar Maker"
PRINT: PRINT: PRINT
PRINT "                                        By Ken G."
PRINT
PRINT "                         With some help from the QB64.org Forum guys!"
PRINT: PRINT: PRINT
PRINT "          This program will make a calendar for the year and month you want."
PRINT "          It will also name some holidays on their days."
PRINT "          This uses the Gregorian Calendar which became common practice in"
PRINT "          England in 1753 and we still use it today."
PRINT
PRINT "          First make a calender, then if you want to save it as a .jpg file,"
PRINT "          press the 'S' key and it will save it as the month and year for its name."
PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
PRINT "          press the 'S' key and it will save it as 1-2020.jpg"
PRINT "          If you wish to print your calendar on your printer, press 'P' once."
PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
PRINT "          If you save the .jpg calendar, it will be put in the same directory as this program."
PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
PRINT "          To make a different calendar without saving, press the Space Bar."
PRINT "          Keyboard commands will be listed on the title bar of the window."
again1:
PRINT
INPUT "          Type the year here (1753-9999): ", y
IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
again2:
PRINT
INPUT "          Type the month here (1-12): ", m
PRINT
IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
 
calculate:
'Get the month name.
IF m = 1 THEN month$ = " January"
IF m = 2 THEN month$ = "February"
IF m = 3 THEN month$ = "  March"
IF m = 4 THEN month$ = "  April"
IF m = 5 THEN month$ = "  May"
IF m = 6 THEN month$ = "  June"
IF m = 7 THEN month$ = "  July"
IF m = 8 THEN month$ = " August"
IF m = 9 THEN month$ = "September"
IF m = 10 THEN month$ = " October"
IF m = 11 THEN month$ = "November"
IF m = 12 THEN month$ = "December"
 
'Calculate to see if it's a Leap Year.
IF m <> 2 THEN GOTO nex:
IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
IF y / 4 = INT(y / 4) THEN leap = 1
IF y / 100 = INT(y / 100) THEN leap = 0
 
'Get the number of days for each month.
more:
IF leap = 1 THEN days = 29
IF leap = 0 THEN days = 28
GOTO weekday:
nex:
IF m = 1 THEN days = 31
IF m = 3 THEN days = 31
IF m = 4 THEN days = 30
IF m = 5 THEN days = 31
IF m = 6 THEN days = 30
IF m = 7 THEN days = 31
IF m = 8 THEN days = 31
IF m = 9 THEN days = 30
IF m = 10 THEN days = 31
IF m = 11 THEN days = 30
IF m = 12 THEN days = 31
weekday:
 
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, y, weekday
 
'This section makes the calendar graph.
make:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
_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."
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
LOCATE 3, 42: PRINT month$; "  "; yy
 
FOR x = 20 TO 780 STEP 108
    LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
NEXT x
FOR z = 100 TO 580 STEP 80
    LINE (16, z)-(780, z), _RGB32(0, 0, 0)
NEXT z
 
LOCATE 5, 8: PRINT "SUNDAY"
LOCATE 5, 21: PRINT "MONDAY"
LOCATE 5, 34: PRINT "TUESDAY"
LOCATE 5, 47: PRINT "WEDNESDAY"
LOCATE 5, 60: PRINT "THURSDAY"
LOCATE 5, 75: PRINT "FRIDAY"
LOCATE 5, 87: PRINT "SATURDAY"
 
'Finding Date of Easter
PQA = yy
GOSUB PAQUES
'month = PQM, day = PQJ, year = PQA
 
'This section puts the right dates and holidays in the right squares for the calendar.
_FONT 16
w = (weekday * 108) + 25
FOR weeky = 110 TO 570 STEP 80
    FOR dayx = w TO 692 STEP 108
        _LIMIT 1000
        dd = dd + 1
        GetDay mm, dd, y, weekday
        dd$ = STR$(dd)
        _FONT 16
        _PRINTSTRING (dayx, weeky), dd$
        _FONT 8
        IF m = 1 AND dd = 1 THEN _PRINTSTRING (dayx + 10, weeky + 60), "New Years":
        IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
        IF m = 2 AND dd = 2 THEN _PRINTSTRING (dayx + 10, weeky + 60), "Groundhog"
        IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
        IF m = 2 AND dd = 14 THEN _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
        IF m = 3 AND dd = 17 THEN _PRINTSTRING (dayx + 10, weeky + 60), "St. Patrick"
        IF m = PQM AND dd = PQJ THEN _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
        IF m = 4 AND dd > 23 AND weekday = 7 THEN _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
        IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN _PRINTSTRING (dayx, weeky + 60), "Armed Forces"
        IF m = 5 AND weekday = 2 AND dd > 24 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
        IF m = 6 AND dd = 14 THEN _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
        IF m = 7 AND dd = 4 THEN _PRINTSTRING (dayx, weeky + 60), "Independence"
        IF m = 9 AND weekday = 2 AND dd < 8 THEN _PRINTSTRING (dayx + 25, weeky + 60), "Labor"
        IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Columbus"
        IF m = 10 AND dd = 31 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
        IF m = 11 AND dd = 11 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Veterans"
        IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN _PRINTSTRING (dayx, weeky + 60), "Thanksgiving"
        IF m = 12 AND dd = 25 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
 
        IF dd = days THEN _FONT 16: GOTO more2:
    NEXT dayx
    w = 25
NEXT weeky
 
more2:
_LIMIT 1000
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
IF a$ = "p" OR a$ = "P" THEN
    'printer prep (code copied and pasted from bplus Free Calendar Program)
    YMAX = _HEIGHT: XMAX = _WIDTH
    landscape& = _NEWIMAGE(YMAX, XMAX, 32)
    _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
    _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
    _PRINTIMAGE landscape&
END IF
 
IF a$ = CHR$(0) + CHR$(77) THEN
    m = m + 1
    IF m > 12 THEN
        m = 1
        yy = yy + 1
    END IF
    y = yy
    IF y > 9999 THEN y = 1753
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
IF a$ = CHR$(0) + CHR$(75) THEN
    m = m - 1
    IF m < 1 THEN
        m = 12
        yy = yy - 1
    END IF
    y = yy
    IF y < 1753 THEN y = 9999
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
 
GOTO more2:
 
 
'Find the right date for Easter.
PAQUES:
PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
RETURN
 
 
'This section saves the calendar to a JPG file along with the SUB at the end of this program.
saving:
mo$ = STR$(m)
mo$ = LTRIM$(RTRIM$(mo$))
year$ = STR$(yy)
year$ = LTRIM$(RTRIM$(year$))
nm$ = mo$ + "-"
nm$ = LTRIM$(RTRIM$(nm$))
nm$ = nm$ + year$
nm$ = LTRIM$(RTRIM$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
CLS
nm2$ = nm$ + ".jpg"
nm2$ = LTRIM$(RTRIM$(nm2$))
PRINT: PRINT: PRINT
PRINT "                                           Saving"
PRINT
PRINT "                          "; nm2$; " has been saved to your computer."
PRINT
PRINT
INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "                         Goodbye."
END
 
weekdays:
 
'This section gets the right weekday.
SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: y = y - 1
    century = y MOD 100
    zerocentury = y \ 100
    weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
END SUB
 
'This section saves the .jpg picture file.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".jpg" THEN ext$ = ".jpg"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 

Title: Re: Calendar Maker
Post by: bplus on August 06, 2019, 05:00:31 pm

Nice simple improvement!

Title: Re: Calendar Maker
Post by: SierraKen on August 06, 2019, 05:20:49 pm

Thanks B+! This is one of my favorite programs I've ever made. It can be used any day, any month, any year. lol

Title: Re: Calendar Maker
Post by: johnno56 on August 06, 2019, 05:53:06 pm

Nice? pfftt... It's brilliant! What would make it perfect? If it came in blue.... Well done, SierraKen. Well done!

J

Title: Re: Calendar Maker
Post by: SierraKen on August 06, 2019, 10:48:45 pm

LOL Thanks Johno! You were probably joking on the blue, but I only have a black and white laser printer so I couldn't test different colors on paper. lol

Title: Re: Calendar Maker
Post by: PauloC on August 07, 2019, 01:56:28 pm

This program is very useful to learn QB64. Thank you!

Title: Re: Calendar Maker
Post by: SierraKen on August 07, 2019, 04:04:10 pm

Welcome PauloC!

Title: Re: Calendar Maker
Post by: pforpond on August 11, 2019, 06:47:12 am

This is really neato! Love that holidays (albeit US ones) are marked on there. Maybe with some work this could become a full-fledged calendar app with events the user can add themselves, though I'd say adding a bit of colour would be a nice addition too :)

Title: Re: Calendar Maker
Post by: SierraKen on August 11, 2019, 12:12:33 pm

Thanks pforpond! Yeah I only have a black and white printer so I couldn't test printing colors. I might look into making it an events calendar, not sure yet.

Title: Re: Calendar Maker
Post by: TempodiBasic on August 11, 2019, 06:23:05 pm

Hi
Good Application!
IMHO next step is to colorize holydays and sunday

Title: Re: Calendar Maker
Post by: SierraKen on August 11, 2019, 08:42:45 pm

Thanks TempodiBasic.

Title: Re: Calendar Maker
Post by: SierraKen on August 12, 2019, 02:08:07 am

SmMcNeill told me that the code I was using was actually .bmp pictures with a .jpg ending, so I changed the code on this program to make the calendars save as .bmp instead. I wondered why the picture files were so large lol. So, here is the fixed version. I also removed my Paint Pixels program off my website, for now anyway. The Calendar Maker's fix has been uploaded to my site.

Code: QB64: [Select]

'This is my very first calendar making program!
'Thanks to the guys from the QB64.org forum for the help: bplus, SMcNeill, and euklides!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'Made on Tuesday, August 6, 2019 by Ken G.
 
 
start:
_TITLE "Calendar Maker"
_LIMIT 1000
dd = 0
leap = 0
m = 0
mm = 0
y = 0
yy = 0
w = 0
weekday = 0
days = 0
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PRINT "                                  Monthly Calendar Maker"
PRINT: PRINT: PRINT
PRINT "                                        By Ken G."
PRINT
PRINT "                         With some help from the QB64.org Forum guys!"
PRINT: PRINT: PRINT
PRINT "          This program will make a calendar for the year and month you want."
PRINT "          It will also name some holidays on their days."
PRINT "          This uses the Gregorian Calendar which became common practice in"
PRINT "          England in 1753 and we still use it today."
PRINT
PRINT "          First make a calendar, then if you want to save it as a .bmp file,"
PRINT "          press the 'S' key and it will save it as the month and year for its name."
PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
PRINT "          press the 'S' key and it will save it as 1-2020.bmp"
PRINT "          If you wish to print your calendar on your printer, press 'P' once."
PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
PRINT "          If you save the .bmp calendar, it will be put in the same directory as this program."
PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
PRINT "          To make a different calendar without saving, press the Space Bar."
PRINT "          Keyboard commands will be listed on the title bar of the window."
again1:
PRINT
INPUT "          Type the year here (1753-9999): ", y
IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
again2:
PRINT
INPUT "          Type the month here (1-12): ", m
PRINT
IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
 
calculate:
'Get the month name.
IF m = 1 THEN month$ = " January"
IF m = 2 THEN month$ = "February"
IF m = 3 THEN month$ = "  March"
IF m = 4 THEN month$ = "  April"
IF m = 5 THEN month$ = "  May"
IF m = 6 THEN month$ = "  June"
IF m = 7 THEN month$ = "  July"
IF m = 8 THEN month$ = " August"
IF m = 9 THEN month$ = "September"
IF m = 10 THEN month$ = " October"
IF m = 11 THEN month$ = "November"
IF m = 12 THEN month$ = "December"
 
'Calculate to see if it's a Leap Year.
IF m <> 2 THEN GOTO nex:
IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
IF y / 4 = INT(y / 4) THEN leap = 1
IF y / 100 = INT(y / 100) THEN leap = 0
 
'Get the number of days for each month.
more:
IF leap = 1 THEN days = 29
IF leap = 0 THEN days = 28
GOTO weekday:
nex:
IF m = 1 THEN days = 31
IF m = 3 THEN days = 31
IF m = 4 THEN days = 30
IF m = 5 THEN days = 31
IF m = 6 THEN days = 30
IF m = 7 THEN days = 31
IF m = 8 THEN days = 31
IF m = 9 THEN days = 30
IF m = 10 THEN days = 31
IF m = 11 THEN days = 30
IF m = 12 THEN days = 31
weekday:
 
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, y, weekday
 
'This section makes the calendar graph.
make:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
_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."
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
LOCATE 3, 42: PRINT month$; "  "; yy
 
FOR x = 20 TO 780 STEP 108
    LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
NEXT x
FOR z = 100 TO 580 STEP 80
    LINE (16, z)-(780, z), _RGB32(0, 0, 0)
NEXT z
 
LOCATE 5, 8: PRINT "SUNDAY"
LOCATE 5, 21: PRINT "MONDAY"
LOCATE 5, 34: PRINT "TUESDAY"
LOCATE 5, 47: PRINT "WEDNESDAY"
LOCATE 5, 60: PRINT "THURSDAY"
LOCATE 5, 75: PRINT "FRIDAY"
LOCATE 5, 87: PRINT "SATURDAY"
 
'Finding Date of Easter
PQA = yy
GOSUB PAQUES
'month = PQM, day = PQJ, year = PQA
 
'This section puts the right dates and holidays in the right squares for the calendar.
_FONT 16
w = (weekday * 108) + 25
FOR weeky = 110 TO 570 STEP 80
    FOR dayx = w TO 692 STEP 108
        _LIMIT 1000
        dd = dd + 1
        GetDay mm, dd, y, weekday
        dd$ = STR$(dd)
        _FONT 16
        _PRINTSTRING (dayx, weeky), dd$
        _FONT 8
        IF m = 1 AND dd = 1 THEN _PRINTSTRING (dayx + 10, weeky + 60), "New Years":
        IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
        IF m = 2 AND dd = 2 THEN _PRINTSTRING (dayx + 10, weeky + 60), "Groundhog"
        IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
        IF m = 2 AND dd = 14 THEN _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
        IF m = 3 AND dd = 17 THEN _PRINTSTRING (dayx + 10, weeky + 60), "St. Patrick"
        IF m = PQM AND dd = PQJ THEN _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
        IF m = 4 AND dd > 23 AND weekday = 7 THEN _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
        IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN _PRINTSTRING (dayx, weeky + 60), "Armed Forces"
        IF m = 5 AND weekday = 2 AND dd > 24 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
        IF m = 6 AND dd = 14 THEN _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
        IF m = 7 AND dd = 4 THEN _PRINTSTRING (dayx, weeky + 60), "Independence"
        IF m = 9 AND weekday = 2 AND dd < 8 THEN _PRINTSTRING (dayx + 25, weeky + 60), "Labor"
        IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Columbus"
        IF m = 10 AND dd = 31 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
        IF m = 11 AND dd = 11 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Veterans"
        IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN _PRINTSTRING (dayx, weeky + 60), "Thanksgiving"
        IF m = 12 AND dd = 25 THEN _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
 
        IF dd = days THEN _FONT 16: GOTO more2:
    NEXT dayx
    w = 25
NEXT weeky
 
more2:
_LIMIT 1000
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
IF a$ = "p" OR a$ = "P" THEN
    'printer prep (code copied and pasted from bplus Free Calendar Program)
    YMAX = _HEIGHT: XMAX = _WIDTH
    landscape& = _NEWIMAGE(YMAX, XMAX, 32)
    _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
    _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
    _PRINTIMAGE landscape&
END IF
 
IF a$ = CHR$(0) + CHR$(77) THEN
    m = m + 1
    IF m > 12 THEN
        m = 1
        yy = yy + 1
    END IF
    y = yy
    IF y > 9999 THEN y = 1753
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
IF a$ = CHR$(0) + CHR$(75) THEN
    m = m - 1
    IF m < 1 THEN
        m = 12
        yy = yy - 1
    END IF
    y = yy
    IF y < 1753 THEN y = 9999
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
 
GOTO more2:
 
 
'Find the right date for Easter.
PAQUES:
PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
RETURN
 
 
'This section saves the calendar to a BMP file along with the SUB at the end of this program.
saving:
mo$ = STR$(m)
mo$ = LTRIM$(RTRIM$(mo$))
year$ = STR$(yy)
year$ = LTRIM$(RTRIM$(year$))
nm$ = mo$ + "-"
nm$ = LTRIM$(RTRIM$(nm$))
nm$ = nm$ + year$
nm$ = LTRIM$(RTRIM$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
CLS
nm2$ = nm$ + ".bmp"
nm2$ = LTRIM$(RTRIM$(nm2$))
PRINT: PRINT: PRINT
PRINT "                                           Saving"
PRINT
PRINT "                          "; nm2$; " has been saved to your computer."
PRINT
PRINT
INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "                         Goodbye."
END
 
weekdays:
 
'This section gets the right weekday.
SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: y = y - 1
    century = y MOD 100
    zerocentury = y \ 100
    weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
END SUB
 
'This section saves the .bmp picture file.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
 

Title: Re: Calendar Maker
Post by: bplus on September 11, 2019, 12:07:37 pm

Thanks Ken lines 140-158 came in handy for me updating my calendar maker for holidays.

For Easter I found and modified a little SUB:

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Test Easter calc 1899 to 2100" 'b+ mod 2019-09-11 checked OK for next decade
DIM yr AS INTEGER, rMonth AS INTEGER, rDay AS INTEGER, m$
PRINT "Easter by the method of Carter (SmallBASIC):"
DO
    INPUT "(0 quits, enter year 1900 to 2099 > "; yr
    IF yr = 0 THEN PRINT "Goodbye": END
    IF yr >= 1900 OR yr <= 2099 THEN
        Easter yr, rMonth, rDay
        IF rMonth = 3 THEN m$ = "March" ELSE m$ = "April"
        PRINT "Easter for year"; yr; "is "; m$; rDay
    ELSE
        PRINT "1899 < year < 2100": BEEP
    END IF
    PRINT
LOOP
 
SUB Easter (givenYear AS INTEGER, rtnMonth AS INTEGER, rtnDay AS INTEGER)
    ' Easter date calculator by Carter from SmallBASIC FLTK pack 1 of 3 given for Easter
    ' This one is restricted to years 1900 to 2099
    DIM tb AS INTEGER, td AS INTEGER, te AS INTEGER
    tb = 225 - 11 * (givenYear MOD 19)
    td = (tb - 21) MOD 30 + 21
    te = (givenYear + givenYear \ 4 + td + 1) MOD 7
    rtnDay = td + 7 - te
    IF rtnDay < 32 THEN
        rtnMonth = 3
    ELSE
        rtnDay = rtnDay - 31
        rtnMonth = 4
    END IF
END SUB
 

So in Maker, Easter setup:

Code: QB64: [Select]

y = 2020 'free calendar
DIM EasterMonth AS INTEGER, EasterDay AS INTEGER
Easter y, EasterMonth, EasterDay
 

Check and print for Easter:

Code: QB64: [Select]

        IF m = EasterMonth AND dd = EasterDay THEN 
            _PRINTSTRING (col * boxW + sideMar + 5, (row + 1) * boxH + yTopGrid - 5 - CH2), "        Easter"
        END IF
 

I've also added Mother's Day and Father's Day

Code: QB64: [Select]

IF m = 5 AND weekday = 1 AND dd > 7 AND dd < 15 THEN S$ = S$ + " Mother's Day" 
IF m = 6 AND weekday = 1 AND dd > 14 AND dd < 22 THEN S$ = S$ + " Father's Day" 
 

and for 2020: Daylight Savings Start and End, and US Election Day

PLUS Birthdays of my family :)

Title: Re: Calendar Maker
Post by: SierraKen on September 13, 2019, 06:17:52 pm

Welcome B+! And thank you for the Mother's Day and Father's Day code! I just added it. It already had Easter on mine. That's all I will add I think. I haven't programmed in a couple weeks or so (besides your code here). I just can't think of anything original to make anymore. A lot of my programs are my own versions of stuff that has already been made and I'm like, "If people can find a better version of this somewhere else, why make a lesser version?" But I really like what I've made so far, so maybe sometime soon I'll think of something else.

Title: Re: Calendar Maker
Post by: bplus on September 13, 2019, 08:39:47 pm

Hi Ken,

Sounds like good time to practice basics, arrays, subs and functions. When you don't have a particular app demanding to get working you can experiment with these main tools. A good game to play is take some code and see if you can do the same thing in less lines.

Another thing to work on is your tool box, subs and functions you can use in future apps.

Title: Re: Calendar Maker
Post by: OldMoses 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. ;)

Title: Re: Calendar Maker
Post by: SierraKen on September 15, 2019, 07:39:53 pm

Wow thanks OldMoses! :)

Title: Re: Calendar Maker
Post by: TempodiBasic 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 ...

Title: Re: Calendar Maker
Post by: SierraKen 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.

Title: Re: Calendar Maker
Post by: SierraKen 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]

'This is my very first calendar making program!
'Thanks to the guys from the QB64.org forum for the help: bplus, SMcNeill, euklides, and TempodiBasic!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'This version has colored Sundays and holidays.
'Made on Wednesday, September 18, 2019 by Ken G.
 
 
start:
_TITLE "Calendar Maker"
_LIMIT 1000
dd = 0
leap = 0
m = 0
mm = 0
y = 0
yy = 0
w = 0
weekday = 0
days = 0
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PRINT "                                  Monthly Calendar Maker"
PRINT: PRINT: PRINT
PRINT "                                        By Ken G."
PRINT
PRINT "                         With some help from the QB64.org Forum guys!"
PRINT: PRINT: PRINT
PRINT "          This program will make a calendar for the year and month you want."
PRINT "          It will also name some holidays on their days."
PRINT "          This uses the Gregorian Calendar which became common practice in"
PRINT "          England in 1753 and we still use it today."
PRINT
PRINT "          First make a calendar, then if you want to save it as a .bmp file,"
PRINT "          press the 'S' key and it will save it as the month and year for its name."
PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
PRINT "          press the 'S' key and it will save it as 1-2020.bmp"
PRINT "          If you wish to print your calendar on your printer, press 'P' once."
PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
PRINT "          If you save the .bmp calendar, it will be put in the same directory as this program."
PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
PRINT "          To make a different calendar without saving, press the Space Bar."
PRINT "          Keyboard commands will be listed on the title bar of the window."
again1:
PRINT
INPUT "          Type the year here (1753-9999): ", y
IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
again2:
PRINT
INPUT "          Type the month here (1-12): ", m
PRINT
IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
 
calculate:
'Get the month name.
IF m = 1 THEN month$ = " January"
IF m = 2 THEN month$ = "February"
IF m = 3 THEN month$ = "  March"
IF m = 4 THEN month$ = "  April"
IF m = 5 THEN month$ = "  May"
IF m = 6 THEN month$ = "  June"
IF m = 7 THEN month$ = "  July"
IF m = 8 THEN month$ = " August"
IF m = 9 THEN month$ = "September"
IF m = 10 THEN month$ = " October"
IF m = 11 THEN month$ = "November"
IF m = 12 THEN month$ = "December"
 
'Calculate to see if it's a Leap Year.
IF m <> 2 THEN GOTO nex:
IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
IF y / 4 = INT(y / 4) THEN leap = 1
IF y / 100 = INT(y / 100) THEN leap = 0
 
'Get the number of days for each month.
more:
IF leap = 1 THEN days = 29
IF leap = 0 THEN days = 28
GOTO weekday:
nex:
IF m = 1 THEN days = 31
IF m = 3 THEN days = 31
IF m = 4 THEN days = 30
IF m = 5 THEN days = 31
IF m = 6 THEN days = 30
IF m = 7 THEN days = 31
IF m = 8 THEN days = 31
IF m = 9 THEN days = 30
IF m = 10 THEN days = 31
IF m = 11 THEN days = 30
IF m = 12 THEN days = 31
weekday:
 
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, y, weekday
 
'This section makes the calendar graph.
make:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
_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."
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
LOCATE 3, 42: PRINT month$; "  "; yy
 
FOR x = 20 TO 780 STEP 108
    LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
NEXT x
FOR z = 100 TO 580 STEP 80
    LINE (16, z)-(780, z), _RGB32(0, 0, 0)
NEXT z
 
LOCATE 5, 8: PRINT "SUNDAY"
LOCATE 5, 21: PRINT "MONDAY"
LOCATE 5, 34: PRINT "TUESDAY"
LOCATE 5, 47: PRINT "WEDNESDAY"
LOCATE 5, 60: PRINT "THURSDAY"
LOCATE 5, 75: PRINT "FRIDAY"
LOCATE 5, 87: PRINT "SATURDAY"
 
'Finding Date of Easter
PQA = yy
GOSUB PAQUES
'month = PQM, day = PQJ, year = PQA
 
'This section puts the right dates and holidays in the right squares for the calendar.
_FONT 16
w = (weekday * 108) + 25
FOR weeky = 110 TO 570 STEP 80
    FOR dayx = w TO 692 STEP 108
        _LIMIT 1000
        dd = dd + 1
        GetDay mm, dd, y, weekday
        IF weekday = 1 THEN GOSUB coloring:
        IF weekday <> 1 THEN COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
        dd$ = STR$(dd)
        _FONT 8
        IF m = 1 AND dd = 1 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "New Years"
        END IF
 
        IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
        END IF
        IF m = 2 AND dd = 2 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Groundhog"
        END IF
        IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
        END IF
        IF m = 2 AND dd = 14 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
        END IF
        IF m = 3 AND dd = 17 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "St. Patrick"
        END IF
        IF m = PQM AND dd = PQJ THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
        END IF
        IF m = 4 AND dd > 23 AND weekday = 7 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
        END IF
        IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx, weeky + 60), "Armed Forces"
        END IF
        IF m = 5 AND weekday = 2 AND dd > 24 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
        END IF
        IF m = 5 AND weekday = 1 AND dd > 7 AND dd < 15 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx, weeky + 60), "Mother's Day"
        END IF
        IF m = 6 AND weekday = 1 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx, weeky + 60), "Father's Day"
        END IF
        IF m = 6 AND dd = 14 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
        END IF
        IF m = 7 AND dd = 4 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx, weeky + 60), "Independence"
        END IF
        IF m = 9 AND weekday = 2 AND dd < 8 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Labor"
        END IF
        IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Columbus"
        END IF
        IF m = 10 AND dd = 31 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
        END IF
        IF m = 11 AND dd = 11 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Veterans"
        END IF
        IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx, weeky + 60), "Thanksgiving"
        END IF
        IF m = 12 AND dd = 25 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
        END IF
        _FONT 16
        _PRINTSTRING (dayx, weeky), dd$
        _FONT 8
        IF dd = days THEN _FONT 16: GOTO more2:
    NEXT dayx
    w = 25
NEXT weeky
 
more2:
_LIMIT 1000
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
IF a$ = "p" OR a$ = "P" THEN
    'printer prep (code copied and pasted from bplus Free Calendar Program)
    YMAX = _HEIGHT: XMAX = _WIDTH
    landscape& = _NEWIMAGE(YMAX, XMAX, 32)
    _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
    _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
    _PRINTIMAGE landscape&
END IF
 
IF a$ = CHR$(0) + CHR$(77) THEN
    m = m + 1
    IF m > 12 THEN
        m = 1
        yy = yy + 1
    END IF
    y = yy
    IF y > 9999 THEN y = 1753
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
IF a$ = CHR$(0) + CHR$(75) THEN
    m = m - 1
    IF m < 1 THEN
        m = 12
        yy = yy - 1
    END IF
    y = yy
    IF y < 1753 THEN y = 9999
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
 
GOTO more2:
 
'Color all Sundays and holidays
coloring:
LINE (dayx - 4, weeky - 9)-(dayx + 102, weeky + 68), _RGB32(255, 255, 127), BF: COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 127)
RETURN
 
 
'Find the right date for Easter.
PAQUES:
PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
RETURN
 
 
'This section saves the calendar to a BMP file along with the SUB at the end of this program.
saving:
mo$ = STR$(m)
mo$ = LTRIM$(RTRIM$(mo$))
year$ = STR$(yy)
year$ = LTRIM$(RTRIM$(year$))
nm$ = mo$ + "-"
nm$ = LTRIM$(RTRIM$(nm$))
nm$ = nm$ + year$
nm$ = LTRIM$(RTRIM$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
CLS
nm2$ = nm$ + ".bmp"
nm2$ = LTRIM$(RTRIM$(nm2$))
PRINT: PRINT: PRINT
PRINT "                                           Saving"
PRINT
PRINT "                          "; nm2$; " has been saved to your computer."
PRINT
PRINT
INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "                         Goodbye."
END
 
weekdays:
 
'This section gets the right weekday.
SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: y = y - 1
    century = y MOD 100
    zerocentury = y \ 100
    weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
END SUB
 
'This section saves the .bmp picture file.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 

Title: Re: Calendar Maker
Post by: SierraKen 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]

'This is my very first calendar making program!
'Thanks to the guys from the QB64.org forum for the help: bplus, SMcNeill, euklides, and TempodiBasic!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'This version has colored Sundays and holidays.
'Made on Wednesday, September 18, 2019 by Ken G.
 
start:
_TITLE "Calendar Maker"
_LIMIT 1000
dd = 0
leap = 0
m = 0
mm = 0
y = 0
yy = 0
w = 0
weekday = 0
days = 0
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PRINT "                                  Monthly Calendar Maker"
PRINT: PRINT: PRINT
PRINT "                                        By Ken G."
PRINT
PRINT "                         With some help from the QB64.org Forum guys!"
PRINT: PRINT: PRINT
PRINT "          This program will make a calendar for the year and month you want."
PRINT "          It will also name some holidays on their days."
PRINT "          This uses the Gregorian Calendar which became common practice in"
PRINT "          England in 1753 and we still use it today."
PRINT
PRINT "          First make a calendar, then if you want to save it as a .bmp file,"
PRINT "          press the 'S' key and it will save it as the month and year for its name."
PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
PRINT "          press the 'S' key and it will save it as 1-2020.bmp"
PRINT "          If you wish to print your calendar on your printer, press 'P' once."
PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
PRINT "          If you save the .bmp calendar, it will be put in the same directory as this program."
PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
PRINT "          To make a different calendar without saving, press the Space Bar."
PRINT "          Keyboard commands will be listed on the title bar of the window."
again1:
PRINT
INPUT "          Type the year here (1753-9999): ", y
IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
again2:
PRINT
INPUT "          Type the month here (1-12): ", m
PRINT
IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
 
calculate:
'Get the month name.
IF m = 1 THEN month$ = " January"
IF m = 2 THEN month$ = "February"
IF m = 3 THEN month$ = "  March"
IF m = 4 THEN month$ = "  April"
IF m = 5 THEN month$ = "  May"
IF m = 6 THEN month$ = "  June"
IF m = 7 THEN month$ = "  July"
IF m = 8 THEN month$ = " August"
IF m = 9 THEN month$ = "September"
IF m = 10 THEN month$ = " October"
IF m = 11 THEN month$ = "November"
IF m = 12 THEN month$ = "December"
 
'Calculate to see if it's a Leap Year.
IF m <> 2 THEN GOTO nex:
IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
IF y / 4 = INT(y / 4) THEN leap = 1
IF y / 100 = INT(y / 100) THEN leap = 0
 
'Get the number of days for each month.
more:
IF leap = 1 THEN days = 29
IF leap = 0 THEN days = 28
GOTO weekday:
nex:
IF m = 1 THEN days = 31
IF m = 3 THEN days = 31
IF m = 4 THEN days = 30
IF m = 5 THEN days = 31
IF m = 6 THEN days = 30
IF m = 7 THEN days = 31
IF m = 8 THEN days = 31
IF m = 9 THEN days = 30
IF m = 10 THEN days = 31
IF m = 11 THEN days = 30
IF m = 12 THEN days = 31
weekday:
 
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, y, weekday
 
'This section makes the calendar graph.
make:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
_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."
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
LOCATE 3, 42: PRINT month$; "  "; yy
 
FOR x = 20 TO 780 STEP 108
    LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
NEXT x
FOR z = 100 TO 580 STEP 80
    LINE (16, z)-(780, z), _RGB32(0, 0, 0)
NEXT z
 
LOCATE 5, 8: PRINT "SUNDAY"
LOCATE 5, 21: PRINT "MONDAY"
LOCATE 5, 34: PRINT "TUESDAY"
LOCATE 5, 47: PRINT "WEDNESDAY"
LOCATE 5, 60: PRINT "THURSDAY"
LOCATE 5, 75: PRINT "FRIDAY"
LOCATE 5, 87: PRINT "SATURDAY"
 
'Finding Date of Easter
PQA = yy
GOSUB PAQUES
'month = PQM, day = PQJ, year = PQA
 
'This section puts the right dates and holidays in the right squares for the calendar.
_FONT 16
w = (weekday * 108) + 25
FOR weeky = 110 TO 570 STEP 80
    FOR dayx = w TO 692 STEP 108
        _LIMIT 1000
        dd = dd + 1
        GetDay mm, dd, y, weekday
        IF weekday = 1 THEN GOSUB coloring:
        IF weekday <> 1 THEN COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
        dd$ = STR$(dd)
        _FONT 8
        IF m = 1 AND dd = 1 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "New Years"
        END IF
        IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
        END IF
        IF m = 2 AND dd = 2 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 13, weeky + 60), "Groundhog"
        END IF
        IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
        END IF
        IF m = 2 AND dd = 14 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
        END IF
        IF m = 3 AND dd = 17 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 5, weeky + 60), "St. Patrick"
        END IF
        IF m = PQM AND dd = PQJ THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
        END IF
        IF m = 4 AND dd > 23 AND weekday = 7 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
        END IF
        IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Armed Forces"
        END IF
        IF m = 5 AND weekday = 2 AND dd > 24 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
        END IF
        IF m = 5 AND weekday = 1 AND dd > 7 AND dd < 15 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Mother's Day"
        END IF
        IF m = 6 AND weekday = 1 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Father's Day"
        END IF
        IF m = 6 AND dd = 14 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
        END IF
        IF m = 7 AND dd = 4 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Independence"
        END IF
        IF m = 9 AND weekday = 2 AND dd < 8 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 27, weeky + 60), "Labor"
        END IF
        IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 17, weeky + 60), "Columbus"
        END IF
        IF m = 10 AND dd = 31 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
        END IF
        IF m = 11 AND dd = 11 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 19, weeky + 60), "Veterans"
        END IF
        IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Thanksgiving"
        END IF
        IF m = 12 AND dd = 25 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
        END IF
        _FONT 16
        _PRINTSTRING (dayx, weeky), dd$
        _FONT 8
        IF dd = days THEN _FONT 16: GOTO more2:
    NEXT dayx
    w = 25
NEXT weeky
 
more2:
_LIMIT 1000
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
IF a$ = "p" OR a$ = "P" THEN
    'printer prep (code copied and pasted from bplus Free Calendar Program)
    YMAX = _HEIGHT: XMAX = _WIDTH
    landscape& = _NEWIMAGE(YMAX, XMAX, 32)
    _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
    _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
    _PRINTIMAGE landscape&
END IF
 
IF a$ = CHR$(0) + CHR$(77) THEN
    m = m + 1
    IF m > 12 THEN
        m = 1
        yy = yy + 1
    END IF
    y = yy
    IF y > 9999 THEN y = 1753
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
IF a$ = CHR$(0) + CHR$(75) THEN
    m = m - 1
    IF m < 1 THEN
        m = 12
        yy = yy - 1
    END IF
    y = yy
    IF y < 1753 THEN y = 9999
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
 
GOTO more2:
 
'Color all Sundays and holidays
coloring:
LINE (dayx - 4, weeky - 9)-(dayx + 102, weeky + 68), _RGB32(255, 255, 127), BF: COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 127)
RETURN
 
 
'Find the right date for Easter.
PAQUES:
PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
RETURN
 
 
'This section saves the calendar to a BMP file along with the SUB at the end of this program.
saving:
mo$ = STR$(m)
mo$ = LTRIM$(RTRIM$(mo$))
year$ = STR$(yy)
year$ = LTRIM$(RTRIM$(year$))
nm$ = mo$ + "-"
nm$ = LTRIM$(RTRIM$(nm$))
nm$ = nm$ + year$
nm$ = LTRIM$(RTRIM$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
CLS
nm2$ = nm$ + ".bmp"
nm2$ = LTRIM$(RTRIM$(nm2$))
PRINT: PRINT: PRINT
PRINT "                                           Saving"
PRINT
PRINT "                          "; nm2$; " has been saved to your computer."
PRINT
PRINT
INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "                         Goodbye."
END
 
weekdays:
 
'This section gets the right weekday.
SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: y = y - 1
    century = y MOD 100
    zerocentury = y \ 100
    weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
END SUB
 
'This section saves the .bmp picture file.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
 

Title: Re: Calendar Maker
Post by: SierraKen 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]

'This is my very first calendar making program!
'Thanks to the guys from the QB64.org forum for the help: bplus, SMcNeill, euklides, and TempodiBasic!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'This version has colored Sundays and holidays and the option of not having U.S. holidays.
'Made on Thursday, September 19, 2019 by Ken G.
 
start:
_TITLE "Calendar Maker"
_LIMIT 1000
dd = 0
leap = 0
m = 0
mm = 0
y = 0
yy = 0
w = 0
weekday = 0
days = 0
holidays = 0
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PRINT "                                  Monthly Calendar Maker"
PRINT: PRINT: PRINT
PRINT "                                        By Ken G."
PRINT
PRINT "                         With some help from the QB64.org Forum guys!"
PRINT: PRINT: PRINT
PRINT "          This program will make a calendar for the year and month you want."
PRINT "          It will also name some U.S. holidays on their dates if you choose that."
PRINT "          This uses the Gregorian Calendar which became common practice in"
PRINT "          England in 1753 and we still use it today."
PRINT
PRINT "          First make a calendar, then if you want to save it as a .bmp file,"
PRINT "          press the 'S' key and it will save it as the month and year for its name."
PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
PRINT "          press the 'S' key and it will save it as 1-2020.bmp"
PRINT "          If you wish to print your calendar on your printer, press 'P' once."
PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
PRINT "          If you save the .bmp calendar, it will be put in the same directory as this program."
PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
PRINT "          To make a different calendar without saving, press the Space Bar."
PRINT "          Keyboard commands will be listed on the title bar of the window."
again1:
PRINT
INPUT "          Type the year here (1753-9999): ", y
IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
again2:
PRINT
INPUT "          Type the month here (1-12): ", m
PRINT
IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
INPUT "          Do you want U.S. holidays added (Y/N)?", hol$
IF LEFT$(hol$, 1) = "y" OR LEFT$(hol$, 1) = "Y" THEN holidays = 1
calculate:
'Get the month name.
IF m = 1 THEN month$ = " January"
IF m = 2 THEN month$ = "February"
IF m = 3 THEN month$ = "  March"
IF m = 4 THEN month$ = "  April"
IF m = 5 THEN month$ = "  May"
IF m = 6 THEN month$ = "  June"
IF m = 7 THEN month$ = "  July"
IF m = 8 THEN month$ = " August"
IF m = 9 THEN month$ = "September"
IF m = 10 THEN month$ = " October"
IF m = 11 THEN month$ = "November"
IF m = 12 THEN month$ = "December"
 
'Calculate to see if it's a Leap Year.
IF m <> 2 THEN GOTO nex:
IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
IF y / 4 = INT(y / 4) THEN leap = 1
IF y / 100 = INT(y / 100) THEN leap = 0
 
'Get the number of days for each month.
more:
IF leap = 1 THEN days = 29
IF leap = 0 THEN days = 28
GOTO weekday:
nex:
IF m = 1 THEN days = 31
IF m = 3 THEN days = 31
IF m = 4 THEN days = 30
IF m = 5 THEN days = 31
IF m = 6 THEN days = 30
IF m = 7 THEN days = 31
IF m = 8 THEN days = 31
IF m = 9 THEN days = 30
IF m = 10 THEN days = 31
IF m = 11 THEN days = 30
IF m = 12 THEN days = 31
weekday:
 
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, y, weekday
 
'This section makes the calendar graph.
make:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
_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."
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
LOCATE 3, 42: PRINT month$; "  "; yy
 
FOR x = 20 TO 780 STEP 108
    LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
NEXT x
FOR z = 100 TO 580 STEP 80
    LINE (16, z)-(780, z), _RGB32(0, 0, 0)
NEXT z
 
LOCATE 5, 8: PRINT "SUNDAY"
LOCATE 5, 21: PRINT "MONDAY"
LOCATE 5, 34: PRINT "TUESDAY"
LOCATE 5, 47: PRINT "WEDNESDAY"
LOCATE 5, 60: PRINT "THURSDAY"
LOCATE 5, 75: PRINT "FRIDAY"
LOCATE 5, 87: PRINT "SATURDAY"
 
'Finding Date of Easter
PQA = yy
GOSUB PAQUES
'month = PQM, day = PQJ, year = PQA
 
'This section puts the right dates and holidays in the right squares for the calendar.
_FONT 16
w = (weekday * 108) + 25
FOR weeky = 110 TO 570 STEP 80
    FOR dayx = w TO 692 STEP 108
        _LIMIT 1000
        dd = dd + 1
        GetDay mm, dd, y, weekday
        IF weekday = 1 THEN GOSUB coloring:
        IF weekday <> 1 THEN COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
        dd$ = STR$(dd)
        IF holidays = 0 THEN GOTO skip:
        _FONT 8
        IF m = 1 AND dd = 1 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "New Years"
        END IF
        IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
        END IF
        IF m = 2 AND dd = 2 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 13, weeky + 60), "Groundhog"
        END IF
        IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
        END IF
        IF m = 2 AND dd = 14 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
        END IF
        IF m = 3 AND dd = 17 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 5, weeky + 60), "St. Patrick"
        END IF
        IF m = PQM AND dd = PQJ THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
        END IF
        IF m = 4 AND dd > 23 AND weekday = 7 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
        END IF
        IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Armed Forces"
        END IF
        IF m = 5 AND weekday = 2 AND dd > 24 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
        END IF
        IF m = 5 AND weekday = 1 AND dd > 7 AND dd < 15 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Mother's Day"
        END IF
        IF m = 6 AND weekday = 1 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Father's Day"
        END IF
        IF m = 6 AND dd = 14 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
        END IF
        IF m = 7 AND dd = 4 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Independence"
        END IF
        IF m = 9 AND weekday = 2 AND dd < 8 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 27, weeky + 60), "Labor"
        END IF
        IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 17, weeky + 60), "Columbus"
        END IF
        IF m = 10 AND dd = 31 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
        END IF
        IF m = 11 AND dd = 11 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 19, weeky + 60), "Veterans"
        END IF
        IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Thanksgiving"
        END IF
        IF m = 12 AND dd = 25 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
        END IF
        skip:
        _FONT 16
        _PRINTSTRING (dayx, weeky), dd$
        _FONT 8
        IF dd = days THEN _FONT 16: GOTO more2:
    NEXT dayx
    w = 25
NEXT weeky
 
more2:
_LIMIT 1000
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
IF a$ = "p" OR a$ = "P" THEN
    'printer prep (code copied and pasted from bplus Free Calendar Program)
    YMAX = _HEIGHT: XMAX = _WIDTH
    landscape& = _NEWIMAGE(YMAX, XMAX, 32)
    _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
    _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
    _PRINTIMAGE landscape&
END IF
 
IF a$ = CHR$(0) + CHR$(77) THEN
    m = m + 1
    IF m > 12 THEN
        m = 1
        yy = yy + 1
    END IF
    y = yy
    IF y > 9999 THEN y = 1753
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
IF a$ = CHR$(0) + CHR$(75) THEN
    m = m - 1
    IF m < 1 THEN
        m = 12
        yy = yy - 1
    END IF
    y = yy
    IF y < 1753 THEN y = 9999
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
 
GOTO more2:
 
'Color all Sundays and holidays
coloring:
LINE (dayx - 4, weeky - 9)-(dayx + 102, weeky + 68), _RGB32(255, 255, 127), BF: COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 127)
RETURN
 
 
'Find the right date for Easter.
PAQUES:
PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
RETURN
 
 
'This section saves the calendar to a BMP file along with the SUB at the end of this program.
saving:
mo$ = STR$(m)
mo$ = LTRIM$(RTRIM$(mo$))
year$ = STR$(yy)
year$ = LTRIM$(RTRIM$(year$))
nm$ = mo$ + "-"
nm$ = LTRIM$(RTRIM$(nm$))
nm$ = nm$ + year$
nm$ = LTRIM$(RTRIM$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
CLS
nm2$ = nm$ + ".bmp"
nm2$ = LTRIM$(RTRIM$(nm2$))
PRINT: PRINT: PRINT
PRINT "                                           Saving"
PRINT
PRINT "                          "; nm2$; " has been saved to your computer."
PRINT
PRINT
INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "                         Goodbye."
END
 
weekdays:
 
'This section gets the right weekday.
SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: y = y - 1
    century = y MOD 100
    zerocentury = y \ 100
    weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
END SUB
 
'This section saves the .bmp picture file.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 

Title: Re: Calendar Maker
Post by: Jack002 on September 19, 2019, 05:26:44 pm

I like the one on post #35 best. Very nice work. Bravo.

Title: Re: Calendar Maker
Post by: SierraKen 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.

Title: Re: Calendar Maker
Post by: SierraKen 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]

'This is my very first calendar making program!
'Thanks to the guys from the QB64.org forum for the help: bplus, SMcNeill, euklides, and TempodiBasic!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'This version has the ability to add info or holidays to dates.
'Made on Thursday, September 19, 2019 by Ken G.
 
start:
_TITLE "Calendar Maker"
_LIMIT 1000
DIM newinfo$(50)
DIM dayinfo(50)
dd = 0
leap = 0
m = 0
mm = 0
y = 0
yy = 0
w = 0
weekday = 0
days = 0
holidays = 0
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PRINT "                                  Monthly Calendar Maker"
PRINT: PRINT: PRINT
PRINT "                                        By Ken G."
PRINT
PRINT "                         With some help from the QB64.org Forum guys!"
PRINT: PRINT: PRINT
PRINT "          This program will make a calendar for the year and month you want."
PRINT "          It will also name some U.S. holidays on their dates if you choose that."
PRINT "          You also can add holidays or info to any day you wish with up to 12"
PRINT "          letters, numbers, symbols, or spaces."
PRINT "          This uses the Gregorian Calendar which became common practice in"
PRINT "          England in 1753 and we still use it today."
PRINT
PRINT "          First make a calendar, then if you want to save it as a .bmp file,"
PRINT "          press the 'S' key and it will save it as the month and year for its name."
PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
PRINT "          press the 'S' key and it will save it as 1-2020.bmp"
PRINT "          If you wish to print your calendar on your printer, press 'P' once."
PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
PRINT "          If you save the .bmp calendar, it will be put in the same directory as this program."
PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
PRINT "          Switching months with the arrow keys will not save your new date info if you come back."
PRINT "          To make a different calendar without saving, press the Space Bar."
PRINT "          Keyboard commands will be listed on the title bar of the window."
again1:
PRINT
INPUT "          Type the year here (1753-9999): ", y
IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
again2:
PRINT
INPUT "          Type the month here (1-12): ", m
PRINT
IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
INPUT "          Do you want U.S. holidays added (Y/N)?", hol$
IF LEFT$(hol$, 1) = "y" OR LEFT$(hol$, 1) = "Y" THEN holidays = 1
PRINT
INPUT "          Do you want to add your own holidays or info (Y/N)?", adding$
calculate:
info = 0
infos = 0
'Get the month name.
IF m = 1 THEN month$ = " January"
IF m = 2 THEN month$ = "February"
IF m = 3 THEN month$ = "  March"
IF m = 4 THEN month$ = "  April"
IF m = 5 THEN month$ = "  May"
IF m = 6 THEN month$ = "  June"
IF m = 7 THEN month$ = "  July"
IF m = 8 THEN month$ = " August"
IF m = 9 THEN month$ = "September"
IF m = 10 THEN month$ = " October"
IF m = 11 THEN month$ = "November"
IF m = 12 THEN month$ = "December"
 
'Calculate to see if it's a Leap Year.
IF m <> 2 THEN GOTO nex:
IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
IF y / 4 = INT(y / 4) THEN leap = 1
IF y / 100 = INT(y / 100) THEN leap = 0
 
'Get the number of days for each month.
more:
IF leap = 1 THEN days = 29
IF leap = 0 THEN days = 28
GOTO weekday:
nex:
IF m = 1 THEN days = 31
IF m = 3 THEN days = 31
IF m = 4 THEN days = 30
IF m = 5 THEN days = 31
IF m = 6 THEN days = 30
IF m = 7 THEN days = 31
IF m = 8 THEN days = 31
IF m = 9 THEN days = 30
IF m = 10 THEN days = 31
IF m = 11 THEN days = 30
IF m = 12 THEN days = 31
weekday:
 
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, y, weekday
 
 
IF LEFT$(adding$, 1) = "y" OR LEFT$(adding$, 1) = "Y" THEN GOSUB adding:
adding$ = ""
 
'This section makes the calendar graph.
make:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
_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."
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
LOCATE 3, 42: PRINT month$; "  "; yy
 
FOR x = 20 TO 780 STEP 108
    LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
NEXT x
FOR z = 100 TO 580 STEP 80
    LINE (16, z)-(780, z), _RGB32(0, 0, 0)
NEXT z
 
LOCATE 5, 8: PRINT "SUNDAY"
LOCATE 5, 21: PRINT "MONDAY"
LOCATE 5, 34: PRINT "TUESDAY"
LOCATE 5, 47: PRINT "WEDNESDAY"
LOCATE 5, 60: PRINT "THURSDAY"
LOCATE 5, 75: PRINT "FRIDAY"
LOCATE 5, 87: PRINT "SATURDAY"
 
'Finding Date of Easter
PQA = yy
GOSUB PAQUES
'month = PQM, day = PQJ, year = PQA
 
'This section puts the right dates and holidays in the right squares for the calendar.
_FONT 16
w = (weekday * 108) + 25
FOR weeky = 110 TO 570 STEP 80
    FOR dayx = w TO 692 STEP 108
        _LIMIT 1000
        dd = dd + 1
        GetDay mm, dd, y, weekday
        IF weekday = 1 THEN GOSUB coloring:
        IF weekday <> 1 THEN COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
        dd$ = STR$(dd)
        _FONT 8
        IF dd = dayinfo(infos) THEN
            GOSUB coloring:
            i = LEN(newinfo$(infos))
            IF i < 8 THEN ii = 25
            IF i > 7 AND i < 12 THEN ii = 11
            IF i > 11 AND i < 14 THEN ii = 5
            IF i > 13 THEN ii = 2
            _PRINTSTRING (dayx + ii, weeky + 20), newinfo$(infos)
            infos = infos + 1
            ye = 1
        END IF
        IF holidays = 0 THEN GOTO skip:
        IF m = 1 AND dd = 1 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "New Years"
        END IF
        IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
        END IF
        IF m = 2 AND dd = 2 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 13, weeky + 60), "Groundhog"
        END IF
        IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
        END IF
        IF m = 2 AND dd = 14 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
        END IF
        IF m = 3 AND dd = 17 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 5, weeky + 60), "St. Patrick"
        END IF
        IF m = PQM AND dd = PQJ THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
        END IF
        IF m = 4 AND dd > 23 AND weekday = 7 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
        END IF
        IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Armed Forces"
        END IF
        IF m = 5 AND weekday = 2 AND dd > 24 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
        END IF
        IF m = 5 AND weekday = 1 AND dd > 7 AND dd < 15 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Mother's Day"
        END IF
        IF m = 6 AND weekday = 1 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Father's Day"
        END IF
        IF m = 6 AND dd = 14 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
        END IF
        IF m = 7 AND dd = 4 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Independence"
        END IF
        IF m = 9 AND weekday = 2 AND dd < 8 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 27, weeky + 60), "Labor"
        END IF
        IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 17, weeky + 60), "Columbus"
        END IF
        IF m = 10 AND dd = 31 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
        END IF
        IF m = 11 AND dd = 11 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 19, weeky + 60), "Veterans"
        END IF
        IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Thanksgiving"
        END IF
        IF m = 12 AND dd = 25 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
        END IF
        skip:
        ye = 0
        _FONT 16
        _PRINTSTRING (dayx, weeky), dd$
        _FONT 8
        IF dd = days THEN _FONT 16: GOTO more2:
    NEXT dayx
    w = 25
NEXT weeky
 
more2:
_LIMIT 1000
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
IF a$ = "p" OR a$ = "P" THEN
    'printer prep (code copied and pasted from bplus Free Calendar Program)
    YMAX = _HEIGHT: XMAX = _WIDTH
    landscape& = _NEWIMAGE(YMAX, XMAX, 32)
    _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
    _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
    _PRINTIMAGE landscape&
END IF
 
IF a$ = CHR$(0) + CHR$(77) THEN
    m = m + 1
    IF m > 12 THEN
        m = 1
        yy = yy + 1
    END IF
    y = yy
    IF y > 9999 THEN y = 1753
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
IF a$ = CHR$(0) + CHR$(75) THEN
    m = m - 1
    IF m < 1 THEN
        m = 12
        yy = yy - 1
    END IF
    y = yy
    IF y < 1753 THEN y = 9999
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
 
GOTO more2:
 
adding:
CLS
PRINT: PRINT
add:
PRINT
olddayinfo = dayinfo(info)
info = info + 1
infos = 1
adding2:
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
PRINT
PRINT "Your dates must go in order here."
PRINT "for example, you cannot put info for day 15 and then put info for day 1."
PRINT "They must all follow from smallest number to highest number or it will tell you to start over again."
PRINT
PRINT info; ". ";
INPUT "Which day of the month for new holiday or information: ", dayinfo(info)
IF dayinfo(info) > days THEN PRINT "That day is not on this calendar, try again.": GOTO adding2:
IF dayinfo(info) < 1 THEN PRINT "You cannot type a date less than 1, try again.": GOTO adding2:
IF dayinfo(info) <> INT(dayinfo(info)) THEN PRINT "You cannot type a decimal for a date, try again.": GOTO adding2:
IF dayinfo(info) < olddayinfo THEN
    PRINT
    PRINT "You have put a date before your previous one which cannot work, start over from your first date."
    FOR dl = 1 TO info
        newinfo$(dl) = ""
        dayinfo(dl) = 0
    NEXT dl
    olddayinfo = 0
    info = 0
    GOTO add:
END IF
adding3:
PRINT
PRINT "Type up to 12 letters, numbers, or spaces that will be put for that day."
PRINT
INPUT "->", newinfo$(info)
infoamount = LEN(newinfo$(info))
IF infoamount > 12 THEN PRINT "Too long, try again.": GOTO adding3:
IF infoamount < 1 THEN PRINT "Nothing typed, try again.": GOTO adding3:
PRINT
INPUT "Do you want to add more (Y/N):", yn$
IF LEFT$(yn$, 1) = "y" OR LEFT$(yn$, 1) = "Y" THEN GOTO adding:
RETURN
 
'Color all Sundays and holidays
coloring:
IF ye = 1 THEN RETURN
LINE (dayx - 4, weeky - 9)-(dayx + 102, weeky + 68), _RGB32(255, 255, 127), BF: COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 127)
RETURN
 
 
'Find the right date for Easter.
PAQUES:
PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
RETURN
 
 
'This section saves the calendar to a BMP file along with the SUB at the end of this program.
saving:
mo$ = STR$(m)
mo$ = LTRIM$(RTRIM$(mo$))
year$ = STR$(yy)
year$ = LTRIM$(RTRIM$(year$))
nm$ = mo$ + "-"
nm$ = LTRIM$(RTRIM$(nm$))
nm$ = nm$ + year$
nm$ = LTRIM$(RTRIM$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
CLS
nm2$ = nm$ + ".bmp"
nm2$ = LTRIM$(RTRIM$(nm2$))
PRINT: PRINT: PRINT
PRINT "                                           Saving"
PRINT
PRINT "                          "; nm2$; " has been saved to your computer."
PRINT
PRINT
INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "                         Goodbye."
END
 
weekdays:
 
'This section gets the right weekday.
SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: y = y - 1
    century = y MOD 100
    zerocentury = y \ 100
    weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
END SUB
 
'This section saves the .bmp picture file.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
 

Title: Re: Calendar Maker
Post by: TempodiBasic on September 20, 2019, 07:35:27 am

Oh Thanks SierraKen

It seems cooler than first one

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

but remember to print o save as image before change mounth by keyboard!

Title: Re: Calendar Maker
Post by: STxAxTIC 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.

Title: Re: Calendar Maker
Post by: SierraKen 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.

Title: Re: Calendar Maker
Post by: SierraKen 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]

'This is my very first calendar making program!
'Thanks to the guys from the QB64.org forum for the help: bplus, SMcNeill, euklides, and TempodiBasic!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'This version has the ability to add info or holidays to dates.
'Made on Thursday, September 19, 2019 by Ken G.
 
start:
_TITLE "Calendar Maker"
_LIMIT 1000
DIM newinfo$(50)
DIM dayinfo(50)
dd = 0
leap = 0
m = 0
mm = 0
y = 0
yy = 0
w = 0
weekday = 0
days = 0
holidays = 0
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PRINT "                                  Monthly Calendar Maker"
PRINT: PRINT: PRINT
PRINT "                                        By Ken G."
PRINT
PRINT "                         With some help from the QB64.org Forum guys!"
PRINT: PRINT: PRINT
PRINT "          This program will make a calendar for the year and month you want."
PRINT "          It will also name some U.S. holidays on their dates if you choose that."
PRINT "          You also can add holidays or info to any day you wish with up to 12"
PRINT "          letters, numbers, symbols, or spaces."
PRINT "          This uses the Gregorian Calendar which became common practice in"
PRINT "          England in 1753 and we still use it today."
PRINT
PRINT "          First make a calendar, then if you want to save it as a .bmp file,"
PRINT "          press the 'S' key and it will save it as the month and year for its name."
PRINT "          For example, if you made a calendar for January 2020 and wish to save it,"
PRINT "          press the 'S' key and it will save it as 1-2020.bmp"
PRINT "          If you wish to print your calendar on your printer, press 'P' once."
PRINT "          Feel free to print as many times as you wish. They take up 1 page each."
PRINT "          If you save the .bmp calendar, it will be put in the same directory as this program."
PRINT "          To switch to the last month use the left arrow key, to the next month the right arrow key."
PRINT "          Switching months with the arrow keys will not save your new date info if you come back."
PRINT "          To make a different calendar without saving, press the Space Bar."
PRINT "          Keyboard commands will be listed on the title bar of the window."
again1:
PRINT
INPUT "          Type the year here (1753-9999): ", y
IF y <> INT(y) THEN PRINT "Cannot use decimals, try again.": GOTO again1:
IF y < 1753 OR y > 9999 THEN PRINT "The year can only be between 1753 and 9999, try again.": GOTO again1:
again2:
PRINT
INPUT "          Type the month here (1-12): ", m
PRINT
IF m <> INT(m) THEN PRINT "Cannot use decimals, try again.": GOTO again2:
IF m < 1 OR m > 12 THEN PRINT "1-12 only, try again.": GOTO again2:
INPUT "          Do you want U.S. holidays added (Y/N)?", hol$
IF LEFT$(hol$, 1) = "y" OR LEFT$(hol$, 1) = "Y" THEN holidays = 1
PRINT
INPUT "          Do you want to add your own holidays or info (Y/N)?", adding$
calculate:
info = 0
infos = 0
'Get the month name.
IF m = 1 THEN month$ = " January"
IF m = 2 THEN month$ = "February"
IF m = 3 THEN month$ = "  March"
IF m = 4 THEN month$ = "  April"
IF m = 5 THEN month$ = "  May"
IF m = 6 THEN month$ = "  June"
IF m = 7 THEN month$ = "  July"
IF m = 8 THEN month$ = " August"
IF m = 9 THEN month$ = "September"
IF m = 10 THEN month$ = " October"
IF m = 11 THEN month$ = "November"
IF m = 12 THEN month$ = "December"
 
'Calculate to see if it's a Leap Year.
IF m <> 2 THEN GOTO nex:
IF y / 400 = INT(y / 400) THEN leap = 1: GOTO more:
IF y / 4 = INT(y / 4) THEN leap = 1
IF y / 100 = INT(y / 100) THEN leap = 0
 
'Get the number of days for each month.
more:
IF leap = 1 THEN days = 29
IF leap = 0 THEN days = 28
GOTO weekday:
nex:
IF m = 1 THEN days = 31
IF m = 3 THEN days = 31
IF m = 4 THEN days = 30
IF m = 5 THEN days = 31
IF m = 6 THEN days = 30
IF m = 7 THEN days = 31
IF m = 8 THEN days = 31
IF m = 9 THEN days = 30
IF m = 10 THEN days = 31
IF m = 11 THEN days = 30
IF m = 12 THEN days = 31
weekday:
 
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, y, weekday
 
 
IF LEFT$(adding$, 1) = "y" OR LEFT$(adding$, 1) = "Y" THEN GOSUB adding:
adding$ = ""
 
'This section makes the calendar graph.
make:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
_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."
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
LOCATE 3, 42: PRINT month$; "  "; yy
 
FOR x = 20 TO 780 STEP 108
    LINE (x, 100)-(x, 580), _RGB32(0, 0, 0)
NEXT x
FOR z = 100 TO 580 STEP 80
    LINE (16, z)-(780, z), _RGB32(0, 0, 0)
NEXT z
 
LOCATE 5, 8: PRINT "SUNDAY"
LOCATE 5, 21: PRINT "MONDAY"
LOCATE 5, 34: PRINT "TUESDAY"
LOCATE 5, 47: PRINT "WEDNESDAY"
LOCATE 5, 60: PRINT "THURSDAY"
LOCATE 5, 75: PRINT "FRIDAY"
LOCATE 5, 87: PRINT "SATURDAY"
 
'Finding Date of Easter
PQA = yy
GOSUB PAQUES
'month = PQM, day = PQJ, year = PQA
 
'This section puts the right dates and holidays in the right squares for the calendar.
_FONT 16
w = (weekday * 108) + 25
FOR weeky = 110 TO 570 STEP 80
    FOR dayx = w TO 692 STEP 108
        _LIMIT 1000
        dd = dd + 1
        GetDay mm, dd, y, weekday
        IF weekday = 1 THEN GOSUB coloring:
        IF weekday <> 1 THEN COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
        dd$ = STR$(dd)
        _FONT 8
        IF dd = dayinfo(infos) THEN
            GOSUB coloring:
            i = LEN(newinfo$(infos))
            IF i < 8 THEN ii = 25
            IF i > 7 AND i < 12 THEN ii = 11
            IF i > 11 AND i < 14 THEN ii = 5
            IF i > 13 THEN ii = 2
            _PRINTSTRING (dayx + ii, weeky + 20), newinfo$(infos)
            infos = infos + 1
            ye = 1
        END IF
        IF holidays = 0 THEN GOTO skip:
        IF m = 1 AND dd = 1 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "New Years"
        END IF
        IF m = 1 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "MLK Jr."
        END IF
        IF m = 2 AND dd = 2 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 13, weeky + 60), "Groundhog"
        END IF
        IF m = 2 AND weekday = 2 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Presidents"
        END IF
        IF m = 2 AND dd = 14 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 10, weeky + 60), "Valentines"
        END IF
        IF m = 3 AND dd = 17 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 5, weeky + 60), "St. Patrick"
        END IF
        IF m = PQM AND dd = PQJ THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
        END IF
        IF m = 4 AND dd > 23 AND weekday = 7 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Arbor"
        END IF
        IF m = 5 AND weekday = 0 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Armed Forces"
        END IF
        IF m = 5 AND weekday = 2 AND dd > 24 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Memorial"
        END IF
        IF m = 5 AND weekday = 1 AND dd > 7 AND dd < 15 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Mother's Day"
        END IF
        IF m = 6 AND weekday = 1 AND dd > 14 AND dd < 22 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Father's Day"
        END IF
        IF m = 6 AND dd = 14 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 35, weeky + 60), "Flag"
        END IF
        IF m = 7 AND dd = 4 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Independence"
        END IF
        IF m = 9 AND weekday = 2 AND dd < 8 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 27, weeky + 60), "Labor"
        END IF
        IF m = 10 AND dd > 9 AND dd < 16 AND weekday = 2 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 17, weeky + 60), "Columbus"
        END IF
        IF m = 10 AND dd = 31 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Halloween"
        END IF
        IF m = 11 AND dd = 11 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 19, weeky + 60), "Veterans"
        END IF
        IF m = 11 AND dd > 21 AND dd < 29 AND weekday = 5 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 2, weeky + 60), "Thanksgiving"
        END IF
        IF m = 12 AND dd = 25 THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 15, weeky + 60), "Christmas"
        END IF
        skip:
        ye = 0
        _FONT 16
        _PRINTSTRING (dayx, weeky), dd$
        _FONT 8
        IF dd = days THEN _FONT 16: GOTO more2:
    NEXT dayx
    w = 25
NEXT weeky
 
more2:
_LIMIT 1000
a$ = INKEY$
IF a$ = CHR$(27) THEN CLS: PRINT: PRINT: PRINT "Goodbye.": END
IF a$ = "s" OR a$ = "S" THEN GOTO saving:
IF a$ = " " THEN GOTO start:
IF a$ = "p" OR a$ = "P" THEN
    'printer prep (code copied and pasted from bplus Free Calendar Program)
    YMAX = _HEIGHT: XMAX = _WIDTH
    landscape& = _NEWIMAGE(YMAX, XMAX, 32)
    _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
    _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
    _PRINTIMAGE landscape&
END IF
 
IF a$ = CHR$(0) + CHR$(77) THEN
    m = m + 1
    IF m > 12 THEN
        m = 1
        yy = yy + 1
    END IF
    y = yy
    IF y > 9999 THEN y = 1753
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
IF a$ = CHR$(0) + CHR$(75) THEN
    m = m - 1
    IF m < 1 THEN
        m = 12
        yy = yy - 1
    END IF
    y = yy
    IF y < 1753 THEN y = 9999
    dd = 0
    leap = 0
    _DELAY .1
    CLS
    GOTO calculate:
END IF
 
GOTO more2:
 
adding:
CLS
PRINT: PRINT
add:
PRINT
olddayinfo = dayinfo(info)
info = info + 1
infos = 1
adding2:
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
PRINT
PRINT "Your dates must go in order here."
PRINT "for example, you cannot put info for day 15 and then put info for day 1."
PRINT "They must all follow from smallest number to highest number or it will tell you to start over again."
PRINT "Also, you cannot change a day by doing it over again, so if you mess up, create a new month."
PRINT
PRINT info; ". ";
INPUT "Which day of the month for new holiday or information: ", dayinfo(info)
IF dayinfo(info) > days THEN PRINT "That day is not on this calendar, try again.": GOTO adding2:
IF dayinfo(info) < 1 THEN PRINT "You cannot type a date less than 1, try again.": GOTO adding2:
IF dayinfo(info) <> INT(dayinfo(info)) THEN PRINT "You cannot type a decimal for a date, try again.": GOTO adding2:
IF dayinfo(info) < olddayinfo THEN
    PRINT
    PRINT "You have put a date before your previous one which cannot work, start over from your first date."
    FOR dl = 1 TO info
        newinfo$(dl) = ""
        dayinfo(dl) = 0
    NEXT dl
    olddayinfo = 0
    info = 0
    GOTO add:
END IF
adding3:
PRINT
PRINT "Type up to 12 letters, numbers, or spaces that will be put for that day."
PRINT
INPUT "->", newinfo$(info)
infoamount = LEN(newinfo$(info))
IF infoamount > 12 THEN PRINT "Too long, try again.": GOTO adding3:
IF infoamount < 1 THEN PRINT "Nothing typed, try again.": GOTO adding3:
PRINT
INPUT "Do you want to add more (Y/N):", yn$
IF LEFT$(yn$, 1) = "y" OR LEFT$(yn$, 1) = "Y" THEN GOTO adding:
RETURN
 
'Color all Sundays and holidays
coloring:
IF ye = 1 THEN RETURN
LINE (dayx - 4, weeky - 9)-(dayx + 102, weeky + 68), _RGB32(255, 255, 127), BF: COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 127)
RETURN
 
 
'Find the right date for Easter.
PAQUES:
PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
RETURN
 
 
'This section saves the calendar to a BMP file along with the SUB at the end of this program.
saving:
mo$ = STR$(m)
mo$ = LTRIM$(RTRIM$(mo$))
year$ = STR$(yy)
year$ = LTRIM$(RTRIM$(year$))
nm$ = mo$ + "-"
nm$ = LTRIM$(RTRIM$(nm$))
nm$ = nm$ + year$
nm$ = LTRIM$(RTRIM$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
CLS
nm2$ = nm$ + ".bmp"
nm2$ = LTRIM$(RTRIM$(nm2$))
PRINT: PRINT: PRINT
PRINT "                                           Saving"
PRINT
PRINT "                          "; nm2$; " has been saved to your computer."
PRINT
PRINT
INPUT "                         Do you wish to make another calendar (Y/N)"; ag$
IF LEFT$(ag$, 1) = "y" OR LEFT$(ag$, 1) = "Y" THEN GOTO start:
PRINT
PRINT
PRINT "                         Goodbye."
END
 
weekdays:
 
'This section gets the right weekday.
SUB GetDay (mm, dd, y, weekday) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    IF mm < 3 THEN mm = mm + 12: y = y - 1
    century = y MOD 100
    zerocentury = y \ 100
    weekday = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
END SUB
 
'This section saves the .bmp picture file.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 

Text Only | Text with Attachments