Author Topic: Calendar Maker (Read 7090 times)

SierraKen · « **on:** August 05, 2019, 01:55:20 am »

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

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

Code: QB64: [Select]

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

euklides · « **Reply #1 on:** August 05, 2019, 04:13:05 am »

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

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

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

johnno56 · « **Reply #2 on:** August 05, 2019, 10:14:39 am »

Cool. Nicely done!

Jack002 · « **Reply #3 on:** August 05, 2019, 10:31:24 am »

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

SMcNeill · « **Reply #4 on:** August 05, 2019, 10:48:02 am »

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

Code: [Select]

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

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

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


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

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

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

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

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

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

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

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

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

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

SLEEP 3
SYSTEM

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

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

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

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

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

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

bplus · « **Reply #5 on:** August 05, 2019, 12:08:04 pm »

Wow SAM never saw OUT before, watch OUT!

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

SierraKen · « **Reply #6 on:** August 05, 2019, 12:20:12 pm »

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

SMcNeill · « **Reply #7 on:** August 05, 2019, 12:23:57 pm »

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

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

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

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

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

SierraKen · « **Reply #8 on:** August 05, 2019, 07:56:18 pm »

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

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

Code: QB64: [Select]

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

bplus · « **Reply #9 on:** August 05, 2019, 10:04:17 pm »

Hi Ken,

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

Code: QB64: [Select]

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

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

bplus · « **Reply #10 on:** August 05, 2019, 10:36:11 pm »

Code: QB64: [Select]

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

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

So Wiki needs a fix?

SMcNeill · « **Reply #11 on:** August 05, 2019, 10:49:39 pm »

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

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

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

So Wiki needs a fix?

Nope. It’s part of the SCREEN syntax.

SCREEN imagehandle& [, , active_page, visual_page]

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

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

Color setting?

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

(See the comma comma with nothing between it?

SierraKen · « **Reply #12 on:** August 05, 2019, 10:58:37 pm »

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

SierraKen · « **Reply #13 on:** August 05, 2019, 11:07:07 pm »

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

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

Code: QB64: [Select]

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

bplus · « **Reply #14 on:** August 05, 2019, 11:34:05 pm »

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

Nope. It’s part of the SCREEN syntax.

SCREEN imagehandle& [, , active_page, visual_page]

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

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

Color setting?

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

(See the comma comma with nothing between it?

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

Hi, Ken,

I thought you might like that change. :)

News:

Author Topic: Calendar Maker (Read 7090 times)

SierraKen

Calendar Maker

euklides

Re: Calendar Maker

johnno56

Re: Calendar Maker

Jack002

Re: Calendar Maker

SMcNeill

Re: Calendar Maker

bplus

Re: Calendar Maker

SierraKen

Re: Calendar Maker

SMcNeill

Re: Calendar Maker

SierraKen

Re: Calendar Maker

bplus

Re: Calendar Maker

bplus

Re: Calendar Maker

SMcNeill

Re: Calendar Maker

SierraKen

Re: Calendar Maker

SierraKen

Re: Calendar Maker

bplus

Re: Calendar Maker