Author Topic: Calendar 2021 (Read 6969 times)

SMcNeill · « **on:** December 24, 2020, 06:45:17 pm »

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

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

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

Code: QB64: [Select]

CONST ShowGrid = -1
CONST ShowYear = 0
CONST DesiredYear = 2021
$COLOR:32
 
SCREEN _NEWIMAGE(1283, 720, 32)
_PRINTMODE _KEEPBACKGROUND
RANDOMIZE TIMER
 
 
DIM SHARED f: f = _LOADFONT("OLDENGL.ttf", 72)
DIM SHARED ThisMonth, Today, ThisYear
DIM SHARED BackGrounds(1 TO 12)
 
ThisMonth = VAL(DATE$)
Today = VAL(MID$(DATE$, 4))
ThisYear = VAL(RIGHT$(DATE$, 4))
 
 
 
TitleScreen
IF ShowYear THEN
    FOR i = 1 TO 12
        CLS
        _PUTIMAGE , BackGrounds(i)
        IF ShowGrid THEN DrawLines
        CenterMonth i, DesiredYear
        DrawDays i, DesiredYear
        SLEEP
    NEXT
ELSE
    CLS
    _PUTIMAGE , BackGrounds(1)
    IF ShowGrid THEN DrawLines
    CenterMonth ThisMonth, ThisYear
    DrawDays ThisMonth, ThisYear
    SLEEP
END IF
SYSTEM
 
 
SUB TitleScreen
    _TITLE "Steve's Calendar"
    CLS , SkyBlue
    _FONT f
    text$ = "Steve's Calendar"
    pw = _PRINTWIDTH(text$) \ 2
    _PRINTSTRING (640 - pw, 200), text$
    IF ShowYear THEN
        text$ = _TRIM$(STR$(DesiredYear))
    ELSE
        text$ = _TRIM$(STR$(ThisYear))
    END IF
    pw = _PRINTWIDTH(text$) \ 2
    _PRINTSTRING (640 - pw, 300), text$
    GetBackgrounds
    _FONT 16
    COLOR Black
    text$ = "Press <ANY KEY> to continue."
    pw = _PRINTWIDTH(text$) \ 2
    _PRINTSTRING (640 - pw, 400), text$
    COLOR White
    _FONT f
    SLEEP 2
END SUB
 
 
SUB GetHolidays (month, day, holiday() AS STRING)
    REDIM holiday(0) AS STRING
    SELECT CASE month
        CASE 1
            SELECT CASE day
                CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "New Years Day"
                CASE 6: REDIM holiday(1) AS STRING: holiday(1) = "Epiphany"
            END SELECT
        CASE 2
            SELECT CASE day
                CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "Black History Month"
                CASE 2: REDIM holiday(1) AS STRING: holiday(1) = "Groundhog Day"
                CASE 14: REDIM holiday(1) AS STRING: holiday(1) = "Valentine's Day"
            END SELECT
        CASE 3
            SELECT CASE day
                CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "Women's History Month"
            END SELECT
        CASE 4
            SELECT CASE day
                CASE 15: REDIM holiday(1) AS STRING: holiday(1) = "Tax Day"
            END SELECT
        CASE 5
            SELECT CASE day
            END SELECT
        CASE 6
            SELECT CASE day
            END SELECT
        CASE 7
            SELECT CASE day
                CASE 4: REDIM holiday(1) AS STRING: holiday(1) = "Independence Day"
            END SELECT
        CASE 8
            SELECT CASE day
            END SELECT
        CASE 9
            SELECT CASE day
                CASE 25: REDIM holiday(1) AS STRING: holiday(1) = "Steve's Birthday"
            END SELECT
        CASE 10
            SELECT CASE day
                CASE 31: REDIM holiday(1) AS STRING: holiday(1) = "Halloween"
            END SELECT
        CASE 11
            SELECT CASE day
                CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "All Saint's Day"
                CASE 2: REDIM holiday(1) AS STRING: holiday(1) = "All Soul's Day"
                CASE 11: REDIM holiday(1) AS STRING: holiday(1) = "Vetern's Day"
            END SELECT
        CASE 12
            SELECT CASE day
                CASE 7: REDIM holiday(1) AS STRING: holiday(1) = "Pearl Harbor Remembrance"
                CASE 24: REDIM holiday(1) AS STRING: holiday(1) = "Christmas Eve"
                CASE 25: REDIM holiday(1) AS STRING: holiday(1) = "Christmas"
                CASE ELSE: REDIM holiday(0) AS STRING
            END SELECT
    END SELECT
END SUB
 
 
SUB GetBackgrounds
    IF ShowYear THEN limit = 12 ELSE limit = 1
    FOR i = 1 TO limit
        redo:
        t = INT(RND * 1088) + 1
        FOR j = 1 TO i
            IF BackGrounds(j) = t GOTO redo
            t$ = ".\Backgrounds\" + _TRIM$(STR$(t)) + ".jpg"
            t1 = _LOADIMAGE(t$, 32)
            IF t1 = -1 THEN _FREEIMAGE t1: GOTO redo
        NEXT
        BackGrounds(i) = t1
    NEXT
END SUB
 
SUB CenterMonth (month, year)
    _FONT f
    SELECT CASE month
        CASE 1: text$ = "January"
        CASE 2: text$ = "February"
        CASE 3: text$ = "March"
        CASE 4: text$ = "April"
        CASE 5: text$ = "May"
        CASE 6: text$ = "June"
        CASE 7: text$ = "July"
        CASE 8: text$ = "August"
        CASE 9: text$ = "September"
        CASE 10: text$ = "October"
        CASE 11: text$ = "November"
        CASE 12: text$ = "December"
    END SELECT
    text$ = text$ + STR$(year)
    pw = _PRINTWIDTH(text$) / 2
    _PRINTSTRING (640 - pw, 0), text$
END SUB
 
 
SUB DrawLines
    TopOffset = 72
    FOR i = 0 TO 6
        LINE (0, i * 90 + TopOffset)-STEP(1280, 3), _RGBA32(128, 128, 64, 160), BF
    NEXT
    FOR i = 0 TO 7
        LINE (i * 1280 / 7, 0 + TopOffset)-STEP(3, 540), _RGBA32(128, 128, 64, 160), BF
    NEXT
END SUB
 
 
SUB DrawDays (month, year)
    SHARED highlightday
    REDIM Holidays(0) AS STRING
    TopOffset = 76
    nod = NumberOfDays(month, year)
    y = 0
    FOR i = 1 TO nod
        text$ = _TRIM$(STR$(i))
        pw = _PRINTWIDTH(text$)
        x = GetDay(month, i, year)
        IF month = ThisMonth AND i = Today AND ThisYear = year THEN LINE ((x - 1) * 1280 / 7 + 3, y * 90 + TopOffset)-STEP(1280 / 7 - 3, 86), Blue, BF
        _PRINTSTRING (x * 1280 / 7 - pw, y * 90 + TopOffset), text$
        GetHolidays month, i, Holidays()
        u = UBOUND(holidays)
        IF u > 0 THEN
            _FONT 8
            FOR j = 1 TO u
                pw = _PRINTWIDTH(Holidays(j))
                _PRINTSTRING ((x - 1) * 1280 / 7 + 4, (y + 1) * 90 + TopOffset - 5 - j * 8), Holidays(j)
            NEXT
            _FONT f
        END IF
 
        IF x = 7 THEN y = y + 1
    NEXT
END SUB
 
 
FUNCTION NumberOfDays (month, year)
    SELECT CASE month
        CASE 1, 3, 5, 7, 8, 10, 12: NumberOfDays = 31
        CASE 2: IF IsLeapYear(year) THEN NumberOfDays = 29 ELSE NumberOfDays = 28
        CASE 4, 6, 9, 11: NumberOfDays = 30
    END SELECT
END SUB
 
 
FUNCTION IsLeapYear (yyyy) 'use 4 digit year
    IF GetDay(2, 29, yyyy) <> GetDay(3, 1, yyyy) THEN IsLeapYear = -1
END FUNCTION
 
FUNCTION GetDay (m, d, y) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    mm = m: dd = d: yyyy = y
    IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
    century = yyyy MOD 100
    zerocentury = yyyy \ 100
    result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
    IF result = 0 THEN
        GetDay = 7
    ELSE
        GetDay = result
    END IF
    'Function changed to return a numeric value instead of a string for this program
    '    SELECT CASE result
    '        CASE 7: GetDay$ = "Saturday"
    '        CASE 1: GetDay$ = "Sunday"
    '        CASE 2: GetDay$ = "Monday"
    '        CASE 3: GetDay$ = "Tuesday"
    '        CASE 4: GetDay$ = "Wednesday"
    '        CASE 5: GetDay$ = "Thursday"
    '        CASE 6: GetDay$ = "Friday"
    '    END SELECT
END FUNCTION
 

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

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

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

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

SMcNeill · « **Reply #1 on:** December 24, 2020, 06:48:10 pm »

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

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

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

Richard Frost · « **Reply #2 on:** December 25, 2020, 03:13:23 am »

Code: QB64: [Select]

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

SMcNeill · « **Reply #3 on:** December 25, 2020, 10:46:51 pm »

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

Code: QB64: [Select]

CONST ShowGrid = -1
CONST ShowYear = 0
CONST DesiredYear = 2021
CONST ShowDays = -1
$COLOR:32
 
SCREEN _NEWIMAGE(1600, 720, 32)
_PRINTMODE _KEEPBACKGROUND
RANDOMIZE TIMER
 
 
TYPE Sun_Data_type
    field AS STRING
    value AS STRING
END TYPE
 
REDIM SHARED Sun(0) AS Sun_Data_type
DIM SHARED f: f = _LOADFONT("OLDENGL.ttf", 72)
DIM SHARED f1: f1 = _LOADFONT("OLDENGL.ttf", 32)
DIM SHARED ThisMonth, Today, ThisYear
DIM SHARED BackGrounds(1 TO 12)
DIM Lat AS _FLOAT, Lon AS _FLOAT
 
ThisMonth = VAL(DATE$)
Today = VAL(MID$(DATE$, 4))
ThisYear = VAL(RIGHT$(DATE$, 4))
 
Lat_Long Lat, Lon, 0 'get latitude and longitude, but no need to force them to redownload over and over,
'                     if we already have them saved on the disk.
 
SunStuff Lat, Lon, ThisMonth, Today, ThisYear
 
TitleScreen
 
IF ShowYear THEN
    FOR i = 1 TO 12
        CLS , SkyBlue
        _PUTIMAGE (0, 0)-(1283, 720), BackGrounds(i)
        IF ShowGrid THEN DrawLines
        CenterMonth i, DesiredYear
        DrawDays i, DesiredYear
        ShowDailyStuff Lat, Lon
        SLEEP
    NEXT
ELSE
    CLS , SkyBlue
    _PUTIMAGE (0, 0)-(1283, 720), BackGrounds(1)
    IF ShowGrid THEN DrawLines
    CenterMonth ThisMonth, ThisYear
    DrawDays ThisMonth, ThisYear
    ShowDailyStuff Lat, Lon
    SLEEP
END IF
SYSTEM
 
 
 
SUB ShowDailyStuff (Lat AS _FLOAT, Lon AS _FLOAT)
    _FONT f1
    COLOR Black
    LINE (1320, 50)-(1560, 500), Gold, BF
 
    cp = 1280 + (1600 - 1280) \ 2 'center of our non-calendar area
    t$ = ConvertToDay(GetDay(ThisMonth, Today, ThisYear)): _PRINTSTRING (cp - _PRINTWIDTH(t$) \ 2, 60), t$
    t$ = DATE$: _PRINTSTRING (cp - _PRINTWIDTH(t$) \ 2, 95), t$
    _FONT 16
    t$ = "For Lat/Long:" + STR$(INT(100 * Lat) / 100) + "," + STR$(INT(100 * Lon) / 100)
    _PRINTSTRING (1325, 130), t$
    _PRINTSTRING (1325, 156), "Sun Rise  : " + Sun(1).value
    _PRINTSTRING (1325, 174), "Sun Set   : " + Sun(2).value
    _PRINTSTRING (1325, 192), "Solar Noon: " + Sun(3).value
    _PRINTSTRING (1325, 210), "Day Length: " + Sun(4).value
    _PRINTSTRING (1325, 228), "Moon Phase:" + MoonPhase$(month, day, year)
    COLOR White
    _FONT f
    EXIT SUB
END SUB
 
 
 
 
 
SUB TitleScreen
    _TITLE "Steve's Calendar"
    CLS , SkyBlue
    _FONT f
    text$ = "Steve's Calendar"
    pw = _PRINTWIDTH(text$) \ 2
    _PRINTSTRING (640 - pw, 200), text$
    IF ShowYear THEN
        text$ = _TRIM$(STR$(DesiredYear))
    ELSE
        text$ = _TRIM$(STR$(ThisYear))
    END IF
    pw = _PRINTWIDTH(text$) \ 2
    _PRINTSTRING (640 - pw, 300), text$
    GetBackgrounds
    _FONT 16
    COLOR Black
    text$ = "Press <ANY KEY> to continue."
    pw = _PRINTWIDTH(text$) \ 2
    _PRINTSTRING (640 - pw, 400), text$
    COLOR White
    _FONT f
    SLEEP 2
END SUB
 
 
SUB GetHolidays (month, day, holiday() AS STRING)
    REDIM holiday(0) AS STRING
    SELECT CASE month
        CASE 1
            SELECT CASE day
                CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "New Years Day"
                CASE 6: REDIM holiday(1) AS STRING: holiday(1) = "Epiphany"
            END SELECT
        CASE 2
            SELECT CASE day
                CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "Black History Month"
                CASE 2: REDIM holiday(1) AS STRING: holiday(1) = "Groundhog Day"
                CASE 14: REDIM holiday(1) AS STRING: holiday(1) = "Valentine's Day"
            END SELECT
        CASE 3
            SELECT CASE day
                CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "Women's History Month"
            END SELECT
        CASE 4
            SELECT CASE day
                CASE 15: REDIM holiday(1) AS STRING: holiday(1) = "Tax Day"
            END SELECT
        CASE 5
            SELECT CASE day
            END SELECT
        CASE 6
            SELECT CASE day
            END SELECT
        CASE 7
            SELECT CASE day
                CASE 4: REDIM holiday(1) AS STRING: holiday(1) = "Independence Day"
            END SELECT
        CASE 8
            SELECT CASE day
            END SELECT
        CASE 9
            SELECT CASE day
                CASE 25: REDIM holiday(1) AS STRING: holiday(1) = "Steve's Birthday"
            END SELECT
        CASE 10
            SELECT CASE day
                CASE 31: REDIM holiday(1) AS STRING: holiday(1) = "Halloween"
            END SELECT
        CASE 11
            SELECT CASE day
                CASE 1: REDIM holiday(1) AS STRING: holiday(1) = "All Saint's Day"
                CASE 2: REDIM holiday(1) AS STRING: holiday(1) = "All Soul's Day"
                CASE 11: REDIM holiday(1) AS STRING: holiday(1) = "Vetern's Day"
            END SELECT
        CASE 12
            SELECT CASE day
                CASE 7: REDIM holiday(1) AS STRING: holiday(1) = "Pearl Harbor Remembrance"
                CASE 24: REDIM holiday(1) AS STRING: holiday(1) = "Christmas Eve"
                CASE 25: REDIM holiday(1) AS STRING: holiday(1) = "Christmas"
                CASE ELSE: REDIM holiday(0) AS STRING
            END SELECT
    END SELECT
END SUB
 
 
SUB GetBackgrounds
    IF ShowYear THEN limit = 12 ELSE limit = 1
    FOR i = 1 TO limit
        redo:
        t = INT(RND * 1088) + 1
        FOR j = 1 TO i
            IF BackGrounds(j) = t GOTO redo
            t$ = ".\Backgrounds\" + _TRIM$(STR$(t)) + ".jpg"
            t1 = _LOADIMAGE(t$, 32)
            IF t1 = -1 THEN GOTO redo
        NEXT
        BackGrounds(i) = t1
    NEXT
END SUB
 
SUB CenterMonth (month, year)
    _FONT f
    SELECT CASE month
        CASE 1: text$ = "January"
        CASE 2: text$ = "February"
        CASE 3: text$ = "March"
        CASE 4: text$ = "April"
        CASE 5: text$ = "May"
        CASE 6: text$ = "June"
        CASE 7: text$ = "July"
        CASE 8: text$ = "August"
        CASE 9: text$ = "September"
        CASE 10: text$ = "October"
        CASE 11: text$ = "November"
        CASE 12: text$ = "December"
    END SELECT
    text$ = text$ + STR$(year)
    pw = _PRINTWIDTH(text$) / 2
    _PRINTSTRING (640 - pw, 0), text$
END SUB
 
 
SUB DrawLines
    TopOffset = 72
 
    IF ShowDays THEN
        LINE (0, TopOffset)-STEP(1280, 3), _RGBA(128, 128, 64, 160), BF
        FOR i = 0 TO 7
            LINE (i * 1280 / 7, 0 + TopOffset)-STEP(3, 40), _RGBA32(128, 128, 64, 160), BF
        NEXT
        TopOffset = TopOffset + 40
    END IF
    FOR i = 0 TO 6
        LINE (0, i * 90 + TopOffset)-STEP(1280, 3), _RGBA32(128, 128, 64, 160), BF
    NEXT
    FOR i = 0 TO 7
        LINE (i * 1280 / 7, 0 + TopOffset)-STEP(3, 540), _RGBA32(128, 128, 64, 160), BF
    NEXT
END SUB
 
FUNCTION ConvertToDay$ (day) 'Function to return a string for a day
    SELECT CASE day
        CASE 1: ConvertToDay$ = "Sunday"
        CASE 2: ConvertToDay$ = "Monday"
        CASE 3: ConvertToDay$ = "Tuesday"
        CASE 4: ConvertToDay$ = "Wednesday"
        CASE 5: ConvertToDay$ = "Thursday"
        CASE 6: ConvertToDay$ = "Friday"
        CASE 7: ConvertToDay$ = "Saturday"
    END SELECT
END FUNCTION
 
SUB DrawDays (month, year)
    SHARED highlightday
    REDIM Holidays(0) AS STRING
    TopOffset = 76
    IF ShowDays THEN
        _FONT f1
        bw = 1280 \ 7
        FOR i = 1 TO 7
            t$ = ConvertToDay(i)
            pw = _PRINTWIDTH(t$) \ 2
            _PRINTSTRING (bw * (i - 1) + bw \ 2 - pw, 80), t$
        NEXT
        TopOffset = TopOffset + 40
        _FONT f
    END IF
 
    nod = NumberOfDays(month, year)
    y = 0
    FOR i = 1 TO nod
        text$ = _TRIM$(STR$(i))
        pw = _PRINTWIDTH(text$)
        x = GetDay(month, i, year)
        IF month = ThisMonth AND i = Today AND ThisYear = year THEN LINE ((x - 1) * 1280 / 7 + 3, y * 90 + TopOffset)-STEP(1280 / 7 - 3, 86), _RGBA32(128, 128, 128, 128), BF
        _PRINTSTRING (x * 1280 / 7 - pw, y * 90 + TopOffset), text$
        GetHolidays month, i, Holidays()
        u = UBOUND(holidays)
        IF u > 0 THEN
            _FONT 8
            FOR j = 1 TO u
                pw = _PRINTWIDTH(Holidays(j))
                _PRINTSTRING ((x - 1) * 1280 / 7 + 4, (y + 1) * 90 + TopOffset - 5 - j * 8), Holidays(j)
            NEXT
            _FONT f
        END IF
 
        IF x = 7 THEN y = y + 1
    NEXT
END SUB
 
 
FUNCTION NumberOfDays (month, year)
    SELECT CASE month
        CASE 1, 3, 5, 7, 8, 10, 12: NumberOfDays = 31
        CASE 2: IF IsLeapYear(year) THEN NumberOfDays = 29 ELSE NumberOfDays = 28
        CASE 4, 6, 9, 11: NumberOfDays = 30
    END SELECT
END SUB
 
 
FUNCTION IsLeapYear (yyyy) 'use 4 digit year
    IF GetDay(2, 29, yyyy) <> GetDay(3, 1, yyyy) THEN IsLeapYear = -1
END FUNCTION
 
FUNCTION GetDay (m, d, y) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    mm = m: dd = d: yyyy = y
    IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
    century = yyyy MOD 100
    zerocentury = yyyy \ 100
    result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
    IF result = 0 THEN
        GetDay = 7
    ELSE
        GetDay = result
    END IF
    'Function changed to return a numeric value instead of a string for this program
    '    SELECT CASE result
    '        CASE 7: GetDay$ = "Saturday"
    '        CASE 1: GetDay$ = "Sunday"
    '        CASE 2: GetDay$ = "Monday"
    '        CASE 3: GetDay$ = "Tuesday"
    '        CASE 4: GetDay$ = "Wednesday"
    '        CASE 5: GetDay$ = "Thursday"
    '        CASE 6: GetDay$ = "Friday"
    '    END SELECT
END FUNCTION
 
 
FUNCTION GetPublicIP$ (force)
    STATIC f
    IF force = -1 OR _FILEEXISTS("PIP.txt") = 0 THEN
        OPEN "PIP.txt" FOR OUTPUT AS #f: CLOSE f
        SHELL _HIDE "cmd /c nslookup myip.opendns.com resolver1.opendns.com>tempPIP.txt"
    END IF
    f = FREEFILE
    OPEN "tempPIP.txt" FOR INPUT AS #f
    IF LOF(f) THEN
        DO
            LINE INPUT #f, temp$
            IF temp$ <> "" THEN last$ = temp$ 'there's a blank line after the data we need.
            '                                 Ignore it.  What we want is the last line of info generated here.
        LOOP UNTIL EOF(1)
        l = _INSTRREV(last$, "Address:")
        IF l THEN GetPublicIP$ = MID$(last$, l + 10)
    END IF
    CLOSE f
 
END FUNCTION
 
SUB Lat_Long (lat AS _FLOAT, lon AS _FLOAT, force)
    STATIC f
    ip$ = GetPublicIP$(0)
    IF force = -1 OR _FILEEXISTS("LatAndLong.txt") = 0 THEN
        DownloadURL "ip-api.com/line/" + ip$ + "?fields=lat,lon", "LatAndLong.txt"
    END IF
    f = FREEFILE
    OPEN "LatAndLong.txt" FOR INPUT AS #f
    IF LOF(f) = 0 THEN CLOSE f: EXIT SUB 'something didn't download.  this info isn't available to parse.
    INPUT #f, lat
    INPUT #f, lon
    CLOSE f
END SUB
 
SUB DownloadURL (link$, file$)
    STATIC f
    f = FREEFILE
    OPEN file$ FOR OUTPUT AS #f: CLOSE #f 'erase any old file of the same name
    $IF WIN THEN
        out$ = "powershell.exe -c " + CHR$(34) + "Invoke-Webrequest '" + link$ + "' -OutFile '" + file$ + "'" + CHR$(34)
    $ELSE
        out$ = "wget " + chr$(34) + link$ + " -O " + file$ + chr$(34)
    $END IF
    SHELL _HIDE out$
END SUB
 
FUNCTION GetHour (fromTime$) 'time should be hh:mm:ss WhateverM
    l = INSTR(fromTime$, ":") '1st :
    GetHour = VAL(LEFT$(fromTime$, l))
END SUB
 
FUNCTION GetMinute (fromTime$) 'time should be hh:mm:ss WhateverM
    l = INSTR(fromTime$, ":") '1st :
    GetMinute = VAL(MID$(fromTime$, l + 1))
END SUB
 
 
FUNCTION GetSecond (fromTime$) 'time should be hh:mm:ss WhateverM
    l = INSTR(fromTime$, ":") '1st :
    l = INSTR(l + 1, fromTime$, ":") '2nd :
    GetSecond = VAL(MID$(fromTime$, l + 1))
END SUB
 
 
FUNCTION GetTimeOffset
    $IF WIN THEN
        TYPE SYSTEMTIME
            wYear AS _UNSIGNED INTEGER
            wMonth AS _UNSIGNED INTEGER
            wDayOfWeek AS _UNSIGNED INTEGER
            wDay AS _UNSIGNED INTEGER
            wHour AS _UNSIGNED INTEGER
            wMinute AS _UNSIGNED INTEGER
            wSecond AS _UNSIGNED INTEGER
            wMilliseconds AS _UNSIGNED INTEGER
        END TYPE
 
        TYPE TIME_ZONE_INFORMATION
            Bias AS LONG
            StandardName AS STRING * 64 'WCHAR      StandardName[32];
            StandardDate AS SYSTEMTIME
            StandardBias AS LONG
            DaylightName AS STRING * 64 'WCHAR      DaylightName[32];
            DaylightDate AS SYSTEMTIME
            DaylightBias AS LONG
        END TYPE
 
        DECLARE DYNAMIC LIBRARY "Kernel32"
            SUB GetTimeZoneInformation (t AS TIME_ZONE_INFORMATION)
        END DECLARE
 
        DIM t AS TIME_ZONE_INFORMATION
        GetTimeZoneInformation t
        GetTimeOffset = t.Bias
    $END IF
END SUB
 
 
 
SUB SunStuff (lat, lon, month, day, year)
    STATIC f
    d$ = _TRIM$(STR$(year)) + _TRIM$(STR$(month)) + _TRIM$(STR$(day))
    link$ = "https://api.sunrise-sunset.org/json?lat=" + _TRIM$(STR$(lat)) + "&lng="
    link$ = link$ + _TRIM$(STR$(lon)) + "&date=" + d$
    DownloadURL link$, "temp.txt"
    f = FREEFILE
    OPEN "temp.txt" FOR BINARY AS #f
 
    IF LOF(f) = 0 THEN CLOSE f: EXIT SUB 'something didn't download.  this info isn't available to parse.
 
    t$ = SPACE$(LOF(f))
    GET #1, 1, t$
    CLOSE f
 
    'strip off unwanted stuff
    l = INSTR(t$, ":{"): t$ = MID$(t$, l + 2) 'junk left of our initial data
    DO
        l = INSTR(t$, CHR$(34))
        t$ = LEFT$(t$, l - 1) + MID$(t$, l + 1) 'remove all quotes completely from this data
    LOOP UNTIL l = 0
    DO
        l = INSTR(t$, "_")
        t$ = LEFT$(t$, l - 1) + " " + MID$(t$, l + 1) 'change all underscores to spaces in this data
    LOOP UNTIL l = 0
    t$ = _TRIM$(t$)
    t$ = LEFT$(t$, LEN(t$) - 12) 'remove the last end of data }
    PRINT t$
 
    'parse it down to field, data
    DO
        l = INSTR(t$, ",")
        IF l = 0 THEN EXIT DO
        count = count + 1
        REDIM _PRESERVE Sun(count) AS Sun_Data_type
        whole$ = LEFT$(t$, l)
        Sun(count).field = LEFT$(whole$, INSTR(whole$, ":") - 1)
        r$ = MID$(whole$, INSTR(whole$, ":") + 1)
        r$ = LEFT$(r$, LEN(r$) - 1)
        IF RIGHT$(r$, 1) = "M" THEN m$ = RIGHT$(r$, 3) ELSE m$ = ""
        h = GetHour(r$): m = GetMinute(r$): s = GetSecond(r$)
        IF m$ = " PM" AND h <> 12 THEN h = h + 12
        IF count <> 4 THEN
            h = h - GetTimeOffset / 60
            IF h < 0 THEN h = 24 + h 'adjust for AM/PM difference, if ever necessary
            IF h > 23 THEN h = h - 24 'adjust for AM/PM difference, if ever necessary
            SELECT CASE h
                CASE 0: h = 12: m$ = " AM"
                CASE 12: m$ = " PM"
                CASE IS > 12: h = h - 12: m$ = " PM"
                CASE ELSE: m$ = " AM"
            END SELECT
        END IF
        hour$ = _TRIM$(STR$(h)): IF LEN(hour$) = 1 THEN hour$ = "0" + hour$
        min$ = _TRIM$(STR$(m)): IF LEN(min$) = 1 THEN min$ = "0" + min$
        sec$ = _TRIM$(STR$(s)): IF LEN(sec$) = 1 THEN sec$ = "0" + sec$
        Sun(count).value = hour$ + ":" + min$ + ":" + sec$ + m$
        t$ = MID$(t$, l + 1)
    LOOP
END SUB
 
 
FUNCTION MoonPhase$ (month, day, year)
    DIM mooncycle AS _FLOAT
    DIM fullmoon AS _FLOAT, dp AS _FLOAT, sod AS _FLOAT
    mooncycle = 29.5305882 'days between moon rotations
    sod = 24 * 60 * 60 'number of seconds in a day
 
    m$ = _TRIM$(STR$(month))
    d$ = _TRIM$(STR$(day))
    y$ = _TRIM$(STR$(year))
    dt$ = m$ + "-" + d$ + "-" + y$
    guessmoon = TimeStamp(dt$, 23 * 3600 + 59 * 60 + 59) 'what is the moon at 11:59:59 PM
    fullmoon = TimeStamp("1-3-2020", 4 * 3600 + 46 * 60) ' full moon on 1-3-2020 at 4:46 AM UTC
    dp = (guessmoon - fullmoon) / sod 'days past our full moon
    r1 = dp - INT(dp / mooncycle) * mooncycle 'how far we are in repeating our rotation
    SELECT CASE r1
        CASE IS <= mooncycle / 4: MoonPhase$ = "1st Quarter"
        CASE IS <= mooncycle / 2: MoonPhase$ = "Full moon"
        CASE IS <= mooncycle * 3 / 4: MoonPhase$ = "3rd Quarter"
        CASE ELSE: MoonPhase$ = "New Moon"
    END SELECT
END FUNCTION
 
 
 
FUNCTION TimeStamp## (d$, t##) 'date and timer
    'Based on Unix Epoch time, which starts at year 1970.
    DIM l AS _INTEGER64, l1 AS _INTEGER64, m AS _INTEGER64
    DIM d AS _INTEGER64, y AS _INTEGER64, i AS _INTEGER64
    DIM s AS _FLOAT
 
    l = INSTR(d$, "-")
    l1 = INSTR(l + 1, d$, "-")
    m = VAL(LEFT$(d$, l))
    d = VAL(MID$(d$, l + 1))
    y = VAL(MID$(d$, l1 + 1))
    IF y < 1970 THEN 'calculate shit backwards
        SELECT CASE m 'turn the day backwards for the month
            CASE 1, 3, 5, 7, 8, 10, 12: d = 31 - d '31 days
            CASE 2: d = 28 - d 'special 28 or 29.
            CASE 4, 6, 9, 11: d = 30 - d '30 days
        END SELECT
        IF y MOD 4 = 0 AND m < 3 THEN 'check for normal leap year, and we're before it...
            d = d + 1 'assume we had a leap year, subtract another day
            IF y MOD 100 = 0 AND y MOD 400 <> 0 THEN d = d - 1 'not a leap year if year is divisible by 100 and not 400
        END IF
 
        'then count the months that passed after the current month
        FOR i = m + 1 TO 12
            SELECT CASE i
                CASE 2: d = d + 28
                CASE 3, 5, 7, 8, 10, 12: d = d + 31
                CASE 4, 6, 9, 11: d = d + 30
            END SELECT
        NEXT
 
        'we should now have the entered year calculated.  Now lets add in for each year from this point to 1970
        d = d + 365 * (1969 - y) '365 days per each standard year
        FOR i = 1968 TO y + 1 STEP -4 'from 1968 onwards,backwards, skipping the current year (which we handled previously in the FOR loop)
            d = d + 1 'subtract an extra day every leap year
            IF (i MOD 100) = 0 AND (i MOD 400) <> 0 THEN d = d - 1 'but skipping every year divisible by 100, but not 400
        NEXT
        s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
        TimeStamp## = -(s## + 24 * 60 * 60 - t##)
        EXIT FUNCTION
    ELSE
        y = y - 1970
    END IF
 
    FOR i = 1 TO m 'for this year,
        SELECT CASE i 'Add the number of days for each previous month passed
            CASE 1: d = d 'January doestn't have any carry over days.
            CASE 2, 4, 6, 8, 9, 11: d = d + 31
            CASE 3 'Feb might be a leap year
                IF (y MOD 4) = 2 THEN 'if this year is divisible by 4 (starting in 1972)
                    d = d + 29 'its a leap year
                    IF (y MOD 100) = 30 AND (y MOD 400) <> 30 THEN 'unless..
                        d = d - 1 'the year is divisible by 100, and not divisible by 400
                    END IF
                ELSE 'year not divisible by 4, no worries
                    d = d + 28
                END IF
            CASE 5, 7, 10, 12: d = d + 30
        END SELECT
    NEXT
    d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
    FOR i = 2 TO y - 1 STEP 4 'from 1972 onwards, skipping the current year (which we handled previously in the FOR loopp)
        d = d + 1 'add an extra day every leap year
        IF (i MOD 100) = 30 AND (i MOD 400) <> 30 THEN d = d - 1 'but skiping every year divisible by 100, but not 400
    NEXT
    s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
    TimeStamp## = (s## + t##)
END FUNCTION
 

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

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

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

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

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

SMcNeill · « **Reply #4 on:** December 26, 2020, 05:36:00 am »

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

Code: [Select]

Holidays are stored in the format:   MONTH, Modifier, Day, Name
01, ON, 01, New Years Day
01, ON, 06, Epiphany
01, ON, 07, Orthodox Christmas Day
01, ON, 13, Stephen Foster Memorial Day
01, ON, 14, Orthodox New Year
01, THIRD, Monday, Martin Luther King Day
02, ON, 01, National Freedom Day
02, ON, 01, Start of Black History Month
02, ON, 02, Groundhog's Day
02, FIRST, Sunday, Super Bowl
02, ON, 12, Lincoln's Birthday
02, ON, 14, Valentine's Day
02, THIRD, Monday, President's Day
03, ON, 01, Start of Women's History Month
03, SECOND, Sunday, Start of Daylight Saving's Time
03, ON, 17, Saint Patrick's Day
03, ON, 29, National Vietnam War Vetern's Day
05, SECOND, Sunday, Mother's Day
05, LAST, Monday, Memorial Day
06, THIRD, Sunday, Father's Day
07, ON, 04, Independence Day
07, ON, 15, Tax Day
09, FIRST, Monday, Labor Day
09, ON, 25, Steve McNeill's Birthday
10, ON, 31, Halloween
11, ON, 01, All Saint's Day
11, FIRST, Sunday, End of Daylight Saving's Time
11, ON, 02, All Soul's Day
11, ON, 11, Vetern's Day
11, FOURTH, Thursday, Thanksgiving
12, ON, 07, Pearl Harbor Remembrance Day
12, ON, 24, Christmas Eve
12, ON, 25, Christmas Day
12, ON, 31, New Year's Eve

There's a few things which I know I missed, which are like Black Friday -- Friday after Thanksgiving... Well, Thanksgiving is a moving target (fourth thursday in november), and Black Friday isn't necessarily the 4th friday in november. (For example, Nov 1st is a friday, then the first thursday would be on the 7th, and thanksgiving on the 28th... The 4th friday, in this case, would be on the 22nd...)

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

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

STxAxTIC · « **Reply #5 on:** December 26, 2020, 05:56:16 am »

Is it too soon to mention Easter?

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

SMcNeill · « **Reply #6 on:** December 26, 2020, 06:16:25 am »

Quote

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

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

SMcNeill · « **Reply #7 on:** December 26, 2020, 06:25:52 am »

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

Code: QB64: [Select]

SCREEN _NEWIMAGE(800, 600, 32)
 
TYPE Holiday_type
    month AS INTEGER
    day AS INTEGER
    name AS STRING
END TYPE
 
REDIM SHARED HolidayList(0) AS Holiday_type
 
 
GetHolidays 2021
FOR i = 1 TO UBOUND(HolidayList)
    PRINT HolidayList(i).month, HolidayList(i).day, HolidayList(i).name
NEXT
 
SUB GetHolidays (year)
    f = FREEFILE
    IF _FILEEXISTS("Holidays.txt") = 0 THEN 'if the file doesn't exist, then create it with our default data
        OPEN "Holidays.txt" FOR OUTPUT AS #f
        PRINT #f, "Holidays are stored in the format:   MONTH, Modifier, Day, Name"
        PRINT #f, "01, ON, 01, New Years Day"
        PRINT #f, "01, ON, 06, Epiphany"
        PRINT #f, "01, ON, 07, Orthodox Christmas Day"
        PRINT #f, "01, ON, 13, Stephen Foster Memorial Day"
        PRINT #f, "01, ON, 14, Orthodox New Year"
        PRINT #f, "01, THIRD, Monday, Martin Luther King Day"
        PRINT #f, "02, ON, 01, National Freedom Day"
        PRINT #f, "02, ON, 01, Start of Black History Month"
        PRINT #f, "02, ON, 02, Groundhog's Day"
        PRINT #f, "02, FIRST, Sunday, Super Bowl"
        PRINT #f, "02, ON, 12, Lincoln's Birthday"
        PRINT #f, "02, ON, 14, Valentine's Day"
        PRINT #f, "02, THIRD, Monday, President's Day"
        PRINT #f, "03, ON, 01, Start of Women's History Month"
        PRINT #f, "03, SECOND, Sunday, Start of Daylight Saving's Time"
        PRINT #f, "03, ON, 17, Saint Patrick's Day"
        PRINT #f, "03, ON, 29, National Vietnam War Vetern's Day"
        PRINT #f, "05, SECOND, Sunday, Mother's Day"
        PRINT #f, "05, LAST, Monday, Memorial Day"
        PRINT #f, "06, THIRD, Sunday, Father's Day"
        PRINT #f, "07, ON, 04, Independence Day"
        PRINT #f, "07, ON, 15, Tax Day"
        PRINT #f, "09, FIRST, Monday, Labor Day"
        PRINT #f, "09, ON, 25, Steve McNeill's Birthday"
        PRINT #f, "10, ON, 31, Halloween"
        PRINT #f, "11, ON, 01, All Saint's Day"
        PRINT #f, "11, FIRST, Sunday, End of Daylight Saving's Time"
        PRINT #f, "11, ON, 02, All Soul's Day"
        PRINT #f, "11, ON, 11, Vetern's Day"
        PRINT #f, "11, FOURTH, Thursday, Thanksgiving"
        PRINT #f, "12, ON, 07, Pearl Harbor Remembrance Day"
        PRINT #f, "12, ON, 24, Christmas Eve"
        PRINT #f, "12, ON, 25, Christmas Day"
        PRINT #f, "12, ON, 31, New Year's Eve"
        CLOSE f
    END IF
    OPEN "Holidays.txt" FOR INPUT AS #f
    LINE INPUT #f, junk$ 'first line is file comment and not related to the data
    DO UNTIL EOF(f)
        INPUT #f, month
        INPUT #f, event$: event$ = UCASE$(event$)
        INPUT #f, day$
        INPUT #f, nam$
        '  PRINT month, event$, day$, nam$
        count = count + 1
        REDIM _PRESERVE HolidayList(count) AS Holiday_type
        HolidayList(count).month = month
        IF event$ = "ON" THEN
            HolidayList(count).day = VAL(day$)
        ELSEIF event$ = "LAST" THEN 'we need to count backwards to find the last target day
            d = ConvertDayToNum(day$)
            FOR i = NumberOfDays(month, year) TO 1 STEP -1
                IF GetDay(month, i, year) = d THEN HolidayList(count).day = i: EXIT FOR
            NEXT
        ELSE 'we count forwards
            d = ConvertDayToNum(day$)
            FOR i = 1 TO NumberOfDays(month, year)
                IF GetDay(month, i, year) = d THEN EXIT FOR
            NEXT
            SELECT CASE event$
                CASE "FIRST": HolidayList(count).day = i
                CASE "SECOND": HolidayList(count).day = i + 7
                CASE "THIRD": HolidayList(count).day = i + 14
                CASE "FOURTH": HolidayList(count).day = i + 21
                CASE "FIFTH": HolidayList(count).day = i + 28
            END SELECT
        END IF
        HolidayList(count).name = nam$
    LOOP
END SUB
 
FUNCTION ConvertDayToNum (day$)
    SELECT CASE day$
        CASE "Sunday": ConvertDayToNum = 1
        CASE "Monday": ConvertDayToNum = 2
        CASE "Tuseday": ConvertDayToNum = 3
        CASE "Wednesday": ConvertDayToNum = 4
        CASE "Thursday": ConvertDayToNum = 5
        CASE "Friday": ConvertDayToNum = 6
        CASE "Saturday": ConvertDayToNum = 7
    END SELECT
END FUNCTION
 
 
FUNCTION GetDay (m, d, y) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    mm = m: dd = d: yyyy = y
    IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
    century = yyyy MOD 100
    zerocentury = yyyy \ 100
    result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
    IF result = 0 THEN
        GetDay = 7
    ELSE
        GetDay = result
    END IF
END FUNCTION
 
FUNCTION IsLeapYear (yyyy) 'use 4 digit year
    IF GetDay(2, 29, yyyy) <> GetDay(3, 1, yyyy) THEN IsLeapYear = -1
END FUNCTION
 
FUNCTION NumberOfDays (month, year)
    SELECT CASE month
        CASE 1, 3, 5, 7, 8, 10, 12: NumberOfDays = 31
        CASE 2: IF IsLeapYear(year) THEN NumberOfDays = 29 ELSE NumberOfDays = 28
        CASE 4, 6, 9, 11: NumberOfDays = 30
    END SELECT
END SUB

SMcNeill · « **Reply #8 on:** December 26, 2020, 08:46:24 pm »

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

Code: QB64: [Select]

CONST ShowGrid = -1
CONST ShowYear = 0
CONST DesiredYear = 2021
CONST ShowDays = -1
$COLOR:32
 
SCREEN _NEWIMAGE(1600, 720, 32)
_PRINTMODE _KEEPBACKGROUND
RANDOMIZE TIMER
 
 
TYPE Sun_Data_type
    field AS STRING
    value AS STRING
END TYPE
 
 
TYPE Holiday_type
    month AS INTEGER
    day AS INTEGER
    name AS STRING
END TYPE
 
REDIM SHARED Sun(0) AS Sun_Data_type
REDIM SHARED HolidayList(0) AS Holiday_type
 
DIM SHARED f72: f72 = _LOADFONT("OLDENGL.ttf", 72)
DIM SHARED f32: f32 = _LOADFONT("OLDENGL.ttf", 32)
DIM SHARED ThisMonth, Today, ThisYear
DIM SHARED BackGrounds(-12 TO 12)
DIM Lat AS _FLOAT, Lon AS _FLOAT
 
ThisMonth = VAL(DATE$)
Today = VAL(MID$(DATE$, 4))
ThisYear = VAL(RIGHT$(DATE$, 4))
 
Lat_Long Lat, Lon, 0 'get latitude and longitude, but no need to force them to redownload over and over,
'                     if we already have them saved on the disk.
 
SunStuff Lat, Lon, ThisMonth, Today, ThisYear
GetHolidays ThisYear
 
TitleScreen
 
 
update = -1
 
 
CurrentMonth = ThisMonth
CurrentDay = Today
Currentyear = ThisYear
 
DO
    IF update THEN
        CLS , SkyBlue
        reload: 'load our background
        IF bg >= -12 AND bg <= 12 THEN
            'We store 12 set backgrounds before and after our current month, which don't change.
            'But if we go any further than that, then we just use random backgrounds for extreme future events.
            'This is to give an impression of stability for most usage.
            'For example, I start up with an image of the moon on the screen for my current month.
            'I then scroll a few screens to see what is coming up in a few months, and then want to scroll back.
            'All I have to do is look for that visual cue of the image of the moon on my screen, as a quick reference guide.
 
            t$ = ".\Backgrounds\" + _TRIM$(STR$(BackGrounds(bg))) + ".jpg"
            t1 = _LOADIMAGE(t$, 32)
            IF t1 = -1 THEN 'if this is a bad background, then load a different one
                redo:
                t = INT(RND * 1088) + 1
                FOR j = 1 TO i
                    IF BackGrounds(j) = t GOTO redo
                    IF t1 = -1 THEN GOTO redo
                NEXT
                BackGrounds(i) = t
                GOTO reload
            END IF
        ELSE
            'But after a dozen months or so?  No need to keep those image handles in memory.  Just toss them,
            'as my poor memory couldn't store that much information anyway.  :P
 
            DO
                t$ = ".\Backgrounds\" + _TRIM$(STR$(INT(RND * 1088) + 1)) + ".jpg"
                t1 = _LOADIMAGE(t$, 32)
            LOOP UNTIL t1 < -1
        END IF
 
        _PUTIMAGE (0, 0)-(1283, 720), t1
        _FREEIMAGE t1
        IF ShowGrid THEN DrawLines
        CenterMonth CurrentMonth, Currentyear
        DrawDays CurrentMonth, Currentyear
        ShowDailyStuff Lat, Lon
        update = 0
    END IF
 
    k = _KEYHIT
    IF _KEYDOWN(100305) OR _KEYDOWN(100306) THEN
        SELECT CASE k
            CASE 19200 'left
                CurrentMonth = CurrentMonth - 1
                IF CurrentMonth < 1 THEN CurrentMonth = 12: Currentyear = Currentyear - 1
                bg = bg - 1
                update = -1
            CASE 19712 'right
                CurrentMonth = CurrentMonth + 1
                IF CurrentMonth > 12 THEN CurrentMonth = 1: Currentyear = Currentyear + 1
                bg = bg + 1
                update = -1
        END SELECT
    ELSE
        SELECT CASE k
            CASE 27 'ESC
                SYSTEM
        END SELECT
    END IF
 
    _LIMIT 30
    _DISPLAY
LOOP
 
 
 
 
SUB ShowDailyStuff (Lat AS _FLOAT, Lon AS _FLOAT)
    _FONT f32
    COLOR Black
    LINE (1320, 50)-(1560, 500), Gold, BF
 
    cp = 1280 + (1600 - 1280) \ 2 'center of our non-calendar area
    t$ = ConvertToDay(GetDay(ThisMonth, Today, ThisYear)): _PRINTSTRING (cp - _PRINTWIDTH(t$) \ 2, 60), t$
    t$ = DATE$: _PRINTSTRING (cp - _PRINTWIDTH(t$) \ 2, 95), t$
    _FONT 16
    t$ = "For Lat/Long:" + STR$(INT(100 * Lat) / 100) + "," + STR$(INT(100 * Lon) / 100)
    _PRINTSTRING (1325, 130), t$
    _PRINTSTRING (1325, 156), "Sun Rise  : " + Sun(1).value
    _PRINTSTRING (1325, 174), "Sun Set   : " + Sun(2).value
    _PRINTSTRING (1325, 192), "Solar Noon: " + Sun(3).value
    _PRINTSTRING (1325, 210), "Day Length: " + Sun(4).value
    _PRINTSTRING (1325, 228), "Moon Phase: " + MoonPhase$(month, day, year)
    COLOR White
    _FONT f72
    EXIT SUB
END SUB
 
 
 
 
 
SUB TitleScreen
    _TITLE "Steve's Calendar"
    CLS , SkyBlue
    _FONT f72
    text$ = "Steve's Calendar"
    pw = _PRINTWIDTH(text$) \ 2
    _PRINTSTRING (800 - pw, 200), text$
    IF ShowYear THEN
        text$ = _TRIM$(STR$(DesiredYear))
    ELSE
        text$ = _TRIM$(STR$(ThisYear))
    END IF
    pw = _PRINTWIDTH(text$) \ 2
    _PRINTSTRING (800 - pw, 300), text$
    GetBackgrounds
    _FONT 16
    COLOR Black
    text$ = "Press <ANY KEY> to continue."
    pw = _PRINTWIDTH(text$) \ 2
    _PRINTSTRING (800 - pw, 400), text$
    COLOR White
    _FONT f72
    SLEEP 2
END SUB
 
 
SUB GetHolidays (year)
 
 
    f1 = FREEFILE
    IF _FILEEXISTS("Holidays.txt") = 0 THEN 'if the file doesn't exist, then create it with our default data
        OPEN "Holidays.txt" FOR OUTPUT AS #f1
        PRINT #f1, "Holidays are stored in the format:   MONTH, Modifier, Day, Name"
        PRINT #f1, "01, ON, 01, New Years Day"
        PRINT #f1, "01, ON, 06, Epiphany"
        PRINT #f1, "01, ON, 07, Orthodox Christmas Day"
        PRINT #f1, "01, ON, 13, Stephen Foster Memorial Day"
        PRINT #f1, "01, ON, 14, Orthodox New Year"
        PRINT #f1, "01, THIRD, Monday, Martin Luther King Day"
        PRINT #f1, "02, ON, 01, National Freedom Day"
        PRINT #f1, "02, ON, 01, Start of Black History Month"
        PRINT #f1, "02, ON, 02, Groundhog's Day"
        PRINT #f1, "02, FIRST, Sunday, Super Bowl"
        PRINT #f1, "02, ON, 12, Lincoln's Birthday"
        PRINT #f1, "02, ON, 14, Valentine's Day"
        PRINT #f1, "02, THIRD, Monday, President's Day"
        PRINT #f1, "03, ON, 01, Start of Women's History Month"
        PRINT #f1, "03, SECOND, Sunday, Start of Daylight Saving's Time"
        PRINT #f1, "03, ON, 17, Saint Patrick's Day"
        PRINT #f1, "03, ON, 29, National Vietnam War Vetern's Day"
        PRINT #f1, "05, SECOND, Sunday, Mother's Day"
        PRINT #f1, "05, LAST, Monday, Memorial Day"
        PRINT #f1, "06, THIRD, Sunday, Father's Day"
        PRINT #f1, "07, ON, 04, Independence Day"
        PRINT #f1, "07, ON, 15, Tax Day"
        PRINT #f1, "09, FIRST, Monday, Labor Day"
        PRINT #f1, "09, ON, 25, Steve McNeill's Birthday"
        PRINT #f1, "10, ON, 31, Halloween"
        PRINT #f1, "11, ON, 01, All Saint's Day"
        PRINT #f1, "11, FIRST, Sunday, End of Daylight Saving's Time"
        PRINT #f1, "11, ON, 02, All Soul's Day"
        PRINT #f1, "11, ON, 11, Vetern's Day"
        PRINT #f1, "11, FOURTH, Thursday, Thanksgiving"
        PRINT #f1, "12, ON, 07, Pearl Harbor Remembrance Day"
        PRINT #f1, "12, ON, 24, Christmas Eve"
        PRINT #f1, "12, ON, 25, Christmas Day"
        PRINT #f1, "12, ON, 31, New Year's Eve"
        CLOSE f1
    END IF
    OPEN "Holidays.txt" FOR INPUT AS #f1
    LINE INPUT #f1, junk$ 'first line is file comment and not related to the data
    DO UNTIL EOF(f1)
        INPUT #f1, month
        INPUT #f1, event$: event$ = UCASE$(event$)
        INPUT #f1, day$
        INPUT #f1, nam$
        '  PRINT month, event$, day$, nam$
        count = count + 1
        REDIM _PRESERVE HolidayList(count) AS Holiday_type
        HolidayList(count).month = month
        IF event$ = "ON" THEN
            HolidayList(count).day = VAL(day$)
        ELSEIF RIGHT$(event$, 4) = "LAST" THEN 'we need to count backwards to find the last target day
            d = ConvertDayToNum(day$)
            FOR i = NumberOfDays(month, year) TO 1 STEP -1
                IF GetDay(month, i, year) = d THEN EXIT FOR
            NEXT
            SELECT CASE event$
                CASE "LAST": HolidayList(count).day = i
                CASE "SECOND TO LAST": HolidayList(count).day = i - 7
                CASE "THIRD TO LAST": HolidayList(count).day = i - 14
                CASE "FOURTH TO LAST": HolidayList(count).day = i - 21
                CASE "FIFTH TO LAST": HolidayList(count).day = i - 28
            END SELECT
        ELSE 'we count forwards
            d = ConvertDayToNum(day$)
            FOR i = 1 TO NumberOfDays(month, year)
                IF GetDay(month, i, year) = d THEN EXIT FOR
            NEXT
            SELECT CASE event$
                CASE "FIRST": HolidayList(count).day = i
                CASE "SECOND": HolidayList(count).day = i + 7
                CASE "THIRD": HolidayList(count).day = i + 14
                CASE "FOURTH": HolidayList(count).day = i + 21
                CASE "FIFTH": HolidayList(count).day = i + 28
            END SELECT
        END IF
        HolidayList(count).name = nam$
 
 
        '*******************************************************************
        '**   Special Exceptions for days which are hard to calculate otherwise
        '*******************************************************************
 
        IF HolidayList(count).name = "Thanksgiving" THEN 'Add Black Friday and Cyber Monday
            d = HolidayList(count).day
            count = count + 2
            REDIM _PRESERVE HolidayList(count) AS Holiday_type
            HolidayList(count - 1).month = 11
            HolidayList(count - 1).day = d + 1
            HolidayList(count - 1).name = "Black Fridy"
            d = HolidayList(count - 1).day + 4
            HolidayList(count).month = 11
            IF d > 30 THEN d = d - 30: HolidayList(count).month = 12
            HolidayList(count).day = d
            HolidayList(count).name = "Cyber Monday"
        END IF
    LOOP
    CLOSE #f1
 
    '*******************************************************************
    '**   Seasons, which are on a simple look-up table
    '*******************************************************************
    IF _FILEEXISTS("Seasons.txt") = 0 THEN
        OPEN "Seasons.txt" FOR OUTPUT AS #f1
        PRINT #f1, "2016, 20, Mar, 04:30 GMT, 20, Jun, 23:34 BST, 22, Sep, 15:21 BST, 21, Dec, 10:44 GMT"
        PRINT #f1, "2017, 20, Mar, 10:29 GMT, 21, Jun, 05:24 BST, 22, Sep, 21:02 BST, 21, Dec, 16:28 GMT"
        PRINT #f1, "2018, 20, Mar, 16:15 GMT, 21, Jun, 11:07 BST, 23, Sep, 02:54 BST, 21, Dec, 22:23 GMT"
        PRINT #f1, "2019, 20, Mar, 21:59 GMT, 21, Jun, 16:54 BST, 23, Sep, 08:50 BST, 22, Dec, 04:19 GMT"
        PRINT #f1, "2020, 20, Mar, 03:50 GMT, 20, Jun, 22:44 BST, 22, Sep, 14:31 BST, 21, Dec, 10:02 GMT"
        PRINT #f1, "2021, 20, Mar, 09:37 GMT, 21, Jun, 04:32 BST, 22, Sep, 20:21 BST, 21, Dec, 15:59 GMT"
        PRINT #f1, "2022, 20, Mar, 15:33 GMT, 21, Jun, 10:14 BST, 23, Sep, 02:04 BST, 21, Dec, 21:48 GMT"
        PRINT #f1, "2023, 20, Mar, 21:24 GMT, 21, Jun, 15:58 BST, 23, Sep, 07:50 BST, 22, Dec, 03:27 GMT"
        PRINT #f1, "2024, 20, Mar, 03:06 GMT, 20, Jun, 21:51 BST, 22, Sep, 13:43 BST, 21, Dec, 09:20 GMT"
        PRINT #f1, "2025, 20, Mar, 09:01 GMT, 21, Jun, 03:42 BST, 22, Sep, 19:19 BST, 21, Dec, 15:03 GMT"
        PRINT #f1, "2026, 20, Mar, 14:46 GMT, 21, Jun, 09:24 BST, 23, Sep, 01:05 BST, 21, Dec, 20:50 GMT"
        PRINT #f1, "2027, 20, Mar, 20:25 GMT, 21, Jun, 15:11 BST, 23, Sep, 07:02 BST, 22, Dec, 02:42 GMT"
        PRINT #f1, "2028, 20, Mar, 02:17 GMT, 20, Jun, 21:02 BST, 22, Sep, 12:45 BST, 21, Dec, 08:20 GMT"
        PRINT #f1, "2029, 20, Mar, 08:02 GMT, 21, Jun, 02:48 BST, 22, Sep, 18:38 BST, 21, Dec, 14:14 GMT"
        PRINT #f1, "2030, 20, Mar, 13:52 GMT, 21, Jun, 08:31 BST, 23, Sep, 00:27 BST, 21, Dec, 20:09 GMT"
        PRINT #f1, "2031, 20, Mar, 19:41 GMT, 21, Jun, 14:17 BST, 23, Sep, 06:15 BST, 22, Dec, 01:55 GMT"
        PRINT #f1, "2032, 20, Mar, 01:22 GMT, 20, Jun, 20:09 BST, 22, Sep, 12:11 BST, 21, Dec, 07:56 GMT"
        PRINT #f1, "2033, 20, Mar, 07:23 GMT, 21, Jun, 02:01 BST, 22, Sep, 17:51 BST, 21, Dec, 13:46 GMT"
        PRINT #f1, "2034, 20, Mar, 13:17 GMT, 21, Jun, 07:44 BST, 22, Sep, 23:39 BST, 21, Dec, 19:34 GMT"
        PRINT #f1, "2035, 20, Mar, 19:02 GMT, 21, Jun, 13:33 BST, 23, Sep, 05:39 BST, 22, Dec, 01:31 GMT"
        PRINT #f1, "2036, 20, Mar, 01:03 GMT, 20, Jun, 19:32 BST, 22, Sep, 11:23 BST, 21, Dec, 07:13 GMT"
        PRINT #f1, "2037, 20, Mar, 06:50 GMT, 21, Jun, 01:22 BST, 22, Sep, 17:13 BST, 21, Dec, 13:08 GMT"
        PRINT #f1, "2038, 20, Mar, 12:41 GMT, 21, Jun, 07:09 BST, 22, Sep, 23:02 BST, 21, Dec, 19:02 GMT"
        PRINT #f1, "2039, 20, Mar, 18:32 GMT, 21, Jun, 12:57 BST, 23, Sep, 04:49 BST, 22, Dec, 00:40 GMT"
        PRINT #f1, "2040, 20, Mar, 00:11 GMT, 20, Jun, 18:46 BST, 22, Sep, 10:45 BST, 21, Dec, 06:33 GMT"
        PRINT #f1, "2041, 20, Mar, 06:07 GMT, 21, Jun, 00:36 BST, 22, Sep, 16:26 BST, 21, Dec, 12:18 GMT"
        PRINT #f1, "2042, 20, Mar, 11:53 GMT, 21, Jun, 06:16 BST, 22, Sep, 22:11 BST, 21, Dec, 18:04 GMT"
        PRINT #f1, "2043, 20, Mar, 17:28 GMT, 21, Jun, 11:58 BST, 23, Sep, 04:07 BST, 22, Dec, 00:01 GMT"
        PRINT #f1, "2044, 19, Mar, 23:20 GMT, 20, Jun, 17:51 BST, 22, Sep, 09:48 BST, 21, Dec, 05:43 GMT"
        PRINT #f1, "2045, 20, Mar, 05:07 GMT, 20, Jun, 23:34 BST, 22, Sep, 15:33 BST, 21, Dec, 11:35 GMT"
        PRINT #f1, "2046, 20, Mar, 10:58 GMT, 21, Jun, 05:14 BST, 22, Sep, 21:21 BST, 21, Dec, 17:28 GMT"
        PRINT #f1, "2047, 20, Mar, 16:52 GMT, 21, Jun, 11:03 BST, 23, Sep, 03:08 BST, 21, Dec, 23:07 GMT"
        PRINT #f1, "2048, 19, Mar, 22:34 GMT, 20, Jun, 16:54 BST, 22, Sep, 09:00 BST, 21, Dec, 05:02 GMT"
        PRINT #f1, "2049, 20, Mar, 04:28 GMT, 20, Jun, 22:47 BST, 22, Sep, 14:42 BST, 21, Dec, 10:52 GMT"
        PRINT #f1, "2050, 20, Mar, 10:19 GMT, 21, Jun, 04:33 BST, 22, Sep, 20:28 BST, 21, Dec, 16:38 GMT"
        PRINT #f1, "2051, 20, Mar, 15:59 GMT, 21, Jun, 10:18 BST, 23, Sep, 02:27 BST, 21, Dec, 22:34 GMT"
        PRINT #f1, "2052, 19, Mar, 21:56 GMT, 20, Jun, 16:16 BST, 22, Sep, 08:15 BST, 21, Dec, 04:17 GMT"
        PRINT #f1, "2053, 20, Mar, 03:47 GMT, 20, Jun, 22:04 BST, 22, Sep, 14:06 BST, 21, Dec, 10:10 GMT"
        PRINT #f1, "2054, 20, Mar, 09:34 GMT, 21, Jun, 03:47 BST, 22, Sep, 19:59 BST, 21, Dec, 16:10 GMT"
        PRINT #f1, "2055, 20, Mar, 15:28 GMT, 21, Jun, 09:40 BST, 23, Sep, 01:48 BST, 21, Dec, 21:55 GMT"
        PRINT #f1, "2056, 19, Mar, 21:11 GMT, 20, Jun, 15:28 BST, 22, Sep, 07:39 BST, 21, Dec, 03:51 GMT"
        PRINT #f1, "2057, 20, Mar, 03:08 GMT, 20, Jun, 21:19 BST, 22, Sep, 13:23 BST, 21, Dec, 09:43 GMT"
        PRINT #f1, "2058, 20, Mar, 09:05 GMT, 21, Jun, 03:04 BST, 22, Sep, 19:08 BST, 21, Dec, 15:25 GMT"
        PRINT #f1, "2059, 20, Mar, 14:44 GMT, 21, Jun, 08:47 BST, 23, Sep, 01:03 BST, 21, Dec, 21:18 GMT"
        PRINT #f1, "2060, 19, Mar, 20:38 GMT, 20, Jun, 14:45 BST, 22, Sep, 06:48 BST, 21, Dec, 03:01 GMT"
        PRINT #f1, "2061, 20, Mar, 02:26 GMT, 20, Jun, 20:32 BST, 22, Sep, 12:31 BST, 21, Dec, 08:49 GMT"
        PRINT #f1, "2062, 20, Mar, 08:07 GMT, 21, Jun, 02:11 BST, 22, Sep, 18:20 BST, 21, Dec, 14:42 GMT"
        PRINT #f1, "2063, 20, Mar, 13:59 GMT, 21, Jun, 08:02 BST, 23, Sep, 00:08 BST, 21, Dec, 20:21 GMT"
        PRINT #f1, "2064, 19, Mar, 19:38 GMT, 20, Jun, 13:45 BST, 22, Sep, 05:57 BST, 21, Dec, 02:09 GMT"
        PRINT #f1, "2065, 20, Mar, 01:28 GMT, 20, Jun, 19:32 BST, 22, Sep, 11:42 BST, 21, Dec, 08:00 GMT"
        PRINT #f1, "2066, 20, Mar, 07:20 GMT, 21, Jun, 01:16 BST, 22, Sep, 17:27 BST, 21, Dec, 13:45 GMT"
        PRINT #f1, "2067, 20, Mar, 12:53 GMT, 21, Jun, 06:56 BST, 22, Sep, 23:19 BST, 21, Dec, 19:43 GMT"
        PRINT #f1, "2068, 19, Mar, 18:49 GMT, 20, Jun, 12:53 BST, 22, Sep, 05:07 BST, 21, Dec, 01:32 GMT"
        PRINT #f1, "2069, 20, Mar, 00:45 GMT, 20, Jun, 18:41 BST, 22, Sep, 10:51 BST, 21, Dec, 07:22 GMT"
        PRINT #f1, "2070, 20, Mar, 06:34 GMT, 21, Jun, 00:22 BST, 22, Sep, 16:45 BST, 21, Dec, 13:19 GMT"
        PRINT #f1, "2071, 20, Mar, 12:34 GMT, 21, Jun, 06:21 BST, 22, Sep, 22:37 BST, 21, Dec, 19:04 GMT"
        PRINT #f1, "2072, 19, Mar, 18:21 GMT, 20, Jun, 12:13 BST, 22, Sep, 04:27 BST, 21, Dec, 00:56 GMT"
        PRINT #f1, "2073, 20, Mar, 00:13 GMT, 20, Jun, 18:07 BST, 22, Sep, 10:15 BST, 21, Dec, 06:50 GMT"
        PRINT #f1, "2074, 20, Mar, 06:09 GMT, 20, Jun, 23:58 BST, 22, Sep, 16:03 BST, 21, Dec, 12:35 GMT"
        PRINT #f1, "2075, 20, Mar, 11:46 GMT, 21, Jun, 05:40 BST, 22, Sep, 21:59 BST, 21, Dec, 18:27 GMT"
        PRINT #f1, "2076, 19, Mar, 17:39 GMT, 20, Jun, 11:36 BST, 22, Sep, 03:50 BST, 21, Dec, 00:13 GMT"
        PRINT #f1, "2077, 19, Mar, 23:31 GMT, 20, Jun, 17:23 BST, 22, Sep, 09:36 BST, 21, Dec, 06:01 GMT"
        PRINT #f1, "2078, 20, Mar, 05:11 GMT, 20, Jun, 22:58 BST, 22, Sep, 15:24 BST, 21, Dec, 11:58 GMT"
        PRINT #f1, "2079, 20, Mar, 11:00 GMT, 21, Jun, 04:49 BST, 22, Sep, 21:13 BST, 21, Dec, 17:44 GMT"
        PRINT #f1, "2080, 19, Mar, 16:44 GMT, 20, Jun, 10:34 BST, 22, Sep, 02:56 BST, 20, Dec, 23:33 GMT"
        PRINT #f1, "2081, 19, Mar, 22:34 GMT, 20, Jun, 16:16 BST, 22, Sep, 08:37 BST, 21, Dec, 05:22 GMT"
        PRINT #f1, "2082, 20, Mar, 04:30 GMT, 20, Jun, 22:03 BST, 22, Sep, 14:23 BST, 21, Dec, 11:04 GMT"
        PRINT #f1, "2083, 20, Mar, 10:10 GMT, 21, Jun, 03:44 BST, 22, Sep, 20:11 BST, 21, Dec, 16:53 GMT"
        PRINT #f1, "2084, 19, Mar, 15:59 GMT, 20, Jun, 09:40 BST, 22, Sep, 01:59 BST, 20, Dec, 22:41 GMT"
        PRINT #f1, "2085, 19, Mar, 21:53 GMT, 20, Jun, 15:33 BST, 22, Sep, 07:43 BST, 21, Dec, 04:28 GMT"
        PRINT #f1, "2086, 20, Mar, 03:35 GMT, 20, Jun, 21:09 BST, 22, Sep, 13:32 BST, 21, Dec, 10:22 GMT"
        PRINT #f1, "2087, 20, Mar, 09:28 GMT, 21, Jun, 03:06 BST, 22, Sep, 19:28 BST, 21, Dec, 16:08 GMT"
        PRINT #f1, "2088, 19, Mar, 15:17 GMT, 20, Jun, 08:56 BST, 22, Sep, 01:18 BST, 20, Dec, 21:56 GMT"
        PRINT #f1, "2089, 19, Mar, 21:06 GMT, 20, Jun, 14:43 BST, 22, Sep, 07:07 BST, 21, Dec, 03:52 GMT"
        PRINT #f1, "2090, 20, Mar, 03:02 GMT, 20, Jun, 20:36 BST, 22, Sep, 12:59 BST, 21, Dec, 09:43 GMT"
        PRINT #f1, "2091, 20, Mar, 08:42 GMT, 21, Jun, 02:19 BST, 22, Sep, 18:51 BST, 21, Dec, 15:38 GMT"
        PRINT #f1, "2092, 19, Mar, 14:33 GMT, 20, Jun, 08:15 BST, 22, Sep, 00:42 BST, 20, Dec, 21:32 GMT"
        PRINT #f1, "2093, 19, Mar, 20:34 GMT, 20, Jun, 14:07 BST, 22, Sep, 06:29 BST, 21, Dec, 03:21 GMT"
        PRINT #f1, "2094, 20, Mar, 02:21 GMT, 20, Jun, 19:42 BST, 22, Sep, 12:16 BST, 21, Dec, 09:13 GMT"
        PRINT #f1, "2095, 20, Mar, 08:15 GMT, 21, Jun, 01:39 BST, 22, Sep, 18:11 BST, 21, Dec, 15:01 GMT"
        PRINT #f1, "2096, 19, Mar, 14:03 GMT, 20, Jun, 07:31 BST, 21, Sep, 23:55 BST, 20, Dec, 20:46 GMT"
        PRINT #f1, "2097, 19, Mar, 19:48 GMT, 20, Jun, 13:13 BST, 22, Sep, 05:36 BST, 21, Dec, 02:37 GMT"
        PRINT #f1, "2098, 20, Mar, 01:40 GMT, 20, Jun, 19:03 BST, 22, Sep, 11:24 BST, 21, Dec, 08:21 GMT"
        PRINT #f1, "2099, 20, Mar, 07:17 GMT, 21, Jun, 00:41 BST, 22, Sep, 17:11 BST, 21, Dec, 14:04 GMT"
        CLOSE #f1
    END IF
    IF year > 2015 AND year < 2100 THEN
        count = count + 4
        REDIM _PRESERVE HolidayList(count) AS Holiday_type
        HolidayList(count - 3).month = 3: HolidayList(count - 3).name = "Spring Starts"
        HolidayList(count - 2).month = 6: HolidayList(count - 2).name = "Summer Starts"
        HolidayList(count - 1).month = 9: HolidayList(count - 1).name = "Autumn Starts"
        HolidayList(count).month = 12: HolidayList(count).name = "Winter Starts"
        HolidayList(count - 1).day = d + 1
        OPEN "Seasons.txt" FOR INPUT AS #f1
        DO UNTIL EOF(1)
            INPUT #f1, y
            INPUT #f1, HolidayList(count - 3).day
            INPUT #f1, junk$
            INPUT #f1, junk$
            INPUT #f1, HolidayList(count - 2).day
            INPUT #f1, junk$
            INPUT #f1, junk$
            INPUT #f1, HolidayList(count - 1).day
            INPUT #f1, junk$
            INPUT #f1, junk$
            INPUT #f1, HolidayList(count).day
            INPUT #f1, junk$
            INPUT #f1, junk$
            IF y = year THEN EXIT DO
        LOOP
        CLOSE #f1
    END IF
END SUB
 
 
SUB GetBackgrounds
    FOR i = -12 TO 12
        redo:
        t = INT(RND * 1088) + 1
        FOR j = -12 TO i
            IF BackGrounds(j) = t GOTO redo
        NEXT
        BackGrounds(i) = t
    NEXT
END SUB
 
SUB CenterMonth (month, year)
    _FONT f72
    SELECT CASE month
        CASE 1: text$ = "January"
        CASE 2: text$ = "February"
        CASE 3: text$ = "March"
        CASE 4: text$ = "April"
        CASE 5: text$ = "May"
        CASE 6: text$ = "June"
        CASE 7: text$ = "July"
        CASE 8: text$ = "August"
        CASE 9: text$ = "September"
        CASE 10: text$ = "October"
        CASE 11: text$ = "November"
        CASE 12: text$ = "December"
    END SELECT
    text$ = text$ + STR$(year)
    pw = _PRINTWIDTH(text$) / 2
    _PRINTSTRING (640 - pw, 0), text$
END SUB
 
 
SUB DrawLines
    TopOffset = 72
 
    IF ShowDays THEN
        LINE (0, TopOffset)-STEP(1280, 3), _RGBA(128, 128, 64, 160), BF
        FOR i = 0 TO 7
            LINE (i * 1280 / 7, 0 + TopOffset)-STEP(3, 40), _RGBA32(128, 128, 64, 160), BF
        NEXT
        TopOffset = TopOffset + 40
    END IF
    FOR i = 0 TO 6
        LINE (0, i * 90 + TopOffset)-STEP(1280, 3), _RGBA32(128, 128, 64, 160), BF
    NEXT
    FOR i = 0 TO 7
        LINE (i * 1280 / 7, 0 + TopOffset)-STEP(3, 540), _RGBA32(128, 128, 64, 160), BF
    NEXT
END SUB
 
FUNCTION ConvertToDay$ (day) 'Function to return a string for a day
    SELECT CASE day
        CASE 1: ConvertToDay$ = "Sunday"
        CASE 2: ConvertToDay$ = "Monday"
        CASE 3: ConvertToDay$ = "Tuesday"
        CASE 4: ConvertToDay$ = "Wednesday"
        CASE 5: ConvertToDay$ = "Thursday"
        CASE 6: ConvertToDay$ = "Friday"
        CASE 7: ConvertToDay$ = "Saturday"
    END SELECT
END FUNCTION
 
SUB DrawDays (month, year)
    SHARED highlightday
    REDIM Holidays(0) AS STRING
    TopOffset = 76
    IF ShowDays THEN
        _FONT f32
        bw = 1280 \ 7
        FOR i = 1 TO 7
            t$ = ConvertToDay(i)
            pw = _PRINTWIDTH(t$) \ 2
            _PRINTSTRING (bw * (i - 1) + bw \ 2 - pw, 80), t$
        NEXT
        TopOffset = TopOffset + 40
        _FONT f72
    END IF
 
    nod = NumberOfDays(month, year)
    y = 0
    FOR i = 1 TO nod
        text$ = _TRIM$(STR$(i))
        pw = _PRINTWIDTH(text$)
        x = GetDay(month, i, year)
        IF month = ThisMonth AND i = Today AND ThisYear = year THEN LINE ((x - 1) * 1280 / 7 + 3, y * 90 + TopOffset)-STEP(1280 / 7 - 3, 86), _RGBA32(128, 128, 128, 128), BF
        _PRINTSTRING (x * 1280 / 7 - pw, y * 90 + TopOffset), text$
 
        '
 
 
        u = UBOUND(HolidayList)
        IF u > 0 THEN
            _FONT 8
            count = 0
            FOR j = 1 TO u
                IF month = HolidayList(j).month AND i = HolidayList(j).day THEN
                    count = count + 1
                    _PRINTSTRING ((x - 1) * 1280 / 7 + 4, (y + 1) * 90 + TopOffset - 5 - count * 8), LEFT$(HolidayList(j).name, 22)
                END IF
            NEXT
            _FONT f72
        END IF
        IF x = 7 THEN y = y + 1
    NEXT
END SUB
 
 
FUNCTION NumberOfDays (month, year)
    SELECT CASE month
        CASE 1, 3, 5, 7, 8, 10, 12: NumberOfDays = 31
        CASE 2: IF IsLeapYear(year) THEN NumberOfDays = 29 ELSE NumberOfDays = 28
        CASE 4, 6, 9, 11: NumberOfDays = 30
    END SELECT
END SUB
 
 
FUNCTION IsLeapYear (yyyy) 'use 4 digit year
    IF GetDay(2, 29, yyyy) <> GetDay(3, 1, yyyy) THEN IsLeapYear = -1
END FUNCTION
 
FUNCTION GetDay (m, d, y) 'use 4 digit year
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    mm = m: dd = d: yyyy = y
    IF mm < 3 THEN mm = mm + 12: yyyy = yyyy - 1
    century = yyyy MOD 100
    zerocentury = yyyy \ 100
    result = (dd + INT(13 * (mm + 1) / 5) + century + INT(century / 4) + INT(zerocentury / 4) + 5 * zerocentury) MOD 7
    IF result = 0 THEN
        GetDay = 7
    ELSE
        GetDay = result
    END IF
    'Function changed to return a numeric value instead of a string for this program
    '    SELECT CASE result
    '        CASE 7: GetDay$ = "Saturday"
    '        CASE 1: GetDay$ = "Sunday"
    '        CASE 2: GetDay$ = "Monday"
    '        CASE 3: GetDay$ = "Tuesday"
    '        CASE 4: GetDay$ = "Wednesday"
    '        CASE 5: GetDay$ = "Thursday"
    '        CASE 6: GetDay$ = "Friday"
    '    END SELECT
END FUNCTION
 
 
FUNCTION GetPublicIP$ (force)
 
    f1 = FREEFILE
    IF force = -1 OR _FILEEXISTS("PIP.txt") = 0 THEN
        OPEN "PIP.txt" FOR OUTPUT AS #f1: CLOSE f1
        SHELL _HIDE "cmd /c nslookup myip.opendns.com resolver1.opendns.com>PIP.txt"
    END IF
 
    OPEN "PIP.txt" FOR INPUT AS #f1
    IF LOF(f1) THEN
        DO
            LINE INPUT #f1, temp$
            IF temp$ <> "" THEN last$ = temp$ 'there's a blank line after the data we need.
            '                                 Ignore it.  What we want is the last line of info generated here.
        LOOP UNTIL EOF(1)
        l = _INSTRREV(last$, "Address:")
        IF l THEN GetPublicIP$ = MID$(last$, l + 10)
    END IF
    CLOSE f1
END FUNCTION
 
SUB Lat_Long (lat AS _FLOAT, lon AS _FLOAT, force)
    ip$ = GetPublicIP$(0)
    IF force = -1 OR _FILEEXISTS("LatAndLong.txt") = 0 THEN
        DownloadURL "ip-api.com/line/" + ip$ + "?fields=lat,lon", "LatAndLong.txt"
    END IF
    f1 = FREEFILE
    OPEN "LatAndLong.txt" FOR INPUT AS #f1
    IF LOF(f1) = 0 THEN CLOSE f1: EXIT SUB 'something didn't download.  this info isn't available to parse.
    INPUT #f1, lat
    INPUT #f1, lon
    CLOSE f1
END SUB
 
SUB DownloadURL (link$, file$)
    f1 = FREEFILE
    OPEN file$ FOR OUTPUT AS #f1: CLOSE #f1 'erase any old file of the same name
    $IF WIN THEN
        out$ = "powershell.exe -c " + CHR$(34) + "Invoke-Webrequest '" + link$ + "' -OutFile '" + file$ + "'" + CHR$(34)
    $ELSE
        out$ = "wget " + chr$(34) + link$ + " -O " + file$ + chr$(34)
    $END IF
    SHELL _HIDE out$
END SUB
 
FUNCTION GetHour (fromTime$) 'time should be hh:mm:ss WhateverM
    l = INSTR(fromTime$, ":") '1st :
    GetHour = VAL(LEFT$(fromTime$, l))
END SUB
 
FUNCTION GetMinute (fromTime$) 'time should be hh:mm:ss WhateverM
    l = INSTR(fromTime$, ":") '1st :
    GetMinute = VAL(MID$(fromTime$, l + 1))
END SUB
 
 
FUNCTION GetSecond (fromTime$) 'time should be hh:mm:ss WhateverM
    l = INSTR(fromTime$, ":") '1st :
    l = INSTR(l + 1, fromTime$, ":") '2nd :
    GetSecond = VAL(MID$(fromTime$, l + 1))
END SUB
 
 
FUNCTION GetTimeOffset
    $IF WIN THEN
        TYPE SYSTEMTIME
            wYear AS _UNSIGNED INTEGER
            wMonth AS _UNSIGNED INTEGER
            wDayOfWeek AS _UNSIGNED INTEGER
            wDay AS _UNSIGNED INTEGER
            wHour AS _UNSIGNED INTEGER
            wMinute AS _UNSIGNED INTEGER
            wSecond AS _UNSIGNED INTEGER
            wMilliseconds AS _UNSIGNED INTEGER
        END TYPE
 
        TYPE TIME_ZONE_INFORMATION
            Bias AS LONG
            StandardName AS STRING * 64 'WCHAR      StandardName[32];
            StandardDate AS SYSTEMTIME
            StandardBias AS LONG
            DaylightName AS STRING * 64 'WCHAR      DaylightName[32];
            DaylightDate AS SYSTEMTIME
            DaylightBias AS LONG
        END TYPE
 
        DECLARE DYNAMIC LIBRARY "Kernel32"
            SUB GetTimeZoneInformation (t AS TIME_ZONE_INFORMATION)
        END DECLARE
 
        DIM t AS TIME_ZONE_INFORMATION
        GetTimeZoneInformation t
        GetTimeOffset = t.Bias
    $END IF
END SUB
 
 
 
SUB SunStuff (lat, lon, month, day, year)
    STATIC f
    d$ = _TRIM$(STR$(year)) + _TRIM$(STR$(month)) + _TRIM$(STR$(day))
    link$ = "https://api.sunrise-sunset.org/json?lat=" + _TRIM$(STR$(lat)) + "&lng="
    link$ = link$ + _TRIM$(STR$(lon)) + "&date=" + d$
    DownloadURL link$, "temp.txt"
    f = FREEFILE
    OPEN "temp.txt" FOR BINARY AS #f
 
    IF LOF(f) = 0 THEN CLOSE f: EXIT SUB 'something didn't download.  this info isn't available to parse.
 
    t$ = SPACE$(LOF(f))
    GET #1, 1, t$
    CLOSE f
 
    'strip off unwanted stuff
    l = INSTR(t$, ":{"): t$ = MID$(t$, l + 2) 'junk left of our initial data
    DO
        l = INSTR(t$, CHR$(34))
        t$ = LEFT$(t$, l - 1) + MID$(t$, l + 1) 'remove all quotes completely from this data
    LOOP UNTIL l = 0
    DO
        l = INSTR(t$, "_")
        t$ = LEFT$(t$, l - 1) + " " + MID$(t$, l + 1) 'change all underscores to spaces in this data
    LOOP UNTIL l = 0
    t$ = _TRIM$(t$)
    t$ = LEFT$(t$, LEN(t$) - 12) 'remove the last end of data }
    PRINT t$
 
    'parse it down to field, data
    DO
        l = INSTR(t$, ",")
        IF l = 0 THEN EXIT DO
        count = count + 1
        REDIM _PRESERVE Sun(count) AS Sun_Data_type
        whole$ = LEFT$(t$, l)
        Sun(count).field = LEFT$(whole$, INSTR(whole$, ":") - 1)
        r$ = MID$(whole$, INSTR(whole$, ":") + 1)
        r$ = LEFT$(r$, LEN(r$) - 1)
        IF RIGHT$(r$, 1) = "M" THEN m$ = RIGHT$(r$, 3) ELSE m$ = ""
        h = GetHour(r$): m = GetMinute(r$): s = GetSecond(r$)
        IF m$ = " PM" AND h <> 12 THEN h = h + 12
        IF count <> 4 THEN
            h = h - GetTimeOffset / 60
            IF h < 0 THEN h = 24 + h 'adjust for AM/PM difference, if ever necessary
            IF h > 23 THEN h = h - 24 'adjust for AM/PM difference, if ever necessary
            SELECT CASE h
                CASE 0: h = 12: m$ = " AM"
                CASE 12: m$ = " PM"
                CASE IS > 12: h = h - 12: m$ = " PM"
                CASE ELSE: m$ = " AM"
            END SELECT
        END IF
        hour$ = _TRIM$(STR$(h)): IF LEN(hour$) = 1 THEN hour$ = "0" + hour$
        min$ = _TRIM$(STR$(m)): IF LEN(min$) = 1 THEN min$ = "0" + min$
        sec$ = _TRIM$(STR$(s)): IF LEN(sec$) = 1 THEN sec$ = "0" + sec$
        Sun(count).value = hour$ + ":" + min$ + ":" + sec$ + m$
        t$ = MID$(t$, l + 1)
    LOOP
END SUB
 
 
FUNCTION MoonPhase$ (month, day, year)
    DIM mooncycle AS _FLOAT
    DIM fullmoon AS _FLOAT, dp AS _FLOAT, sod AS _FLOAT
    mooncycle = 29.5305882 'days between moon rotations
    sod = 24 * 60 * 60 'number of seconds in a day
 
    m$ = _TRIM$(STR$(month))
    d$ = _TRIM$(STR$(day))
    y$ = _TRIM$(STR$(year))
    dt$ = m$ + "-" + d$ + "-" + y$
    guessmoon = TimeStamp(dt$, 23 * 3600 + 59 * 60 + 59) 'what is the moon at 11:59:59 PM
    fullmoon = TimeStamp("1-3-2020", 4 * 3600 + 46 * 60) ' full moon on 1-3-2020 at 4:46 AM UTC
    dp = (guessmoon - fullmoon) / sod 'days past our full moon
    r1 = dp - INT(dp / mooncycle) * mooncycle 'how far we are in repeating our rotation
    SELECT CASE r1
        CASE IS <= mooncycle / 4: MoonPhase$ = "1st Quarter"
        CASE IS <= mooncycle / 2: MoonPhase$ = "Full moon"
        CASE IS <= mooncycle * 3 / 4: MoonPhase$ = "3rd Quarter"
        CASE ELSE: MoonPhase$ = "New Moon"
    END SELECT
END FUNCTION
 
 
 
FUNCTION TimeStamp## (d$, t##) 'date and timer
    'Based on Unix Epoch time, which starts at year 1970.
    DIM l AS _INTEGER64, l1 AS _INTEGER64, m AS _INTEGER64
    DIM d AS _INTEGER64, y AS _INTEGER64, i AS _INTEGER64
    DIM s AS _FLOAT
 
    l = INSTR(d$, "-")
    l1 = INSTR(l + 1, d$, "-")
    m = VAL(LEFT$(d$, l))
    d = VAL(MID$(d$, l + 1))
    y = VAL(MID$(d$, l1 + 1))
    IF y < 1970 THEN 'calculate shit backwards
        SELECT CASE m 'turn the day backwards for the month
            CASE 1, 3, 5, 7, 8, 10, 12: d = 31 - d '31 days
            CASE 2: d = 28 - d 'special 28 or 29.
            CASE 4, 6, 9, 11: d = 30 - d '30 days
        END SELECT
        IF y MOD 4 = 0 AND m < 3 THEN 'check for normal leap year, and we're before it...
            d = d + 1 'assume we had a leap year, subtract another day
            IF y MOD 100 = 0 AND y MOD 400 <> 0 THEN d = d - 1 'not a leap year if year is divisible by 100 and not 400
        END IF
 
        'then count the months that passed after the current month
        FOR i = m + 1 TO 12
            SELECT CASE i
                CASE 2: d = d + 28
                CASE 3, 5, 7, 8, 10, 12: d = d + 31
                CASE 4, 6, 9, 11: d = d + 30
            END SELECT
        NEXT
 
        'we should now have the entered year calculated.  Now lets add in for each year from this point to 1970
        d = d + 365 * (1969 - y) '365 days per each standard year
        FOR i = 1968 TO y + 1 STEP -4 'from 1968 onwards,backwards, skipping the current year (which we handled previously in the FOR loop)
            d = d + 1 'subtract an extra day every leap year
            IF (i MOD 100) = 0 AND (i MOD 400) <> 0 THEN d = d - 1 'but skipping every year divisible by 100, but not 400
        NEXT
        s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
        TimeStamp## = -(s## + 24 * 60 * 60 - t##)
        EXIT FUNCTION
    ELSE
        y = y - 1970
    END IF
 
    FOR i = 1 TO m 'for this year,
        SELECT CASE i 'Add the number of days for each previous month passed
            CASE 1: d = d 'January doestn't have any carry over days.
            CASE 2, 4, 6, 8, 9, 11: d = d + 31
            CASE 3 'Feb might be a leap year
                IF (y MOD 4) = 2 THEN 'if this year is divisible by 4 (starting in 1972)
                    d = d + 29 'its a leap year
                    IF (y MOD 100) = 30 AND (y MOD 400) <> 30 THEN 'unless..
                        d = d - 1 'the year is divisible by 100, and not divisible by 400
                    END IF
                ELSE 'year not divisible by 4, no worries
                    d = d + 28
                END IF
            CASE 5, 7, 10, 12: d = d + 30
        END SELECT
    NEXT
    d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
    FOR i = 2 TO y - 1 STEP 4 'from 1972 onwards, skipping the current year (which we handled previously in the FOR loopp)
        d = d + 1 'add an extra day every leap year
        IF (i MOD 100) = 30 AND (i MOD 400) <> 30 THEN d = d - 1 'but skiping every year divisible by 100, but not 400
    NEXT
    s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
    TimeStamp## = (s## + t##)
END FUNCTION
 
FUNCTION ConvertDayToNum (day$)
    SELECT CASE day$
        CASE "Sunday": ConvertDayToNum = 1
        CASE "Monday": ConvertDayToNum = 2
        CASE "Tuseday": ConvertDayToNum = 3
        CASE "Wednesday": ConvertDayToNum = 4
        CASE "Thursday": ConvertDayToNum = 5
        CASE "Friday": ConvertDayToNum = 6
        CASE "Saturday": ConvertDayToNum = 7
    END SELECT
END FUNCTION

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

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

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

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

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

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

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

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

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

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

Adrian · « **Reply #9 on:** December 29, 2020, 01:37:40 pm »

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

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

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

Code: QB64: [Select]

' EASTER DATE CALCULATION FOR YEARS 1583 TO 4099
 
' y is a 4 digit year 1583 to 4099
' d returns the day of the month of Easter
' m returns the month of Easter
 
' Easter Sunday is the Sunday following the Paschal Full Moon
' (PFM) date for the year
 
' This algorithm is an arithmetic interpretation of the 3 step
' Easter Dating Method developed by Ron Mallen
 
DIM FirstDig, Remain19, temp 'intermediate results
DIM tA, tB, tC, tD, tE 'table A to E results
 
INPUT "year "; y
FirstDig = y \ 100 'first 2 digits of year
Remain19 = y MOD 19 'remainder of year / 19
 
' calculate PFM date
temp = (FirstDig - 15) \ 2 + 202 - 11 * Remain19
 
SELECT CASE FirstDig
    CASE 21, 24, 25, 27 TO 32, 34, 35, 38
        temp = temp - 1
    CASE 33, 36, 37, 39, 40
        temp = temp - 2
END SELECT
temp = temp MOD 30
 
tA = temp + 21
IF temp = 29 THEN tA = tA - 1
IF (temp = 28 AND Remain19 > 10) THEN tA = tA - 1
 
'find the next Sunday
tB = (tA - 19) MOD 7
 
tC = (40 - FirstDig) MOD 4
IF tC = 3 THEN tC = tC + 1
IF tC > 1 THEN tC = tC + 1
 
temp = y MOD 100
tD = (temp + temp \ 4) MOD 7
 
tE = ((20 - tB - tC - tD) MOD 7) + 1
d = tA + tE
 
'return the date
IF d > 31 THEN
    d = d - 31
    m = 4: m$ = "April"
ELSE
    m = 3: m$ = "March"
END IF
 
PRINT m$, d
END
 

SierraKen · « **Reply #10 on:** December 29, 2020, 07:41:27 pm »

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

Code: QB64: [Select]

'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
 

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

Code: QB64: [Select]

        IF m = PQM AND dd = PQJ THEN
            GOSUB coloring:
            _PRINTSTRING (dayx + 25, weeky + 60), "Easter"
        END IF
 

SMcNeill · « **Reply #11 on:** January 05, 2021, 11:09:19 pm »

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

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

Ryster · « **Reply #12 on:** January 07, 2021, 01:38:44 pm »

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

STxAxTIC · « **Reply #13 on:** January 07, 2021, 03:12:44 pm »

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

bplus · « **Reply #14 on:** January 07, 2021, 03:25:06 pm »

Edit: sorry this distracted from lovely thread Steve started.

News:

Author Topic: Calendar 2021 (Read 6969 times)

SMcNeill

Calendar 2021

SMcNeill

Re: Calendar 2021

Richard Frost

Re: Calendar 2021

SMcNeill

Re: Calendar 2021

SMcNeill

Re: Calendar 2021

STxAxTIC

Re: Calendar 2021

SMcNeill

Re: Calendar 2021

SMcNeill

Re: Calendar 2021

SMcNeill

Re: Calendar 2021

Adrian

Re: Calendar 2021

SierraKen

Re: Calendar 2021

SMcNeill

Re: Calendar 2021

Ryster

Re: Calendar 2021

STxAxTIC

Re: Calendar 2021

bplus

Re: Calendar 2021