11-27-2022, 11:28 AM (This post was last modified: 11-27-2022, 11:50 AM by NasaCow.)
So, deciding to abandon the GUI ideas, I went back to making a different style. Spent the last two days drawing and programming in some of my ideas (and recycling a little of my old code). I hope to finish up the student side before building the gradebook side. Next time, I hope to print the database to .txt files for easing organizing and printing info (pdf would be better but not sure I am ready for that) for those various teacher clipboards. In the end, I hope to print weekly, monthly, and term grade reports by students to make it easier keeping parents informed what homework is missing or completed poorly. A long way to go but it would be nice to share with the community
Enjoy!
I'll post the code here but I do use pictures for the sake of my programming simplicity so feel free to download the attached .zip for the full thing (contents .bas, .ttf. .png files only)
Code: (Select All)
'===========================================
'| Grade Keeper Version 3 Release V:.1 |
'| Updated: November 2022 |
'| Rebuild of V1, code cleanup |
'| Contact: NasaCow @ |
'===========================================
'$DEBUG
'$DYNAMIC
$NOPREFIX
OPTION EXPLICIT
OPTION BASE 1
CONST FALSE = 0, TRUE = NOT FALSE
TYPE NameListType
PinYinName AS STRING * 20
FirstName AS STRING * 20
MiddleName AS STRING * 20
LastName AS STRING * 20
Year AS INTEGER
Month AS INTEGER
Day AS INTEGER
HouseColor AS STRING * 10
MomName AS STRING * 40
MomPhone AS STRING * 20 'Saved as string to support symbols and international prefixes
MomEmail AS STRING * 80
DadName AS STRING * 40
DadPhone AS STRING * 20
DadEmail AS STRING * 80
END TYPE
DIM SHARED AS NameListType NameList(10) 'Student list
DIM SHARED AS LONG ScreenPointer(5), Arial8, Arial12, Arial16 'Screen & font handles
DIM SHARED AS LONG Arial24, Arial32, Arial48, Arial60 'Font handles
DIM SHARED AS LONG Intro, AboutPic, Current, CheckSelect, Report 'Picture handles
DIM SHARED AS LONG NewNameEntry, DisplayData, CurrentLayout, Generic 'Picture handles
DIM SHARED AS INTEGER Counter 'Throw-away counter
DIM SHARED AS INTEGER NumberOfStudents
DIM SHARED AS INTEGER Pointer 'Used for menu selections
DIM SHARED AS BIT SelectFlag 'Used to prevent graphic glitches and/or escape loops
'Loading needed screen space
TITLE "Grade Keeper Alpha Version 0.1"
DISPLAY 'Turn off Auto Display
SCREEN NEWIMAGE(1280, 720, 32)
SCREENMOVE 0, 0
ScreenPointer(1) = DEST 'Main screen
FOR Counter = 2 TO 5 'Screen 5 is exclusive use of CENTERNEWSCREEN text printing
ScreenPointer(Counter) = NEWIMAGE(1280, 720, 32)
NEXT Counter
'Font sizes
Arial8 = LOADFONT("data/assets/arial.ttf", 8) 'For grades and later use
Arial12 = LOADFONT("data/assets/arial.ttf", 12) 'For grades and later use
Arial16 = LOADFONT("data/assets/arial.ttf", 16) 'For grades and later use
Arial24 = LOADFONT("data/assets/arial.ttf", 24)
Arial32 = LOADFONT("data/assets/arial.ttf", 32)
Arial48 = LOADFONT("data/assets/arial.ttf", 48)
Arial60 = LOADFONT("data/assets/arial.ttf", 60)
DO: MAINMENU: LOOP 'Main program loop
SYSTEM
errorhandle: 'Error handling
DIM AS STRING ErrorCode
ErrorCode = "Error" + STR$(ERR) + " on program file line" + STR$(ERRORLINE) + ". Program will end."
PRINTCENTERNEWSCREEN ErrorCode, 48, 1
SYSTEM
SUB MAINMENU
Pointer = 0: SelectFlag = FALSE
PAUSE (.15)
SCREEN ScreenPointer(1)
DO
CLS
PUTIMAGE (0, 0), Intro
SELECT CASE Pointer
CASE 0: PUTIMAGE (375, 221), CheckSelect
CASE 1: PUTIMAGE (375, 292), CheckSelect
CASE 2: PUTIMAGE (375, 365), CheckSelect
CASE 3: PUTIMAGE (375, 437), CheckSelect
CASE 4: PUTIMAGE (375, 510), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE (.15) 'Avoid double press delay
SelectFlag = FALSE
'Checking for key press (keyboard)
IF KEYDOWN(CVI(CHR$(0) + "H")) THEN ' up case
IF Pointer = 0 THEN Pointer = 4 ELSE Pointer = Pointer - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(CVI(CHR$(0) + "P")) THEN 'down case
IF Pointer = 4 THEN Pointer = 0 ELSE Pointer = Pointer + 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) 'Return/Spacebar to select
SELECT CASE Pointer
CASE 0: CURRENTCLASS
CASE 1: 'ARCHIVEDCLASS
CASE 2: 'OPTIONS
CASE 3: ABOUT
CASE 4: SYSTEM
END SELECT
END SUB
SUB CURRENTCLASS
PAUSE (.15)
Pointer = 0
DO
DO
CLS 'Prepare and draw the menu
PUTIMAGE (0, 0), Current
SELECT CASE Pointer
CASE 0: PUTIMAGE (260, 190), CheckSelect
CASE 1: PUTIMAGE (260, 280), CheckSelect
CASE 2: PUTIMAGE (260, 380), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE (.125) 'Avoid double press delay
SelectFlag = FALSE
'Checking for key press (keyboard)
IF KEYDOWN(CVI(CHR$(0) + "H")) THEN ' up case
IF Pointer = 0 THEN Pointer = 2 ELSE Pointer = Pointer - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(CVI(CHR$(0) + "P")) THEN 'down case
IF Pointer = 2 THEN Pointer = 0 ELSE Pointer = Pointer + 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) 'Return or Space bar to select
'Execute choice
SELECT CASE Pointer
CASE 0: 'LOADGRADES
CASE 1: LOADNAMES
END SELECT
LOOP UNTIL Pointer = 2
END SUB
SUB LOADGRADES 'Future release
END SUB
SUB LOADNAMES
DIM AS INTEGER Rows, Columns, RowStep, ColumnStep, StartX, StartY
DIM AS STRING FirstName, LastName
DIM AS INTEGER Highlight(500000)
DIM AS BIT Selected, Back
IF FILEEXISTS("data/current/namelist.gkn") THEN 'Display current list if it exists
LOADSTUDENTDATA
FONT Arial32
Counter = 1: Rows = 3: Columns = 15: RowStep = FONTHEIGHT(Arial32): ColumnStep = 615
Back = FALSE
CLS
PUTIMAGE (0, 0), CurrentLayout 'Simple box layout
WHILE Counter <= NumberOfStudents 'Prints student names to screen
FirstName = TRIM$(NameList(Counter).FirstName)
LastName = TRIM$(NameList(Counter).LastName)
LOCATE Rows, Columns: PRINT FirstName + " " + LastName
Counter = Counter + 1
Rows = Rows + 1
WEND
LOCATE Rows, Columns: PRINT "Add student to class"
LOCATE Rows + 1, Columns: PRINT "Whole class data reports"
LOCATE Rows + 2, Columns: PRINT "Go back to the prior screen"
DO 'Keep looping until explicitly told to return to prior menu
Rows = 3: StartX = 4: StartY = (Rows - 1) * FONTHEIGHT(Arial32)
Counter = 1: Selected = FALSE
PAUSE (.15)
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
DO 'GUI student interface selection
DISPLAY
IF KEYDOWN(18432) THEN 'up case
IF Counter = 1 THEN 'Top of table check
'Do nothing, ignore key press
ELSE 'Process the change
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
StartY = StartY - RowStep
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
Counter = Counter - 1
PAUSE (.15)
END IF
END IF
IF KEYDOWN(20480) THEN 'down case
IF NumberOfStudents + 3 = Counter THEN 'Bottom of table check
'Do nothing, ignore key press
ELSE 'Process the change
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
StartY = StartY + RowStep
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
Counter = Counter + 1
PAUSE (.15)
END IF
END IF
IF KEYDOWN(13) OR KEYDOWN(32) THEN 'Select a choice and exit the loop
Selected = TRUE
PAUSE (.15)
GET (StartX, StartY)-(619, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
END IF
LOOP WHILE NOT Selected
SELECT CASE Counter 'Process selected choice
CASE 1 TO NumberOfStudents:
CASE NumberOfStudents + 1:
CASE NumberOfStudents + 2: STUDENTREPORTS
CASE NumberOfStudents + 3: Back = TRUE 'Return to prior meny
END SELECT
LOOP UNTIL Back
PAUSE (.15)
ELSE
CREATESTUDENTLIST
END IF
END SUB
SUB STUDENTREPORTS
DIM Back AS BIT
SCREEN ScreenPointer(2)
Counter = 0
SelectFlag = FALSE: Back = FALSE
PAUSE (.15)
DO
DO
CLS
PUTIMAGE (0, 0), Report
SELECT CASE Counter
CASE 0: PUTIMAGE (285, 170), CheckSelect
CASE 1: PUTIMAGE (285, 240), CheckSelect
CASE 2: PUTIMAGE (285, 310), CheckSelect
CASE 3: PUTIMAGE (285, 380), CheckSelect
CASE 4: PUTIMAGE (285, 455), CheckSelect
CASE 5: PUTIMAGE (285, 525), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE (.15) 'Avoid double press delay
SelectFlag = FALSE
'Checking for key press (keyboard)
IF KEYDOWN(18432) THEN ' up case
IF Counter = 0 THEN Counter = 5 ELSE Counter = Counter - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(20480) THEN 'down case
IF Counter = 5 THEN Counter = 0 ELSE Counter = Counter + 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) 'Return of Spacebar to select
SELECT CASE Counter
CASE 0:
CASE 1:
CASE 2:
CASE 3:
CASE 4:
CASE 5: Back = TRUE
END SELECT
PAUSE (.15)
LOOP UNTIL Back
SCREEN ScreenPointer(1)
END SUB
SUB ARCHIVEDCLASS 'Prior year record keeping - Future release
SUB ABOUT
CLS
PUTIMAGE (0, 0), Generic
FONT Arial60: LOCATE 2, 1280 / 2 - PRINTWIDTH("Grade Keeper") / 2: PRINT "Grade Keeper"
FONT Arial32: LOCATE 5, 1280 / 2 - PRINTWIDTH("Alpha Version 0.1") / 2: PRINT "Alpha Version 0.1"
FONT Arial24: LOCATE 15, 50: PRINT "Public alpha release #1. Built November 27th, 2022. Released as non-commercial and share alike as defined"
LOCATE 16, 50: PRINT "by the creative commons 4.0. May not apply any additional legal terms nor technological measures that"
LOCATE 17, 50: PRINT "legally restrict others from doing anything that the license permits. Please contact NasaCow at"
LOCATE 18, 50: PRINT "NasaCowPro@gmail.com with any questions or feedback. No warranty or guarantee explicitly or implicitly"
LOCATE 19, 50: PRINT "made with the use of this software."
LOCATE 28, 50: PRINT "Press any key to go back..."
DISPLAY
SLEEP
END SUB
'===========Support Subs/Functions===========
'Used for initial database building of student data
SUB CREATESTUDENTLIST
DIM AS STRING * 1 AddAnother, Correct
DIM AS NameListType NewData
PAUSE (.15)
FONT Arial24
OPEN "data/current/namelist.gkn" FOR OUTPUT AS #1 'For writing the master name list data
Counter = 1
AUTODISPLAY
DO 'Gathering data about students
CLS
PUTIMAGE (0, 0), NewNameEntry
LOCATE 7, 140: PRINT Counter 'Built with Arial24
LOCATE 7, 280: INPUT "", NewData.PinYinName
DO
LOCATE 7, 710: PRINT " "
LOCATE 7, 710: INPUT "", NewData.Month
LOOP UNTIL NewData.Month > 0 AND NewData.Month < 13
DO
LOCATE 7, 780: PRINT " "
LOCATE 7, 780: INPUT "", NewData.Day
LOOP UNTIL NewData.Day > 0 AND NewData.Day < 32
DO
LOCATE 7, 840: PRINT " "
LOCATE 7, 840: INPUT "", NewData.Year
LOOP UNTIL NewData.Year > 1990 AND NewData.Year < 2100
LOCATE 7, 970: INPUT "", NewData.HouseColor
LOCATE 12, 55: INPUT "", NewData.FirstName
LOCATE 12, 400: INPUT "", NewData.MiddleName
LOCATE 12, 780: INPUT "", NewData.LastName
LOCATE 17, 55: INPUT "", NewData.MomName
LOCATE 17, 400: INPUT "", NewData.MomPhone
LOCATE 17, 780: INPUT "", NewData.MomEmail
LOCATE 22, 55: INPUT "", NewData.DadName
LOCATE 22, 400: INPUT "", NewData.DadPhone
LOCATE 22, 780: INPUT "", NewData.DadEmail
DO
LOCATE 27, 430: PRINT " "
LOCATE 27, 430: INPUT "", Correct
Correct = UCASE$(Correct)
LOOP UNTIL Correct = "Y" OR Correct = "N"
DO
LOCATE 27, 690: PRINT " "
LOCATE 27, 690: INPUT "", AddAnother
AddAnother = UCASE$(AddAnother)
LOOP UNTIL AddAnother = "Y" OR AddAnother = "N"
IF Correct = "Y" THEN
WRITE #1, NewData.PinYinName
WRITE #1, NewData.Month
WRITE #1, NewData.Day
WRITE #1, NewData.Year
WRITE #1, NewData.HouseColor
WRITE #1, NewData.FirstName
WRITE #1, NewData.MiddleName
WRITE #1, NewData.LastName
WRITE #1, NewData.MomName
WRITE #1, NewData.MomPhone
WRITE #1, NewData.MomEmail
WRITE #1, NewData.DadName
WRITE #1, NewData.DadPhone
WRITE #1, NewData.DadEmail
Counter = Counter + 1
ELSE
PRINTCENTERNEWSCREEN "Data not written. Please re-enter data.", 32, 1
AUTODISPLAY
FONT Arial24
AddAnother = "Y"
END IF
LOOP UNTIL AddAnother = "N"
DISPLAY
CLOSE #1
PRINTCENTERNEWSCREEN "Data written successfully!", 32, 1
END SUB
'Loads the student data into memory. Ensure file exists before calling
SUB LOADSTUDENTDATA
NumberOfStudents = 0
OPEN "data/current/namelist.gkn" FOR INPUT AS #1
WHILE NOT EOF(1)
NumberOfStudents = NumberOfStudents + 1
IF UBOUND(namelist) = NumberOfStudents THEN REDIM PRESERVE NameList(NumberOfStudents + 1) AS NameListType
INPUT #1, NameList(NumberOfStudents).PinYinName
INPUT #1, NameList(NumberOfStudents).Month
INPUT #1, NameList(NumberOfStudents).Day
INPUT #1, NameList(NumberOfStudents).Year
INPUT #1, NameList(NumberOfStudents).HouseColor
INPUT #1, NameList(NumberOfStudents).FirstName
INPUT #1, NameList(NumberOfStudents).MiddleName
INPUT #1, NameList(NumberOfStudents).LastName
INPUT #1, NameList(NumberOfStudents).MomName
INPUT #1, NameList(NumberOfStudents).MomPhone
INPUT #1, NameList(NumberOfStudents).MomEmail
INPUT #1, NameList(NumberOfStudents).DadName
INPUT #1, NameList(NumberOfStudents).DadPhone
INPUT #1, NameList(NumberOfStudents).DadEmail
WEND
CLOSE #1
END SUB
'Prints a short pop-up message to the user
SUB PRINTCENTERNEWSCREEN (ToPrint AS STRING, FontHandle AS INTEGER, CurrentScreen AS INTEGER)
DIM AS INTEGER Rows, Columns
SCREEN ScreenPointer(5) 'Save prior screen
SELECT CASE FontHandle
CASE 8: FONT Arial8
CASE 12: FONT Arial12
CASE 16: FONT Arial16
CASE 24: FONT Arial24
CASE 32: FONT Arial32
CASE 48: FONT Arial48
CASE 60: FONT Arial60
CASE ELSE: BEEP
EXIT SUB
END SELECT
CLS
PUTIMAGE (0, 0), Generic
Rows = (HEIGHT / FONTHEIGHT) / 2
Columns = 1280 / 2 - PRINTWIDTH(ToPrint) / 2
LOCATE Rows, Columns: PRINT ToPrint
Columns = 1280 / 2 - PRINTWIDTH("Press any key.") / 2
LOCATE Rows + 2, Columns: PRINT "Press any key."
BEEP
DISPLAY
SLEEP
PAUSE .15
SCREEN ScreenPointer(CurrentScreen) 'Restore prior screen before call
END SUB
'Simple timer delay with keyboard flush - Used to avoid double key presses
SUB PAUSE (Dlay)
DIM Start AS DOUBLE
Start = TIMER
IF Start > TIMER THEN Start = Start - 86400 'Midnight issue
DO WHILE Start + Dlay >= TIMER: LOOP
KEYCLEAR 'Clear any key press
END SUB
You might want to fix the last comment line at the top... unless you expect only forum members to write to you. No I actually didn't do a search for it ROFL.
You could load a text file into OpenOffice-dot-org/Libreoffice, format it the way you like and export to PDF. But this is just one office app that could do it. I have never ventured using Calc or database program for PDF export but it shouldn't be difficult to arrange.
11-27-2022, 11:49 AM (This post was last modified: 11-27-2022, 11:51 AM by NasaCow.)
(11-27-2022, 11:36 AM)mnrvovrfc Wrote: You might want to fix the last comment line at the top... unless you expect only forum members to write to you. No I actually didn't do a search for it ROFL.
You could load a text file into OpenOffice-dot-org/Libreoffice, format it the way you like and export to PDF. But this is just one office app that could do it. I have never ventured using Calc or database program for PDF export but it shouldn't be difficult to arrange.
Thanks, I'll put it off the board but leave it in the .zip. It isn't my daily email, it is one I use for these kind of things!
Luv that screen shot with Chalkboard Menu and pencil border, nice touch!
Maybe font writing too good for a chalkboard?
Also like idea of periodic reports to parents do you keep attendance records as well?
Maybe something more for Jr and Sr High levels, early warning system before train is completely off the rail.
Definitely a WIP, menu system looks good, be nice to have Mouse Clicks as well as arrows and Enter.
There seems to be no exit, cancel or escape from Data Entry for Student but I am sure you will discover that soon enough, maybe it's the Yes No?
For Pause, QB64 has
_Delay Secs
and you can do fractions of secs. Your Pause will race the CPU if for extended times.
Here is a progress of my Grade Keeper. It is really feeling like a student management system right now. I need to figure out to do a multiple page report without rewriting the wheel, but we will see. I also need to start on the gradebook side. I have ideas (homework completion is one vs strict 100-point grade which is useless in primary per se)
A lot of additions and changes. I know, I know, no mouse. I have never really dug into mouse use, but I can program how to read my PS3 controller (priorities right?) I will look at that after adding a basic grade book perhaps? Maybe a more experienced programmer can say good idea/bad idea. My longest program yet running over 1,500 lines.
Well, all constructive feedback is welcome. I also include a few fun files to let you play around without too much setup if you like.
Code: (Select All)
'====================================================================================
'| |
'| Grade Keeper Build 3 V: 0.4 |
'| Release #2 December 2022 |
'| Additions: #1 - Major student database functions work (add, modify, delete) |
'| #2 - Teacher info collected |
'| #3 - Teacher reports established (except for index cards) |
'| #4 - Ability to remove program files. |
'| |
'| Modifications: #1 - Pause now doesn't race the CPU |
'| #2 - Start transition to building data screens (less files) |
'| #3 - Loops limited to prevent CPU racing |
'| |
'| Current Limitations: #1 - Student records limited to 33 students |
'| #2 - Printed reports limited to windows |
'| #3 = Printed reports limited to 1 page |
'| |
'====================================================================================
'$DYNAMIC
$NOPREFIX
OPTION EXPLICIT
OPTION BASE 1
'Standard file # list (Same # throughout for one file type)
'#1 is namelist.gkn for student name list
'#2 is teacher.gkn for teacher and school info
CONST FALSE = 0, TRUE = NOT FALSE, LIMITRATE = 20, TIME = .1 'Global loop speed limit to control CPU usage: Delay timer
TYPE NameListType 'Used for the student name database
PinYinName AS STRING * 20
FirstName AS STRING * 20
MiddleName AS STRING * 20
LastName AS STRING * 20
Year AS INTEGER
Month AS INTEGER
Day AS INTEGER
HouseColor AS STRING * 8
MomName AS STRING * 30
MomPhone AS STRING * 20 'Saved as string to support symbols and international prefixes
MomEmail AS STRING * 38
DadName AS STRING * 30
DadPhone AS STRING * 20
DadEmail AS STRING * 38
END TYPE
TYPE TeacherType 'Info for reports and such
TeacherName AS STRING * 50
School AS STRING * 100
Grade AS STRING * 10
Class AS STRING * 10
Classroom AS STRING * 10
END TYPE
DIM SHARED AS NameListType NameList(10) 'Student list
DIM SHARED AS TeacherType Teacher 'Teacher/class info
DIM SHARED AS LONG ScreenPointer(5), Arial8, Arial12, Arial16 'Screen & font handles
DIM SHARED AS LONG Arial24, Arial32, Arial48, Arial60 'Font handles
DIM SHARED AS LONG Intro, AboutPic, Current, CheckSelect, Report, BlankData 'Picture handles
DIM SHARED AS LONG NewNameEntry, DisplayStudentData, CurrentLayout, Generic 'Picture handles
DIM SHARED AS INTEGER Counter 'Throw-away counter
DIM SHARED AS INTEGER NumberOfStudents
DIM SHARED AS INTEGER Pointer 'Used for menu selections
DIM SHARED AS BIT SelectFlag 'Used to prevent graphic glitches and/or escape loops
'Loading needed screen space
TITLE "Grade Keeper Alpha Version 0.4"
DISPLAY 'Turn off Auto Display
SCREEN NEWIMAGE(1280, 720, 32)
SCREENMOVE 0, 0
ScreenPointer(1) = DEST 'Main screen
FOR Counter = 2 TO 5 'Screen 5 is exclusive use of QUICKMESSAGE text printing
ScreenPointer(Counter) = NEWIMAGE(1280, 720, 32)
NEXT Counter
'Font sizes
Arial8 = LOADFONT("data/assets/arial.ttf", 8) 'For grades and later use
Arial12 = LOADFONT("data/assets/arial.ttf", 12) 'For grades and later use
Arial16 = LOADFONT("data/assets/arial.ttf", 16) 'For grades and later use
Arial24 = LOADFONT("data/assets/arial.ttf", 24)
Arial32 = LOADFONT("data/assets/arial.ttf", 32)
Arial48 = LOADFONT("data/assets/arial.ttf", 48)
Arial60 = LOADFONT("data/assets/arial.ttf", 60)
DO: LIMIT LIMITRATE: MAINMENU: LOOP 'Main program loop
SYSTEM
errorhandle: 'Error handling
DIM AS STRING ErrorCode
ErrorCode = "Error" + STR$(ERR) + " on program file line" + STR$(ERRORLINE) + ". Program will end."
QUICKMESSAGE ErrorCode, 48, 1
SYSTEM
SUB MAINMENU
IF NOT FILEEXISTS("data/current/teacher.gkn") THEN 'prompt for teacher info if not on record
QUICKMESSAGE "Please go to " + CHR$(34) + "options" + CHR$(34) + CHR$(26) + CHR$(34) +_
"teacher info" + CHR$(34) + " to enter your name and school. Thank you!", 32, 1
ELSE
OPEN "data/current/teacher.gkn" FOR INPUT AS #2
AUTODISPLAY
IF LOF(2) = 200 THEN 'Corruption and tamper check
INPUT #2, Teacher.TeacherName
INPUT #2, Teacher.School
INPUT #2, Teacher.Grade
INPUT #2, Teacher.Class
INPUT #2, Teacher.Classroom
ELSE
QUICKMESSAGE "Teacher file corrupted! Please reenter data on the option screen.", 32, 1
END IF
CLOSE #2
END IF
Pointer = 0: SelectFlag = FALSE
PAUSE (TIME)
SCREEN ScreenPointer(1)
DO
LIMIT LIMITRATE
CLS
PUTIMAGE (0, 0), Intro
SELECT CASE Pointer
CASE 0: PUTIMAGE (375, 221), CheckSelect
CASE 1: PUTIMAGE (375, 292), CheckSelect
CASE 2: PUTIMAGE (375, 365), CheckSelect
CASE 3: PUTIMAGE (375, 437), CheckSelect
CASE 4: PUTIMAGE (375, 510), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE (TIME) 'Avoid double press delay
SelectFlag = FALSE
'Checking for key press (keyboard)
IF KEYDOWN(CVI(CHR$(0) + "H")) THEN ' up case
IF Pointer = 0 THEN Pointer = 4 ELSE Pointer = Pointer - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(CVI(CHR$(0) + "P")) THEN 'down case
IF Pointer = 4 THEN Pointer = 0 ELSE Pointer = Pointer + 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) 'Return/Spacebar to select
SELECT CASE Pointer
CASE 0: CURRENTCLASS
CASE 1: 'ARCHIVEDCLASS
CASE 2: OPTIONS
CASE 3: ABOUT
CASE 4: SYSTEM
END SELECT
END SUB
'For configuration & archiving/restoring existing classes - Future release
SUB OPTIONS
DIM AS INTEGER Row, Column
DIM AS LONG Script
SCREEN ScreenPointer(2)
Pointer = 0
DO
LIMIT LIMITRATE
DO
'Prepare and draw the menu
LIMIT LIMITRATE
CLS
PUTIMAGE , Generic
Script = LOADFONT("data/assets/script.ttf", 96)
FONT Script
Row = 2: Column = 1280 / 2 - PRINTWIDTH("Options") / 2
LOCATE Row, Column: PRINT "Options";
FONT Arial24
FREEFONT Script
Script = LOADFONT("data/assets/script.ttf", 60)
FONT Script
Row = 5: Column = 250
LOCATE Row, Column: PRINT "Teacher Info"
LOCATE Row + 1, Column: PRINT "Archive Current Class & Gradebook(s)"
LOCATE Row + 2, Column: PRINT "Program Reset Options"
LOCATE Row + 3, Column: PRINT "Back"
FONT Arial24
FREEFONT Script
SELECT CASE Pointer
CASE 0: PUTIMAGE (190, 240), CheckSelect
CASE 1: PUTIMAGE (190, 300), CheckSelect
CASE 2: PUTIMAGE (190, 360), CheckSelect
CASE 3: PUTIMAGE (190, 420), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE (.125) 'Avoid double press delay
SelectFlag = FALSE
'Checking for key press (keyboard)
IF KEYDOWN(CVI(CHR$(0) + "H")) THEN ' up case
IF Pointer = 0 THEN Pointer = 3 ELSE Pointer = Pointer - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(CVI(CHR$(0) + "P")) THEN 'down case
IF Pointer = 3 THEN Pointer = 0 ELSE Pointer = Pointer + 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) 'Return or Space bar to select
'Execute choice
SELECT CASE Pointer
CASE 0: TEACHERINFO
CASE 1: 'Future release
CASE 2: RESETPROGRAM
END SELECT
LOOP UNTIL Pointer = 3
SCREEN ScreenPointer(1)
END SUB
'Deletes data files as requested
SUB RESETPROGRAM
DIM AS INTEGER X, Y
DIM AS STRING Delete
DIM AS BYTE DeleteTeacher, DeleteStudents
DeleteTeacher = FALSE: DeleteStudents = FALSE
'Required warning
BEEP
QUICKMESSAGE "This operation is unrecoverable!", 60, 2
BEEP
QUICKMESSAGE "Note: Printed reports WILL NOT be removed. Please take care of student data.", 32, 2
SCREEN ScreenPointer(3)
CLS: PUTIMAGE , Generic
FONT Arial32
AUTODISPLAY
'#1 - Student name list
IF FILEEXISTS("data/current/namelist.gkn") THEN
X = 1280 / 2 - PRINTWIDTH("Remove ALL Student infomation (type all caps YES to confirm)? ") / 2
Y = (HEIGHT / FONTHEIGHT) / 2 - 5
LOCATE Y, X: INPUT "Remove ALL Student infomation (type all caps YES to confirm)? ", Delete
IF Delete = "YES" THEN DeleteStudents = TRUE
ELSE
QUICKMESSAGE "Student info NOT ON FILE. No action required.", 32, 3
END IF
'#2 - Teacher and school info
IF FILEEXISTS("data/current/teacher.gkn") THEN
X = 1280 / 2 - PRINTWIDTH("Remove teacher & school info (type all caps YES to confirm)? ") / 2
Y = Y + 2
LOCATE Y, X: INPUT "Remove teacher & school info (type all caps YES to confirm)? ", Delete
IF Delete = "YES" THEN DeleteTeacher = TRUE
ELSE
QUICKMESSAGE "Teacher info NOT ON FILE. No action required.", 32, 3
END IF
'Build our delete file string or escape for abort
Delete = ""
IF DeleteStudents THEN
Delete = "student information"
ELSEIF DeleteTeacher THEN
Delete = "teacher information"
END IF
IF DeleteTeacher AND DeleteStudents THEN
Delete = Delete + " and teacher information"
ELSEIF NOT DeleteTeacher AND NOT DeleteStudents THEN
Delete = "no files"
END IF
IF DeleteStudents OR DeleteTeacher THEN
Delete = "You are removing " + Delete + "."
ELSE
BEEP
QUICKMESSAGE "No action taken. Please try again if you desire.", 32, 3
PAUSE TIME
DISPLAY
SCREEN ScreenPointer(2)
EXIT SUB
END IF
'Final comfirmation
X = 1280 / 2 - PRINTWIDTH(Delete) / 2
Y = Y + 2
LOCATE Y, X: PRINT Delete
X = 1280 / 2 - PRINTWIDTH("Are you sure (Type YES to confirm? ") / 2
Y = Y + 1
LOCATE Y, X: INPUT "Are you sure (Type YES to confirm? ", Delete
'Execute file removal or abort
IF Delete = "YES" AND (DeleteStudents OR DeleteTeacher) THEN
IF DeleteStudents THEN KILL "data/current/namelist.gkn"
IF DeleteTeacher THEN KILL "data/current/teacher.gkn"
BEEP
QUICKMESSAGE "Files deleted. Please take care of all printed reports.", 32, 3
ELSE
BEEP
QUICKMESSAGE "No action taken. Please try again if you desire.", 32, 3
END IF
PAUSE TIME
DISPLAY
SCREEN ScreenPointer(2)
END SUB
SUB CURRENTCLASS
PAUSE (TIME)
Pointer = 0
DO
LIMIT LIMITRATE
DO
LIMIT LIMITRATE
CLS 'Prepare and draw the menu
PUTIMAGE (0, 0), Current
SELECT CASE Pointer
CASE 0: PUTIMAGE (260, 190), CheckSelect
CASE 1: PUTIMAGE (260, 280), CheckSelect
CASE 2: PUTIMAGE (260, 380), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE (.125) 'Avoid double press delay
SelectFlag = FALSE
'Checking for key press (keyboard)
IF KEYDOWN(CVI(CHR$(0) + "H")) THEN ' up case
IF Pointer = 0 THEN Pointer = 2 ELSE Pointer = Pointer - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(CVI(CHR$(0) + "P")) THEN 'down case
IF Pointer = 2 THEN Pointer = 0 ELSE Pointer = Pointer + 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) 'Return or Space bar to select
'Execute choice
SELECT CASE Pointer
CASE 0: 'LOADGRADES
CASE 1: LOADNAMES
END SELECT
LOOP UNTIL Pointer = 2
END SUB
SUB LOADGRADES 'Future release
END SUB
SUB LOADNAMES
DIM AS INTEGER Rows, Columns, RowStep, ColumnStep, StartX, StartY, OffsetX
DIM AS STRING FirstName, LastName
DIM AS INTEGER Highlight(500000)
DIM AS BIT Selected, Back
IF FILEEXISTS("data/current/namelist.gkn") THEN 'Display current list if it exists
LOADSTUDENTDATA
SORT 1
DIM AS INTEGER BuildCounter
Rows = 3: Counter = 1: StartX = 4: StartY = (Rows - 1) * FONTHEIGHT(Arial32)
DO 'Keep looping until explicitly told to return to prior menu
LIMIT LIMITRATE
FONT Arial32
BuildCounter = 1: Rows = 3: Columns = 15: RowStep = FONTHEIGHT(Arial32): ColumnStep = 625: OffsetX = 604
Back = FALSE
CLS
PUTIMAGE (0, 0), CurrentLayout 'Simple box layout
WHILE BuildCounter <= NumberOfStudents 'Prints student names to screen
FirstName = TRIM$(NameList(BuildCounter).FirstName)
LastName = TRIM$(NameList(BuildCounter).LastName)
LOCATE Rows, Columns: PRINT FirstName + " " + LastName
BuildCounter = BuildCounter + 1
Rows = Rows + 1
IF BuildCounter = 19 THEN
Rows = 3
Columns = 15 + ColumnStep
END IF
WEND
LOCATE Rows, Columns: PRINT "Add student to class"
LOCATE Rows + 1, Columns: PRINT "Whole class data reports"
LOCATE Rows + 2, Columns: PRINT "Go back to the prior screen"
Selected = FALSE
PAUSE (TIME)
GET (StartX, StartY)-(StartX + OffsetX, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
DO 'GUI student interface selection
LIMIT LIMITRATE
DISPLAY
IF KEYDOWN(18432) THEN 'up case
IF Counter = 1 THEN 'Top of table check
'Do nothing, ignore key press
ELSE 'Process the change
GET (StartX, StartY)-(StartX + OffsetX, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
IF Counter = 19 THEN
StartX = 4
StartY = 640
END IF
StartY = StartY - RowStep
GET (StartX, StartY)-(StartX + OffsetX, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
Counter = Counter - 1
PAUSE (TIME)
END IF
END IF
IF KEYDOWN(20480) THEN 'down case
IF NumberOfStudents + 3 = Counter THEN 'Bottom of table check
'Do nothing, ignore key press
ELSE 'Process the change
GET (StartX, StartY)-(StartX + OffsetX, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
IF Counter = 18 THEN
StartX = 628
StartY = 32
END IF
StartY = StartY + RowStep
GET (StartX, StartY)-(StartX + OffsetX, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
Counter = Counter + 1
PAUSE (TIME)
END IF
END IF
IF KEYDOWN(19712) THEN 'right case
IF StartX = 628 OR Counter + 18 > NumberOfStudents + 3 THEN 'Already on the left or going off table
'Do nothing, ignore key press
ELSE
GET (StartX, StartY)-(StartX + OffsetX, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
StartX = 628
GET (StartX, StartY)-(StartX + OffsetX, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
Counter = Counter + 18
PAUSE (TIME)
END IF
END IF
IF KEYDOWN(19200) THEN 'left case
IF StartX = 4 THEN 'Already on the left
'Do nothing, ignore key press
ELSE
GET (StartX, StartY)-(StartX + OffsetX, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
StartX = 4
GET (StartX, StartY)-(StartX + OffsetX, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
Counter = Counter - 18
PAUSE (TIME)
END IF
END IF
IF KEYDOWN(13) OR KEYDOWN(32) THEN 'Select a choice and exit the loop
Selected = TRUE
PAUSE (TIME)
GET (StartX, StartY)-(StartX + OffsetX, StartY + RowStep), Highlight()
PUT (StartX, StartY), Highlight(), PRESET
END IF
LOOP WHILE NOT Selected
SELECT CASE Counter 'Process selected choice
CASE 1 TO NumberOfStudents: SHOWSTUDENTDATA Counter: SORT 1
CASE NumberOfStudents + 1: ADDSTUDENT: SORT 1
Rows = 3: Counter = 1 'Start at the top of the list
StartX = 4: StartY = (Rows - 1) * FONTHEIGHT(Arial32)
CASE NumberOfStudents + 2: STUDENTREPORTS
CASE NumberOfStudents + 3: Back = TRUE 'Return to prior meny
END SELECT
LOOP UNTIL Back
PAUSE (TIME)
ELSE
CREATESTUDENTLIST
END IF
END SUB
'Displays student data to screen and modifies or deletes said student
SUB SHOWSTUDENTDATA (Student AS INTEGER)
DIM AS BIT ExitFlag
ExitFlag = FALSE
SCREEN ScreenPointer(2)
CLS
PUTIMAGE (0, 0), DisplayStudentData
FONT Arial24
QUICKPRINTSTUDENTDATA NameList(Student), Student
DISPLAY
PAUSE (TIME)
DO
LIMIT LIMITRATE
IF KEYDOWN(109) OR KEYDOWN(77) THEN 'Modify a student
DIM AS NameListType UpdateData 'Holds data, only overwrites fields with data present
DIM AS STRING Blank8, Blank20, Blank30 'Used to check for blank entries of fixed strings
Blank8 = " "
Blank20 = " "
Blank30 = " "
ExitFlag = FALSE
COLOR RGB32(196, 255, 14)
FONT Arial32
LOCATE 19, 750: PRINT "If a data field requires no update,"
LOCATE 20, 750: PRINT "you may just press enter."
DISPLAY
COLOR RGB32(255, 255, 255)
FONT Arial24
AUTODISPLAY
LOCATE 7, 140: PRINT Counter 'Built with Arial24
PAUSE (TIME)
LOCATE 7, 280: INPUT "", UpdateData.PinYinName
DO
LOCATE 7, 710: PRINT " "
LOCATE 7, 710: INPUT "", UpdateData.Month
LOOP UNTIL UpdateData.Month = 0 OR (UpdateData.Month > 0 AND UpdateData.Month < 13)
DO
LOCATE 7, 780: PRINT " "
LOCATE 7, 780: INPUT "", UpdateData.Day
LOOP UNTIL UpdateData.Day = 0 OR (UpdateData.Day > 0 AND UpdateData.Day < 32)
DO
LOCATE 7, 840: PRINT " "
LOCATE 7, 840: INPUT "", UpdateData.Year
LOOP UNTIL UpdateData.Year = 0 OR (UpdateData.Year > 2000 AND UpdateData.Year < 2100)
LOCATE 7, 970: INPUT "", UpdateData.HouseColor
LOCATE 12, 55: INPUT "", UpdateData.FirstName
LOCATE 12, 400: INPUT "", UpdateData.MiddleName
LOCATE 12, 780: INPUT "", UpdateData.LastName
LOCATE 17, 55: INPUT "", UpdateData.MomName
LOCATE 17, 400: INPUT "", UpdateData.MomPhone
LOCATE 17, 780: INPUT "", UpdateData.MomEmail
LOCATE 22, 55: INPUT "", UpdateData.DadName
LOCATE 22, 400: INPUT "", UpdateData.DadPhone
LOCATE 22, 780: INPUT "", UpdateData.DadEmail
DISPLAY
IF UpdateData.PinYinName = Blank20 THEN UpdateData.PinYinName = NameList(Student).PinYinName 'Replace blank entries with current data
IF UpdateData.FirstName = Blank20 THEN UpdateData.FirstName = NameList(Student).FirstName
IF UpdateData.MiddleName = Blank20 THEN UpdateData.MiddleName = NameList(Student).MiddleName
IF UpdateData.LastName = Blank20 THEN UpdateData.LastName = NameList(Student).LastName
IF UpdateData.Year = 0 THEN UpdateData.Year = NameList(Student).Year
IF UpdateData.Month = 0 THEN UpdateData.Month = NameList(Student).Month
IF UpdateData.Day = 0 THEN UpdateData.Day = NameList(Student).Day
IF UpdateData.HouseColor = Blank8 THEN UpdateData.HouseColor = NameList(Student).HouseColor
IF UpdateData.MomName = Blank30 THEN UpdateData.MomName = NameList(Student).MomName
IF UpdateData.MomPhone = Blank20 THEN UpdateData.MomPhone = NameList(Student).MomPhone
IF UpdateData.MomEmail = Blank30 + Blank8 THEN UpdateData.MomEmail = NameList(Student).MomEmail
IF UpdateData.DadName = Blank30 THEN UpdateData.DadName = NameList(Student).DadName
IF UpdateData.DadPhone = Blank20 THEN UpdateData.DadPhone = NameList(Student).DadPhone
IF UpdateData.DadEmail = Blank30 + Blank8 THEN UpdateData.DadEmail = NameList(Student).DadEmail
CLS
PUTIMAGE (0, 0), DisplayStudentData
QUICKPRINTSTUDENTDATA UpdateData, Student
FONT Arial32
COLOR RGB32(147, 237, 255)
LOCATE 18, 75: PRINT "Saving this change to the list. "
LOCATE 19, 75: PRINT "Press Enter to confirm, any other key to abort. "
LOCATE 20, 75: PRINT " "
LOCATE 21, 75: PRINT " ";
COLOR RGB(255, 255, 255)
FONT Arial24
DISPLAY
PAUSE (TIME)
DO
LIMIT LIMITRATE
IF KEYDOWN(13) THEN
DIM AS INTEGER LoopCounter
ExitFlag = TRUE
UPDATESTUDENTLIST UpdateData, Student
OPEN "data/current/namelist.gkn" FOR OUTPUT AS #1
FOR LoopCounter = 1 TO NumberOfStudents
WRITESTUDENTLIST NameList(LoopCounter)
NEXT LoopCounter
CLOSE #1
QUICKMESSAGE "File updated succesfully!", 48, 2
ELSEIF KEYHIT THEN
ExitFlag = TRUE
QUICKMESSAGE "Modification discarded, please try agian if you need to make changes.", 32, 2
END IF
LOOP UNTIL ExitFlag
ELSEIF KEYDOWN(100) OR KEYDOWN(83) THEN 'delete student
FONT Arial32
COLOR RGB32(255, 79, 79)
LOCATE 18, 75: PRINT "Deleting student from list. Once done, cannot be reversed"
LOCATE 19, 75: PRINT " ARE YOU SURE? "
LOCATE 20, 75: PRINT " "
LOCATE 21, 75: PRINT "Press K to confirm, any other key to abort. ";
COLOR RGB(255, 255, 255)
FONT Arial24
DISPLAY
PAUSE (TIME)
DO
LIMIT LIMITRATE
IF KEYDOWN(107) OR KEYDOWN(75) THEN 'K hit, delete confirmed.
DIM AS INTEGER DeleteCounter
OPEN "data/current/namelist.gkn" FOR OUTPUT AS #1
IF Counter = NumberOfStudents THEN 'Deleting the last student
FOR DeleteCounter = 1 TO NumberOfStudents - 1
WRITESTUDENTLIST NameList(DeleteCounter)
NEXT DeleteCounter
ELSEIF Counter = 1 THEN 'Deleting the first student
FOR DeleteCounter = 2 TO NumberOfStudents
UPDATESTUDENTLIST NameList(DeleteCounter), DeleteCounter - 1
WRITESTUDENTLIST NameList(DeleteCounter - 1)
NEXT DeleteCounter
ELSE 'Deleting a student in the middle of the list
FOR DeleteCounter = Counter + 1 TO NumberOfStudents
UPDATESTUDENTLIST NameList(DeleteCounter), DeleteCounter - 1
NEXT DeleteCounter
FOR DeleteCounter = 1 TO NumberOfStudents - 1
WRITESTUDENTLIST NameList(DeleteCounter)
NEXT DeleteCounter
END IF
CLOSE #1
NumberOfStudents = NumberOfStudents - 1
ExitFlag = TRUE
QUICKMESSAGE "Deletion confirmed. File updated succesfully!", 48, 2
ELSEIF KEYHIT THEN
ExitFlag = TRUE
QUICKMESSAGE "Deletion cancelled. Try again if desired.", 48, 2
END IF
LOOP UNTIL ExitFlag
ELSEIF INKEY$ <> "" THEN ExitFlag = TRUE
END IF
LOOP UNTIL ExitFlag
SCREEN ScreenPointer(1)
END SUB
SUB STUDENTREPORTS
DIM AS BIT Back
DIM AS INTEGER ReportCounter
SCREEN ScreenPointer(2)
ReportCounter = 0
SelectFlag = FALSE: Back = FALSE
PAUSE (TIME)
DO
LIMIT LIMITRATE
DO
LIMIT LIMITRATE
CLS
PUTIMAGE (0, 0), Report
SELECT CASE ReportCounter
CASE 0: PUTIMAGE (285, 170), CheckSelect
CASE 1: PUTIMAGE (285, 240), CheckSelect
CASE 2: PUTIMAGE (285, 310), CheckSelect
CASE 3: PUTIMAGE (285, 380), CheckSelect
CASE 4: PUTIMAGE (285, 455), CheckSelect
CASE 5: PUTIMAGE (285, 525), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE (TIME) 'Avoid double press delay
SelectFlag = FALSE
'Checking for key press (keyboard)
IF KEYDOWN(18432) THEN ' up case
IF ReportCounter = 0 THEN ReportCounter = 5 ELSE ReportCounter = ReportCounter - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(20480) THEN 'down case
IF ReportCounter = 5 THEN ReportCounter = 0 ELSE ReportCounter = ReportCounter + 1
SelectFlag = TRUE
END IF
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) 'Return or Spacebar to select
SELECT CASE ReportCounter
CASE 0: REPORTWRITER "Birthday Report", 2
CASE 1: REPORTWRITER "Index Cards", 2
CASE 2: REPORTWRITER "House Color Groupings", 2
CASE 3: REPORTWRITER "Name List", 2
CASE 4: REPORTWRITER "Parent Contact Info", 2
CASE 5: Back = TRUE
END SELECT
PAUSE (TIME)
LOOP UNTIL Back
SCREEN ScreenPointer(1)
END SUB
SUB ARCHIVEDCLASS 'Prior year record keeping - Future release
END SUB
'===========Support Subs/Functions===========
'Quick about the program and the release to public domain
SUB ABOUT
DIM AS LONG Script
CLS
PUTIMAGE (0, 0), Generic
Script = LOADFONT("data\assets\script.ttf", 60)
FONT Script: LOCATE 2, 1280 / 2 - PRINTWIDTH("Grade Keeper") / 2: PRINT "Grade Keeper"
FONT Arial32: LOCATE 8, 1280 / 2 - PRINTWIDTH("Alpha Version 0.4") / 2: PRINT "Alpha Version 0.4"
FONT Arial24: LOCATE 15, 50: PRINT "Public alpha release #2. Built November 27th, 2022. Released as non-commercial and share alike as defined"
LOCATE 16, 50: PRINT "by the creative commons 4.0. May not apply any additional legal terms nor technological measures that"
LOCATE 17, 50: PRINT "legally restrict others from doing anything that the license permits. Please contact NasaCow at"
LOCATE 18, 50: PRINT "NasaCowPro@gmail.com with any questions or feedback. No warranty or guarantee explicitly or implicitly"
LOCATE 19, 50: PRINT "made with the use of this software."
LOCATE 28, 50: PRINT "Press any key to go back..."
FREEFONT Script
DISPLAY
SLEEP
END SUB
'Writes reports with PRINTIMAGE (one page limit currently)
SUB REPORTWRITER (ReportName AS STRING, SourceScreen AS INTEGER)
DIM AS INTEGER PageH, PageW, PageS 'Height, Width, Scale (higher is clearer)
DIM AS INTEGER FSize, FHeight 'Size is used to set the height
DIM AS INTEGER X, Y, YReturn, MaxY 'Location on page
DIM AS INTEGER PrintCounter, StartPointer 'DO/LOOP index: Where to start in the namelist
DIM AS INTEGER LongName 'Longest name on the student list (first name + last name)
DIM AS LONG Page, Script, Cursive 'Paper, Report font, cursive font for logo
DIM AS STRING School, Teach, Location, DateAndTime 'Preparing teacher info for printer
DIM AS STRING * 1 Confirm
DIM AS BYTE WantGrid, WantMother 'Used to estblish a grid or just names.
SCREEN ScreenPointer(4)
FONT Arial32
'Collect info for the "Name List" report before the please wait screen is displayed...
IF ReportName = "Name List" THEN
CLS: PUTIMAGE (0, 0), Generic
X = (HEIGHT / FONTHEIGHT) / 2 - 1
Y = 1280 / 2 - PRINTWIDTH("Do you wish to have a grid boxing with the name list (Y/N)? ") / 2
AUTODISPLAY
DO
LOCATE X, Y: INPUT "Do you wish to have a grid boxing with the name list (Y/N)? ", Confirm
LOOP UNTIL UCASE$(Confirm) = "Y" OR UCASE$(Confirm) = "N"
DISPLAY
IF UCASE$(Confirm) = "Y" THEN WantGrid = TRUE ELSE WantGrid = FALSE
PAUSE (TIME)
END IF
'Collect info for the "Name List" report before the please wait screen is displayed...
IF ReportName = "Parent Contact Info" THEN
CLS: PUTIMAGE (0, 0), Generic
X = (HEIGHT / FONTHEIGHT) / 2 - 1
Y = 1280 / 2 - PRINTWIDTH("Do you wish to have the mother's or father's info (M/F)? ") / 2
AUTODISPLAY
DO
LOCATE X, Y: INPUT "Do you wish to have the mother's or father's info (M/F)? ", Confirm
LOOP UNTIL UCASE$(Confirm) = "M" OR UCASE$(Confirm) = "F"
DISPLAY
IF UCASE$(Confirm) = "M" THEN WantMother = TRUE ELSE WantMother = FALSE
PAUSE (TIME)
END IF
'Make a wait screen, printer prep takes more than a few seconds...
CLS: PUTIMAGE (0, 0), Generic
X = (HEIGHT / FONTHEIGHT) / 2 - 1
Y = 1280 / 2 - PRINTWIDTH("Report is being generated,") / 2
LOCATE X - 1, Y: PRINT "Report is being generated."
Y = 1280 / 2 - PRINTWIDTH("Standby for printer selection...") / 2
LOCATE X, Y: PRINT "Standby for printer selection..."
Y = 1280 / 2 - PRINTWIDTH("Please press nothing while waiting") / 2
LOCATE X + 2, Y: PRINT "Please press nothing while waiting"
DISPLAY
'Building the page and fonts needed
FHeight = INT(FSize * 0.3527 * PageS) 'Formula for a font size
Script = LOADFONT("Data\Assets\arial.ttf", FHeight) 'Load the print font at the proper size
Cursive = LOADFONT("Data\Assets\script.ttf", FHeight) 'Load the cursive font at the proper size
Page = NEWIMAGE(PageW, PageH, 32) 'Create the page
DEST Page: CLS , RGB(255, 255, 255) 'Page set for writing with a white background
FONT Script 'Makes printing text active, done after setting DEST
COLOR RGB(0, 0, 0), RGBA(0, 0, 0, 0) 'Black text with a clear background
'Print the common header of the reports
X = PageW / 2 - PRINTWIDTH(ReportName) / 2: Y = FHeight * 3
PRINTSTRING (X, Y), ReportName
X = PageW / 2 - PRINTWIDTH(Teach) / 2: Y = Y + FHeight * 2
PRINTSTRING (X, Y), Teach
X = PageW / 2 - PRINTWIDTH(School) / 2: Y = Y + FHeight
PRINTSTRING (X, Y), School
X = PageW / 2 - PRINTWIDTH(Location) / 2: Y = Y + FHeight
PRINTSTRING (X, Y), Location
X = PageW / 2 - PRINTWIDTH(DateAndTime) / 2: Y = Y + FHeight
PRINTSTRING (X, Y), DateAndTime
YReturn = Y + FHeight * 2
'Prints the selected report
SELECT CASE ReportName
CASE "Birthday Report":
DIM AS INTEGER CurrentYear
DIM AS BYTE NoLoop 'For no birthdays in the last 4 months of the year (Start printing in Jan.)
SORT 2 'Sort by Birthday
PrintCounter = 0: StartPointer = 0: NoLoop = FALSE
X = 20 * PageS: Y = Y + FHeight * 2
PRINTSTRING (X, Y), "Name"
X = 70 * PageS
PRINTSTRING (X, Y), "Birthday"
X = 180 * PageS
PRINTSTRING (X, Y), "Age"
X = 20 * PageS: Y = Y + FHeight
LINE (X, Y)-(190 * PageS, Y + .5 * PageS), , BF
Y = Y + FHeight * .5
IF VAL(LEFT$(DATE$, 2)) >= 9 THEN CurrentYear = VAL(RIGHT$(DATE$, 4)) ELSE CurrentYear = VAL(RIGHT$(DATE$, 4)) - 1 'Age needs the correct current year for the school year
DO 'Loop searches for the first entry that starts in September or later
PrintCounter = PrintCounter + 1
StartPointer = NameList(PrintCounter).Month
LOOP UNTIL StartPointer >= 9 OR PrintCounter = NumberOfStudents
IF StartPointer < 9 THEN
StartPointer = 1 'On the off-chance of no birthdays in the last 4 months of the year
CurrentYear = CurrentYear + 1 'And advance to next year
NoLoop = TRUE 'Print all at once
END IF
StartPointer = PrintCounter - 1 'Maintain our place in the list
FOR PrintCounter = PrintCounter TO NumberOfStudents 'Print from September to tbe end of the year
PRINTSTRING (X, Y), TRIM$(NameList(PrintCounter).FirstName) + " " + TRIM$(NameList(PrintCounter).LastName)
X = 70 * PageS
PRINTSTRING (X, Y), BIRTHDAY$(NameList(PrintCounter).Month, NameList(PrintCounter).Day, CurrentYear)
X = 180 * PageS
PRINTSTRING (X, Y), STR$(CurrentYear - NameList(PrintCounter).Year)
X = 20 * PageS: Y = Y + FHeight * 1.15
NEXT PrintCounter
IF NOT NoLoop THEN 'Print the list from January to August if not already fully printed
CurrentYear = CurrentYear + 1
FOR PrintCounter = 1 TO StartPointer
PRINTSTRING (X, Y), TRIM$(NameList(PrintCounter).FirstName) + " " + TRIM$(NameList(PrintCounter).LastName)
X = 70 * PageS
PRINTSTRING (X, Y), BIRTHDAY$(NameList(PrintCounter).Month, NameList(PrintCounter).Day, CurrentYear)
X = 180 * PageS
PRINTSTRING (X, Y), STR$(CurrentYear - NameList(PrintCounter).Year)
X = 20 * PageS: Y = Y + FHeight * 1.15
NEXT PrintCounter
END IF
SORT 1 'Restore display sort
CASE "Index Cards": 'Planned report not possible with one page limit
FONT Arial24
FREEFONT Script
FREEFONT Cursive
SCREEN ScreenPointer(SourceScreen): DEST ScreenPointer(SourceScreen) 'Restore our prior screen
QUICKMESSAGE "This report is under development. Aborting...", 32, SourceScreen
EXIT SUB
CASE "House Color Groupings":
DIM AS INTEGER R, Ye, G, B, O, MissingColor, XLine
R = 0: Ye = 0: G = 0: B = 0: O = 0: MissingColor = 0
SORT 3 'Color sort (Should make it faster?)
'Count the number of students in each house
FOR PrintCounter = 1 TO NumberOfStudents
SELECT CASE UCASE$(TRIM$(NameList(PrintCounter).HouseColor))
CASE "RED": R = R + 1
CASE "YELLOW": Ye = Ye + 1
CASE "GREEN": G = G + 1
CASE "BLUE": B = B + 1
CASE "ORANGE": O = O + 1
CASE ELSE: MissingColor = MissingColor + 1 'For mistype and unplaced students
END SELECT
NEXT PrintCounter
'Blue house
YReturn = Y: X = 20 * PageS: Y = Y + FHeight * 2: PrintCounter = 0: StartPointer = 0
XLine = PRINTWIDTH("Blue House:") + X
PRINTSTRING (X, Y), "Blue House:"
Y = Y + FHeight
LINE (X, Y)-(XLine, Y + .5 * PageS), , BF
IF NOT B THEN
DO
StartPointer = StartPointer + 1
IF UCASE$(TRIM$(NameList(StartPointer).HouseColor)) = "BLUE" THEN
X = 25 * PageS: Y = Y + FHeight
PRINTSTRING (X, Y), TRIM$(NameList(StartPointer).FirstName) + " " + TRIM$(NameList(StartPointer).LastName)
PrintCounter = PrintCounter + 1
END IF
LOOP UNTIL PrintCounter = B
END IF
MaxY = Y 'To know how far down we have reached for the next major row
'Green house
Y = YReturn: X = 80 * PageS: Y = Y + FHeight * 2: PrintCounter = 0: StartPointer = 0
XLine = PRINTWIDTH("Green House:") + X
PRINTSTRING (X, Y), "Green House:"
Y = Y + FHeight
LINE (X, Y)-(XLine, Y + .5 * PageS), , BF
IF NOT G THEN
DO
StartPointer = StartPointer + 1
IF UCASE$(TRIM$(NameList(StartPointer).HouseColor)) = "GREEN" THEN
X = 95 * PageS: Y = Y + FHeight
PRINTSTRING (X, Y), TRIM$(NameList(StartPointer).FirstName) + " " + TRIM$(NameList(StartPointer).LastName)
PrintCounter = PrintCounter + 1
END IF
LOOP UNTIL PrintCounter = G
END IF
IF Y > MaxY THEN MaxY = Y 'Are we further down the page?
'Orange house
Y = YReturn: X = 140 * PageS: Y = Y + FHeight * 2: PrintCounter = 0: StartPointer = 0
XLine = PRINTWIDTH("Orange House:") + X
PRINTSTRING (X, Y), "Orange House:"
Y = Y + FHeight
LINE (X, Y)-(XLine, Y + .5 * PageS), , BF
IF NOT O THEN
DO
StartPointer = StartPointer + 1
IF UCASE$(TRIM$(NameList(StartPointer).HouseColor)) = "ORANGE" THEN
X = 145 * PageS: Y = Y + FHeight
PRINTSTRING (X, Y), TRIM$(NameList(StartPointer).FirstName) + " " + TRIM$(NameList(StartPointer).LastName)
PrintCounter = PrintCounter + 1
END IF
LOOP UNTIL PrintCounter = O
END IF
IF Y > MaxY THEN MaxY = Y 'Are we further down the page?
'Red house and next major row
Y = MaxY: X = 20 * PageS: Y = Y + FHeight * 2: PrintCounter = 0: StartPointer = 0
XLine = PRINTWIDTH("Red House:") + X
PRINTSTRING (X, Y), "Red House:"
Y = Y + FHeight
LINE (X, Y)-(XLine, Y + .5 * PageS), , BF
IF NOT R THEN
DO
StartPointer = StartPointer + 1
IF UCASE$(TRIM$(NameList(StartPointer).HouseColor)) = "RED" THEN
X = 25 * PageS: Y = Y + FHeight
PRINTSTRING (X, Y), TRIM$(NameList(StartPointer).FirstName) + " " + TRIM$(NameList(StartPointer).LastName)
PrintCounter = PrintCounter + 1
END IF
LOOP UNTIL PrintCounter = R
END IF
'Yellow house
Y = MaxY: X = 80 * PageS: Y = Y + FHeight * 2: PrintCounter = 0: StartPointer = 0
XLine = PRINTWIDTH("Yellow House:") + X
PRINTSTRING (X, Y), "Yellow House:"
Y = Y + FHeight
LINE (X, Y)-(XLine, Y + .5 * PageS), , BF
IF NOT Ye THEN
DO
StartPointer = StartPointer + 1
IF UCASE$(TRIM$(NameList(StartPointer).HouseColor)) = "YELLOW" THEN
X = 85 * PageS: Y = Y + FHeight
PRINTSTRING (X, Y), TRIM$(NameList(StartPointer).FirstName) + " " + TRIM$(NameList(StartPointer).LastName)
PrintCounter = PrintCounter + 1
END IF
LOOP UNTIL PrintCounter = Ye
END IF
'Unkown house
Y = MaxY: X = 140 * PageS: Y = Y + FHeight * 2: PrintCounter = 0: StartPointer = 0
XLine = PRINTWIDTH("House Unknown:") + X
PRINTSTRING (X, Y), "House Unknown:"
Y = Y + FHeight
LINE (X, Y)-(XLine, Y + .5 * PageS), , BF
IF NOT MissingColor THEN
DO
StartPointer = StartPointer + 1
IF UCASE$(TRIM$(NameList(StartPointer).HouseColor)) <> "ORANGE" OR UCASE$(TRIM$(NameList(StartPointer).HouseColor)) <> "BLUE" _
OR UCASE$(TRIM$(NameList(StartPointer).HouseColor)) <> "GREEN" OR UCASE$(TRIM$(NameList(StartPointer).HouseColor)) <> "YELLOW" _
OR UCASE$(TRIM$(NameList(StartPointer).HouseColor)) <> "RED" THEN
X = 145 * PageS: Y = Y + FHeight
IF TRIM$(NameList(StartPointer).HouseColor) = "" THEN NameList(StartPointer).HouseColor = "Unknown" 'Prints the current entry in case of data entry error
PRINTSTRING (X, Y), TRIM$(NameList(StartPointer).FirstName) + " " + TRIM$(NameList(StartPointer).LastName) + "-"
X = 150 * PageS: Y = Y + FHeight
PRINTSTRING (X, Y), NameList(StartPointer).HouseColor
PrintCounter = PrintCounter + 1
Y = Y + FHeight
END IF
LOOP UNTIL PrintCounter = MissingColor
END IF
SORT 1 'Restore display sort
CASE "Name List":
'Print the names to the sheet
X = 20 * PageS: Y = Y + FHeight * 2: LongName = 0
FOR PrintCounter = 1 TO NumberOfStudents
PRINTSTRING (X, Y), TRIM$(NameList(PrintCounter).FirstName) + " " + TRIM$(NameList(PrintCounter).LastName)
Y = Y + FHeight * 1.5
IF LongName < PRINTWIDTH(TRIM$(NameList(PrintCounter).FirstName) + " " + TRIM$(NameList(PrintCounter).LastName)) THEN 'Finds the longest name
LongName = PRINTWIDTH(TRIM$(NameList(PrintCounter).FirstName) + " " + TRIM$(NameList(PrintCounter).LastName))
END IF
NEXT PrintCounter
'Prints a grid if desired
IF WantGrid THEN
X = LongName + 21 * PageS: Y = YReturn - .25 * FHeight 'intial corner of box drawing
DO WHILE X < 180 * PageS 'Draw boxes horiztionally to the margin.
FOR PrintCounter = 1 TO NumberOfStudents 'Draw boxes vertically
LINE (X, Y)-(X + 15 * PageS, Y + .025 * FHeight), , BF
LINE -(X + 14.95 * PageS, Y + 1.25 * FHeight), , BF
LINE -(X, Y + 1.225 * FHeight), , BF
LINE -(X + .05 * PageS, Y), , BF
Y = Y + FHeight * 1.5
NEXT PrintCounter
X = X + 15 * PageS: Y = YReturn - .25 * FHeight
LOOP
END IF
CASE "Parent Contact Info":
DIM AS STRING MotherFather 'Are we printing the Mother or Father
DIM AS INTEGER XSpacing, MomDadLongName, MomDadLongPhone, MomDadLongEmail 'Used for spacing the report
'Printing mom's or dad's info to keep it to one page.
IF WantMother THEN MotherFather = "Mother's " ELSE MotherFather = "Father's "
'Finds the longest name, and parent info on our name list and print them to the report
YReturn = Y: X = 10 * PageS: Y = Y + FHeight * 3: XSpacing = PageS
FOR PrintCounter = 1 TO NumberOfStudents
PRINTSTRING (X, Y), TRIM$(NameList(PrintCounter).FirstName) + " " + TRIM$(NameList(PrintCounter).LastName)
Y = Y + FHeight * 1.15
IF LongName < PRINTWIDTH(TRIM$(NameList(PrintCounter).FirstName) + " " + TRIM$(NameList(PrintCounter).LastName)) THEN 'Finds the longest name
LongName = PRINTWIDTH(TRIM$(NameList(PrintCounter).FirstName) + " " + TRIM$(NameList(PrintCounter).LastName))
END IF
IF MotherFather = "Mother's " THEN
IF MomDadLongName < PRINTWIDTH(TRIM$(NameList(PrintCounter).MomName)) THEN MomDadLongName = PRINTWIDTH(TRIM$(NameList(PrintCounter).MomName))
IF MomDadLongEmail < PRINTWIDTH(TRIM$(NameList(PrintCounter).MomEmail)) THEN MomDadLongEmail = PRINTWIDTH(TRIM$(NameList(PrintCounter).MomEmail))
IF MomDadLongPhone < PRINTWIDTH(TRIM$(NameList(PrintCounter).MomPhone)) THEN MomDadLongPhone = PRINTWIDTH(TRIM$(NameList(PrintCounter).MomPhone))
ELSE
IF MomDadLongName < PRINTWIDTH(TRIM$(NameList(PrintCounter).DadName)) THEN MomDadLongName = PRINTWIDTH(TRIM$(NameList(PrintCounter).DadName))
IF MomDadLongEmail < PRINTWIDTH(TRIM$(NameList(PrintCounter).DadEmail)) THEN MomDadLongEmail = PRINTWIDTH(TRIM$(NameList(PrintCounter).DadEmail))
IF MomDadLongPhone < PRINTWIDTH(TRIM$(NameList(PrintCounter).DadPhone)) THEN MomDadLongPhone = PRINTWIDTH(TRIM$(NameList(PrintCounter).DadPhone))
END IF
NEXT PrintCounter
'Ensure our spacing is at least as long as our header
IF MomDadLongName < PRINTWIDTH(MotherFather + "name:") THEN MomDadLongName = PRINTWIDTH(MotherFather + "name:")
IF MomDadLongPhone < PRINTWIDTH(MotherFather + "phone:") THEN MomDadLongPhone = PRINTWIDTH(MotherFather + "phone:")
IF MomDadLongPhone < PRINTWIDTH(MotherFather + "email:") THEN MomDadLongPhone = PRINTWIDTH(MotherFather + "email:")
'Print the rest of the selected info
MaxY = Y: Y = YReturn + FHeight * 3
FOR PrintCounter = 1 TO NumberOfStudents
IF MotherFather = "Mother's " THEN
PRINTSTRING (X + LongName + XSpacing, Y), NameList(PrintCounter).MomName
PRINTSTRING (X + LongName + XSpacing + MomDadLongName + XSpacing, Y), NameList(PrintCounter).MomPhone
PRINTSTRING (X + LongName + XSpacing + MomDadLongName + XSpacing + MomDadLongPhone + XSpacing, Y), NameList(PrintCounter).MomEmail
ELSE
PRINTSTRING (X + LongName + XSpacing, Y), NameList(PrintCounter).DadName
PRINTSTRING (X + LongName + XSpacing + MomDadLongName + XSpacing, Y), NameList(PrintCounter).DadPhone
PRINTSTRING (X + LongName + XSpacing + MomDadLongName + XSpacing + MomDadLongPhone + XSpacing, Y), NameList(PrintCounter).DadEmail
END IF
LINE (X, Y + FHeight)-(X + XSpacing * 3 + LongName + MomDadLongName + MomDadLongPhone + MomDadLongEmail - .15 * PageS, Y + 1.05 * FHeight), , BF 'Line spliting rows
Y = Y + FHeight * 1.15
NEXT PrintCounter
'Print the sub-header (mom or dad) with grid lines
X = 10 * PageS: Y = YReturn + FHeight * 2
LINE (X, Y + FHeight)-(X - .15 * PageS, MaxY - .15 * FHeight), , BF 'Top-left to bottom-left
LINE -(X + XSpacing * 3 + LongName + MomDadLongName + MomDadLongPhone + MomDadLongEmail, MaxY - .1 * FHeight), , BF 'to bottom-right
LINE -(X + XSpacing * 3 + LongName + MomDadLongName + MomDadLongPhone + MomDadLongEmail - .15 * PageS, Y - .15 + FHeight), , BF 'to top-tight
LINE -(X, Y + FHeight * 1.05), , BF 'to top-left
LINE (X + LongName + XSpacing * 1 / 3, Y + FHeight)-(X + LongName + XSpacing * 2 / 3, MaxY - .15 * FHeight), , BF 'Top to bottom between name and parent's name
LINE (X + LongName + MomDadLongName + XSpacing * 2 / 3, Y + FHeight)-_
(X + LongName + MomDadLongName + XSpacing, MaxY - .15 * FHeight), , BF 'Top to bottom between parent's name and parent's phone
LINE (X + LongName + MomDadLongName + MomDadLongPhone + XSpacing, Y + FHeight)-_
(X + LongName + MomDadLongName + MomDadLongPhone + XSpacing * 4 / 3, MaxY - .15 * FHeight), , BF 'Top to bottom between parent's phone and parent's email
X = X + XSpacing + LongName
PRINTSTRING (X, Y), MotherFather + "name:"
X = X + XSpacing + MomDadLongName
PRINTSTRING (X, Y), MotherFather + "phone:"
X = X + XSpacing + MomDadLongPhone
PRINTSTRING (X, Y), MotherFather + "email:"
END SELECT
'Report footer
Y = 280 * PageS
PRINTSTRING (20 * PageS, Y), "Prepared with "
PRINTSTRING (190 * PageS - PRINTWIDTH("Page 1 of 1"), Y), "Page 1 of 1"
X = (20 * PageS) + PRINTWIDTH("Prepared with ")
FONT Cursive
PRINTSTRING (X, Y), "Grade Keeper"
'Send the report to the printer, cleans up our fonts, and inform the user of success.
PRINTIMAGE Page
FONT Arial24
FREEFONT Script
FREEFONT Cursive
SCREEN ScreenPointer(SourceScreen): DEST ScreenPointer(SourceScreen) 'Restore our prior screen
QUICKMESSAGE "Report generated!", 32, SourceScreen
END SUB
'Collects info on the teacher to make reports look more professional.
SUB TEACHERINFO
DIM AS STRING * 1 OverWrite
OverWrite = "N"
SCREEN ScreenPointer(3)
CLS
PUTIMAGE , Generic
'prompt for overwrite
IF FILEEXISTS("data/current/teacher.gkn") THEN
QUICKMESSAGE "Info is on file. You may go back on the next screen.", 32, 3
FONT Arial60
LOCATE 4, 1280 / 2 - PRINTWIDTH("OVERWRITE!") / 2: PRINT "OVERWRITE!"
FONT Arial48
AUTODISPLAY
DO
LOCATE 8, 1280 / 2 - PRINTWIDTH("Do you wish to overwrite current teacher info (Y/N)?") / 2
INPUT "Do you wish to overwrite current teacher info (Y/N)?", OverWrite
OverWrite = UCASE$(OverWrite)
LOOP UNTIL OverWrite = "Y" OR OverWrite = "N"
DISPLAY
END IF
'No file? Make one here
IF NOT FILEEXISTS("data/current/teacher.gkn") OR OverWrite = "Y" THEN
DIM AS LONG Script
Script = LOADFONT("data/assets/script.ttf", 39)
CLS
PUTIMAGE , BlankData
FONT Script
AUTODISPLAY
LOCATE 2, 1280 / 2 - PRINTWIDTH("Teacher Info") / 2: PRINT "Teacher Info"
PAUSE (TIME)
LOCATE 5, 50: INPUT "Please enter your name (Mr./Ms. Smith): ", Teacher.TeacherName
PAUSE (TIME)
LOCATE 6, 50: INPUT "Please enter the name of your school: ", Teacher.School
PAUSE (TIME)
LOCATE 7, 50: INPUT "Please enter your grade/subject: ", Teacher.Grade
PAUSE (TIME)
LOCATE 8, 50: INPUT "please enter your class/section: ", Teacher.Class
PAUSE (TIME)
LOCATE 9, 50: INPUT "Pleae enter your classroom number: ", Teacher.Classroom
DISPLAY
OPEN "data/current/teacher.gkn" FOR OUTPUT AS #2
WRITE #2, Teacher.TeacherName
WRITE #2, Teacher.School
WRITE #2, Teacher.Grade
WRITE #2, Teacher.Class
WRITE #2, Teacher.Classroom
CLOSE #2
QUICKMESSAGE "Teacher info written succesfully!", 32, 3
FONT Arial24
FREEFONT Script
END IF
SCREEN ScreenPointer(2)
END SUB
'Used for initial database building of student data
SUB CREATESTUDENTLIST
DIM AS STRING * 1 AddAnother, Correct
DIM AS NameListType NewData
PAUSE (TIME)
FONT Arial24
OPEN "data/current/namelist.gkn" FOR OUTPUT AS #1 'For writing the master name list data
Counter = 1
AUTODISPLAY
'Gathering data about students
DO
CLS
PUTIMAGE (0, 0), NewNameEntry
LOCATE 7, 140: PRINT Counter 'Built with Arial24
LOCATE 7, 280: INPUT "", NewData.PinYinName
DO
LOCATE 7, 710: PRINT " "
LOCATE 7, 710: INPUT "", NewData.Month
LOOP UNTIL NewData.Month > 0 AND NewData.Month < 13
DO
LOCATE 7, 780: PRINT " "
LOCATE 7, 780: INPUT "", NewData.Day
LOOP UNTIL NewData.Day > 0 AND NewData.Day < 32
DO
LOCATE 7, 840: PRINT " "
LOCATE 7, 840: INPUT "", NewData.Year
LOOP UNTIL NewData.Year > 2000 AND NewData.Year < 2100
LOCATE 7, 970: INPUT "", NewData.HouseColor
LOCATE 12, 55: INPUT "", NewData.FirstName
LOCATE 12, 400: INPUT "", NewData.MiddleName
LOCATE 12, 780: INPUT "", NewData.LastName
LOCATE 17, 55: INPUT "", NewData.MomName
LOCATE 17, 400: INPUT "", NewData.MomPhone
LOCATE 17, 780: INPUT "", NewData.MomEmail
LOCATE 22, 55: INPUT "", NewData.DadName
LOCATE 22, 400: INPUT "", NewData.DadPhone
LOCATE 22, 780: INPUT "", NewData.DadEmail
DO
LOCATE 27, 430: PRINT " "
LOCATE 27, 430: INPUT "", Correct
Correct = UCASE$(Correct)
LOOP UNTIL Correct = "Y" OR Correct = "N"
DO
LOCATE 27, 690: PRINT " "
LOCATE 27, 690: INPUT "", AddAnother
AddAnother = UCASE$(AddAnother)
LOOP UNTIL AddAnother = "Y" OR AddAnother = "N"
'Check if the entry is correct. If it is write it, otherwise repeat with same entry number
IF Correct = "Y" THEN
WRITESTUDENTLIST NewData
Counter = Counter + 1
ELSE
QUICKMESSAGE "Data not written. Please re-enter data.", 32, 1
AUTODISPLAY
FONT Arial24
AddAnother = "Y"
END IF
LOOP UNTIL AddAnother = "N"
DISPLAY
CLOSE #1
QUICKMESSAGE "Data written successfully!", 32, 1
END SUB
SUB ADDSTUDENT
DIM AS NameListType NewData
DIM AS STRING * 1 Correct
SCREEN ScreenPointer(2)
CLS
PUTIMAGE (0, 0), NewNameEntry
FONT Arial24
'Used to blank the option to add another
LOCATE 24, 550: PRINT " "
LOCATE 25, 550: PRINT " "
LOCATE 25, 550: PRINT " "
LOCATE 26, 550: PRINT " ";
'Checks correctness and writes or aborts writing and returns to the prior screen
IF Correct = "Y" THEN
NumberOfStudents = NumberOfStudents + 1
UPDATESTUDENTLIST NewData, NumberOfStudents
OPEN "data/current/namelist.gkn" FOR OUTPUT AS #1
FOR Counter = 1 TO NumberOfStudents
WRITESTUDENTLIST NameList(Counter)
NEXT Counter
CLOSE #1
QUICKMESSAGE "Student added successfully!", 32, 2
ELSE
QUICKMESSAGE "Student not added. Please try again.", 32, 2
FONT Arial24
END IF
DISPLAY
SCREEN ScreenPointer(1)
END SUB
'Replace student info from a source NameListType
SUB UPDATESTUDENTLIST (DataSource AS NameListType, Student AS INTEGER)
NameList(Student).PinYinName = DataSource.PinYinName
NameList(Student).FirstName = DataSource.FirstName
NameList(Student).MiddleName = DataSource.MiddleName
NameList(Student).LastName = DataSource.LastName
NameList(Student).Year = DataSource.Year
NameList(Student).Month = DataSource.Month
NameList(Student).Day = DataSource.Day
NameList(Student).HouseColor = DataSource.HouseColor
NameList(Student).MomName = DataSource.MomName
NameList(Student).MomPhone = DataSource.MomPhone
NameList(Student).MomEmail = DataSource.MomEmail
NameList(Student).DadName = DataSource.DadName
NameList(Student).DadPhone = DataSource.DadPhone
NameList(Student).DadEmail = DataSource.DadEmail
END SUB
'Writes a NameListType to file (#1 is reservered)
SUB WRITESTUDENTLIST (DataSource AS NameListType)
WRITE #1, DataSource.PinYinName
WRITE #1, DataSource.Month
WRITE #1, DataSource.Day
WRITE #1, DataSource.Year
WRITE #1, DataSource.HouseColor
WRITE #1, DataSource.FirstName
WRITE #1, DataSource.MiddleName
WRITE #1, DataSource.LastName
WRITE #1, DataSource.MomName
WRITE #1, DataSource.MomPhone
WRITE #1, DataSource.MomEmail
WRITE #1, DataSource.DadName
WRITE #1, DataSource.DadPhone
WRITE #1, DataSource.DadEmail
END SUB
'Loads the student data into memory. Ensure file exists before calling (#1 is reserved)
SUB LOADSTUDENTDATA
NumberOfStudents = 0
OPEN "data/current/namelist.gkn" FOR INPUT AS #1
WHILE NOT EOF(1)
NumberOfStudents = NumberOfStudents + 1
IF UBOUND(namelist) = NumberOfStudents THEN REDIM PRESERVE NameList(NumberOfStudents + 1) AS NameListType
INPUT #1, NameList(NumberOfStudents).PinYinName
INPUT #1, NameList(NumberOfStudents).Month
INPUT #1, NameList(NumberOfStudents).Day
INPUT #1, NameList(NumberOfStudents).Year
INPUT #1, NameList(NumberOfStudents).HouseColor
INPUT #1, NameList(NumberOfStudents).FirstName
INPUT #1, NameList(NumberOfStudents).MiddleName
INPUT #1, NameList(NumberOfStudents).LastName
INPUT #1, NameList(NumberOfStudents).MomName
INPUT #1, NameList(NumberOfStudents).MomPhone
INPUT #1, NameList(NumberOfStudents).MomEmail
INPUT #1, NameList(NumberOfStudents).DadName
INPUT #1, NameList(NumberOfStudents).DadPhone
INPUT #1, NameList(NumberOfStudents).DadEmail
WEND
CLOSE #1
END SUB
'Prints a short pop-up message to the user
SUB QUICKMESSAGE (ToPrint AS STRING, FontHandle AS INTEGER, CurrentScreen AS INTEGER)
DIM AS INTEGER Rows, Columns
'Save prior screen (ScreenPointer(5) is reserved for the sub)
SCREEN ScreenPointer(5)
'Font size selection
SELECT CASE FontHandle
CASE 8: FONT Arial8
CASE 12: FONT Arial12
CASE 16: FONT Arial16
CASE 24: FONT Arial24
CASE 32: FONT Arial32
CASE 48: FONT Arial48
CASE 60: FONT Arial60
CASE ELSE: BEEP 'Debug use only
EXIT SUB
END SELECT
'Formats birthdays and calls to add the day of the week
FUNCTION BIRTHDAY$ (MonthInt AS INTEGER, DayInt AS INTEGER, YearInt AS INTEGER)
DIM AS STRING Month, Day, Year
Year = STR$(YearInt)
SELECT CASE DayInt:
CASE 1, 21, 31: Day = STR$(DayInt) + "st, "
CASE 2, 22: Day = STR$(DayInt) + "nd, "
CASE 3, 23: Day = STR$(DayInt) + "rd, "
CASE ELSE: Day = STR$(DayInt) + "th, "
END SELECT
SELECT CASE MonthInt:
CASE 1: Month = "January "
CASE 2: Month = "February "
CASE 3: Month = "March "
CASE 4: Month = "April "
CASE 5: Month = "May "
CASE 6: Month = "June "
CASE 7: Month = "July "
CASE 8: Month = "August "
CASE 9: Month = "September "
CASE 10: Month = "October "
CASE 11: Month = "November "
CASE 12: Month = "December "
END SELECT
BIRTHDAY$ = DAYOFWEEK(YearInt - 2000, MonthInt, DayInt) + ", " + Month + Day + Year
END FUNCTION
'Formats the date
FUNCTION TODAY$
DIM AS STRING Month, Day, Year
DIM AS INTEGER M
Month = LEFT$(DATE$, 2): M = VAL(Month)
Day = MID$(DATE$, 4, 2)
Year = RIGHT$(DATE$, 4)
SELECT CASE M:
CASE 1: Month = "January "
CASE 2: Month = "February "
CASE 3: Month = "March "
CASE 4: Month = "April "
CASE 5: Month = "May "
CASE 6: Month = "June "
CASE 7: Month = "July "
CASE 8: Month = "August "
CASE 9: Month = "September "
CASE 10: Month = "October "
CASE 11: Month = "November "
CASE 12: Month = "December "
END SELECT
TODAY$ = Month + Day + ", " + Year
END FUNCTION
'Thank you QB64 member Hannes Sehestedt for documenting Day of the week so well!
FUNCTION DAYOFWEEK$ (Year AS INTEGER, Month AS INTEGER, Day AS INTEGER)
DIM AS STRING WeekDay(1 TO 7)
DIM AS INTEGER MonthDay(1 TO 12)
DIM AS INTEGER Result2, Result1, Result3, Temp, Temp2, LeapYear
WeekDay(2) = "Sunday"
WeekDay(3) = "Monday"
WeekDay(4) = "Tuesday"
WeekDay(5) = "Wednesday"
WeekDay(6) = "Thursday"
WeekDay(7) = "Friday"
WeekDay(1) = "Saturday"
MonthDay(1) = 0
MonthDay(2) = 3
MonthDay(3) = 3
MonthDay(4) = 6
MonthDay(5) = 1
MonthDay(6) = 4
MonthDay(7) = 6
MonthDay(8) = 2
MonthDay(9) = 5
MonthDay(10) = 0
MonthDay(11) = 3
MonthDay(12) = 5
Temp = Day + MonthDay(Month) 'Add the day of the month with the MonthDay Value
IF Temp > 6 THEN 'If above 6, subtract the highest multiple of 7
Temp2 = INT(Temp / 7)
Temp = Temp - (Temp2 * 7)
END IF
Result1 = Temp
Temp = Year
IF Year > 27 THEN 'Last two digits of the year, subtract the year that has the highest multiple of 28
Temp2 = INT(Temp / 28)
Temp = Year - (Temp2 * 28)
END IF
Result2 = Temp
Temp = 0
IF Year > 3 THEN 'Take the year value and divide by 4 rounding down
Temp = INT(Year / 4)
END IF
Result3 = Result2 + Temp
IF Month < 3 THEN 'Leap year check, take one away if leap year before leap year day 2/29
IF (Year / 4) = (INT(Year / 4)) THEN
LeapYear = 1
ELSE
LeapYear = 0
END IF
Result3 = Result3 - LeapYear
END IF
Result3 = Result3 + Result1
IF Result3 > 6 THEN
Temp = INT(Result3 / 7)
Result3 = Result3 - (Temp * 7)
END IF
Result3 = Result3 + 1
DAYOFWEEK$ = WeekDay(Result3)
END FUNCTION
'Thank you QB64 WIKI!/Returns time into a more friendly reading style.
FUNCTION CLOCK$
DIM AS STRING Hour, Min, AmPm
DIM AS INTEGER H
Hour = LEFT$(TIME$, 2): H = VAL(Hour)
Min = MID$(TIME$, 3, 3)
IF H >= 12 THEN AmPm = " PM" ELSE AmPm = " AM"
IF H > 12 THEN
IF H - 12 < 10 THEN Hour$ = STR$(H - 12) ELSE Hour$ = LTRIM$(STR$(H% - 12))
ELSEIF H = 0 THEN Hour = "12" ' midnight hour
ELSE: IF H < 10 THEN Hour = STR$(H) ' eliminate leading zeros
END IF
CLOCK$ = Hour + Min + AmPm
END FUNCTION
SUB SORT (Element AS INTEGER) '1 - first name, 2 - birthday, 3 - house color
DIM AS BYTE OOO 'Out of order
DIM AS INTEGER SortCounter
SELECT CASE Element
CASE 1: 'First name sort
DO
OOO = FALSE
FOR SortCounter = 1 TO NumberOfStudents - 1
IF NameList(SortCounter).FirstName > NameList(SortCounter + 1).FirstName THEN
SWAP NameList(SortCounter), NameList(SortCounter + 1)
OOO = TRUE
ELSEIF NameList(SortCounter).FirstName = NameList(SortCounter + 1).FirstName AND _
NameList(SortCounter).LastName > NameList(SortCounter + 1).LastName THEN 'Used for same first names only
SWAP NameList(SortCounter), NameList(SortCounter + 1)
OOO = TRUE
END IF
NEXT SortCounter
LOOP WHILE OOO
CASE 2: 'Birthday Sort
DO
OOO = FALSE
FOR SortCounter = 1 TO NumberOfStudents - 1
IF NameList(SortCounter).Month > NameList(SortCounter + 1).Month THEN
SWAP NameList(SortCounter), NameList(SortCounter + 1)
OOO = TRUE
ELSEIF NameList(SortCounter).Month = NameList(SortCounter + 1).Month AND _
NameList(SortCounter).Day > NameList(SortCounter + 1).Day THEN 'Sort the days inside a month
SWAP NameList(SortCounter), NameList(SortCounter + 1)
OOO = TRUE
ELSEIF NameList(SortCounter).Month = NameList(SortCounter + 1).Month AND _
NameList(SortCounter).Day = NameList(SortCounter + 1).Day AND _
NameList(SortCounter).FirstName > NameList(SortCounter + 1).FirstName THEN 'Secondary sort first name
SWAP NameList(SortCounter), NameList(SortCounter + 1)
OOO = TRUE
ELSEIF NameList(SortCounter).Month = NameList(SortCounter + 1).Month AND _
NameList(SortCounter).Day = NameList(SortCounter + 1).Day AND _
NameList(SortCounter).FirstName = NameList(SortCounter + 1).FirstName AND _
NameList(SortCounter).LastName > NameList(SortCounter + 1).LastName THEN 'Trinary sort last name
SWAP NameList(SortCounter), NameList(SortCounter + 1)
OOO = TRUE
END IF
NEXT SortCounter
LOOP WHILE OOO
CASE 3: 'Color sort
DO
OOO = FALSE
FOR SortCounter = 1 TO NumberOfStudents - 1
IF NameList(SortCounter).HouseColor > NameList(SortCounter + 1).HouseColor THEN
SWAP NameList(SortCounter), NameList(SortCounter + 1)
OOO = TRUE
ELSEIF NameList(SortCounter).HouseColor = NameList(SortCounter + 1).HouseColor AND _
NameList(SortCounter).FirstName > NameList(SortCounter + 1).FirstName THEN 'Secondary sort by first name
SWAP NameList(SortCounter), NameList(SortCounter + 1)
OOO = TRUE
ELSEIF NameList(SortCounter).HouseColor = NameList(SortCounter + 1).HouseColor AND _
NameList(SortCounter).FirstName = NameList(SortCounter + 1).FirstName AND _
NameList(SortCounter).LastName > NameList(SortCounter + 1).LastName THEN 'Trinary sort by last name
SWAP NameList(SortCounter), NameList(SortCounter + 1)
OOO = TRUE
END IF
NEXT SortCounter
LOOP WHILE OOO
END SELECT
END SUB
'Simple delay with keyboard flush - Used to avoid double key presses
SUB PAUSE (Dlay)
DELAY Dlay
KEYCLEAR 'Clear any key press
END SUB
04-17-2023, 12:30 PM (This post was last modified: 04-17-2023, 12:31 PM by NasaCow.)
Here is the most recent release. V4 has been recoded from the ground up. Most functions remained with subs being reprogrammed. Like a good author, a program sometimes needs major revisions. Though I am basically where I left off. The problems I was facing have been eliminated from the ground up. Moving into the actual gradebook is going to be a big task but now I am feeling more confident. As always, I am open to constructive criticism.
Code: (Select All)
'====================================================================================
'| |
'| Grade Keeper Build 4.0.1 - Total code rewrite to resolve major issues. |
'| |
'| Release #3 April 17th, 2023 |
'| |
'| Additions: #1 - Gradebook layout - Still not recoded from V3 |
'| #2 - Gradebook fiie system - 3 UDTs now 'talk' with each other |
'| #3 - Quicker opening to gradebook - 3 ENTERs to active book |
'| #4 - Class set selection screen - Multiple books at once! |
'| |
'| Modifications: #1 - Pictures are now embedded within the code |
'| #2 - More transitions to embedded data (less files - only 2!) |
'| #3 - File structure removed due to less assets. |
'| #4 - Recoded to allow multiple gradebooks at once. |
'| #5 - Archived classes have been removed, only remove for now |
'| |
'| Current Limitations: #X - Student limited to... (Resolved - unlimited students!) |
'| #1 - Printed reports limited to windows |
'| #2 = Printed reports limited to 1 page |
'| |
'====================================================================================
I also have learn to love CIRCLES, it is much cleaner when drawing. Qprint has been really helpful as well (though it seems to not play overly nice with printscreen, guessing it has to do with an overflow in high page scale settings? If someone is curious, I will be happy to share)
Looking forward to getting to the nuts and bolts but I am already using the reports in my classroom! The part that makes me the proudest thus far is eleminating all files except the font files, hopefully I can find a way to include them as DATA at some point as well!
Hi NasaCow
I downloaded this last release of GradeBook V4 R3.zip
I extracted the files allowing its natural path and subpaths, BUUUUT I got an error for missing a file... "./falcon"
Well, I remember that this file was always in the QB64 folder. It is not true for QB64pe until version 3.6.0 x64.
So I hoped to recover this file from old QB64 version (I have the 2.0.2) but also there no falcon.h file exists.
Please can you put this necessary file into your zip? And moreover can you post it alone?
@Nasacow
Great job, I like its style.
A feedback phone number field let me insert until 20 digits. I dunno if it is correct in your country.
This issue leds us to another issue... in the mask of typing data for each student the phone number field covers the email address field both for mother and father.
Typing email in the same mask of input I found difficult to write "@", is it ok on your Pc?
![[Image: image.png]](https://i.ibb.co/0ZRfFq2/image.png)
![[Image: image.png]](https://i.ibb.co/YN9HPtc/image.png)
![[Image: image.png]](https://i.ibb.co/5Yrx193/image.png)
![[Image: image.png]](https://i.ibb.co/vhwGTDm/image.png)
Thank you! I got it.